/[MITgcm]/MITgcm/pkg/grdchk/grdchk_main.F
ViewVC logotype

Diff of /MITgcm/pkg/grdchk/grdchk_main.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.36 by jmc, Fri Jul 6 23:10:28 2012 UTC revision 1.37 by jmc, Wed Aug 15 23:05:48 2012 UTC
# Line 241  cph) Line 241  cph)
241                icglo    = 0                icglo    = 0
242                itest    = 0                itest    = 0
243              endif              endif
             _BARRIER  
244    
245  c******************************************************  c******************************************************
246  c--   (A): get gradient component calculated via adjoint  c--   (A): get gradient component calculated via adjoint
# Line 257  c--   get gradient component calculated Line 256  c--   get gradient component calculated
256              endif              endif
257  C--   Add a global-sum call so that all proc will get the adjoint gradient  C--   Add a global-sum call so that all proc will get the adjoint gradient
258              _GLOBAL_SUM_RL( adxxmemo, myThid )              _GLOBAL_SUM_RL( adxxmemo, myThid )
 c           _BARRIER  
259    
260  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
261  c******************************************************  c******************************************************
# Line 278  c--   1. perturb control vector componen Line 276  c--   1. perturb control vector componen
276                xxmemo_ref  = 0.                xxmemo_ref  = 0.
277                xxmemo_pert = 0.                xxmemo_pert = 0.
278              endif              endif
             _BARRIER  
279    
280  c--  c--
281  c--   2. perform tangent linear run  c--   2. perform tangent linear run
# Line 297  c--   2. perform tangent linear run Line 294  c--   2. perform tangent linear run
294  #endif  #endif
295    
296              call g_the_main_loop( mytime, myiter, mythid )              call g_the_main_loop( mytime, myiter, mythid )
             _BARRIER  
297  #ifdef ALLOW_ADMTLM  #ifdef ALLOW_ADMTLM
298              ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)              ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)
299  #else  #else
# Line 313  c--   3. reset control vector Line 309  c--   3. reset control vector
309       &              itilepos, jtilepos,       &              itilepos, jtilepos,
310       &              xxmemo_ref, mythid )       &              xxmemo_ref, mythid )
311              endif              endif
             _BARRIER  
312    
313  #endif /* ALLOW_TANGENTLINEAR_RUN */  #endif /* ALLOW_TANGENTLINEAR_RUN */
314    
# Line 337  c--   positive perturbation Line 332  c--   positive perturbation
332                xxmemo_ref  = 0.                xxmemo_ref  = 0.
333                xxmemo_pert = 0.                xxmemo_pert = 0.
334              endif              endif
             _BARRIER  
335    
336  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
337              mytime = starttime              mytime = starttime
# Line 348  c--   forward run with perturbed control Line 342  c--   forward run with perturbed control
342  #else  #else
343              fcpertplus = fc              fcpertplus = fc
344  #endif  #endif
345              print *, 'ph-check fcpertplus = ', fcpertplus              print *, 'ph-check fcpertplus  = ', fcpertplus
             _BARRIER  
346    
347  c--   Reset control vector.  c--   Reset control vector.
348              if ( myProcId .EQ. grdchkwhichproc .AND.              if ( myProcId .EQ. grdchkwhichproc .AND.
# Line 359  c--   Reset control vector. Line 352  c--   Reset control vector.
352       &              itilepos, jtilepos,       &              itilepos, jtilepos,
353       &              xxmemo_ref, mythid )       &              xxmemo_ref, mythid )
354              endif              endif
             _BARRIER  
355    
356              fcpertminus = fcref              fcpertminus = fcref
357              print *, 'ph-check fcpertminus = ', fcpertminus              print *, 'ph-check fcpertminus = ', fcpertminus
# Line 381  c--   repeat the proceedure for a negati Line 373  c--   repeat the proceedure for a negati
373                   xxmemo_ref  = 0.                   xxmemo_ref  = 0.
374                   xxmemo_pert = 0.                   xxmemo_pert = 0.
375                 endif                 endif
                _BARRIER  
376    
377  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
378                 mytime = starttime                 mytime = starttime
379                 myiter = niter0                 myiter = niter0
380                 call the_main_loop( mytime, myiter, mythid )                 call the_main_loop( mytime, myiter, mythid )
                _BARRIER  
381  #ifdef ALLOW_ADMTLM  #ifdef ALLOW_ADMTLM
382                 fcpertminus = objf_state_final(idep,jdep,1,1,1)                 fcpertminus = objf_state_final(idep,jdep,1,1,1)
383  #else  #else
# Line 402  c--   Reset control vector. Line 392  c--   Reset control vector.
392       &                 itilepos, jtilepos,       &                 itilepos, jtilepos,
393       &                 xxmemo_ref, mythid )       &                 xxmemo_ref, mythid )
394                 endif                 endif
                _BARRIER  
395    
396  c-- end of if useCentralDiff ...  c-- end of if useCentralDiff ...
397              end if              end if
# Line 490  c*************************************** Line 479  c***************************************
479  #endif  #endif
480              endif              endif
481  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
482              WRITE(msgBuf,'(A34,1PE24.14)')              WRITE(msgBuf,'(A30,1PE22.14)')
483       &              ' TLM  precision_derivative_cost =', fcref       &              ' TLM  ref_cost_function      =', fcref
484              CALL PRINT_MESSAGE              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
485       &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,myThid)       &                          SQUEEZE_RIGHT, myThid )
486              WRITE(msgBuf,'(A34,1PE24.14)')              WRITE(msgBuf,'(A30,1PE22.14)')
487       &              ' TLM  precision_derivative_grad =', ftlxxmemo       &              ' TLM  tangent-lin_grad       =', ftlxxmemo
488              CALL PRINT_MESSAGE              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
489       &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,myThid)       &                          SQUEEZE_RIGHT, myThid )
490                WRITE(msgBuf,'(A30,1PE22.14)')
491         &              ' TLM  finite-diff_grad       =', gfd
492                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
493         &                          SQUEEZE_RIGHT, myThid )
494  #else  #else
495              WRITE(msgBuf,'(A30,1PE22.14)')              WRITE(msgBuf,'(A30,1PE22.14)')
496       &              ' ADM  ref_cost_function      =', fcref       &              ' ADM  ref_cost_function      =', fcref
# Line 517  c*************************************** Line 510  c***************************************
510              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,
511       &           ', ichknum = ', ichknum       &           ', ichknum = ', ichknum
512    
             _BARRIER  
   
513  c-- else of if ( ichknum ...  c-- else of if ( ichknum ...
514           else           else
515              ierr_grdchk = -1              ierr_grdchk = -1
# Line 539  c-- end of do icomp = ... Line 530  c-- end of do icomp = ...
530        endif        endif
531    
532  c--   Everyone has to wait for the component to be reset.  c--   Everyone has to wait for the component to be reset.
533        _BARRIER  c     _BARRIER
534    
535  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
536        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37
  ViewVC Help
Powered by ViewVC 1.1.22