/[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.16 by heimbach, Thu Jul 28 13:54:36 2005 UTC revision 1.40 by heimbach, Wed Aug 22 19:34:51 2012 UTC
# Line 1  Line 1 
 C  
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "GRDCHK_OPTIONS.h"
5  #include "AD_CONFIG.h"  #include "AD_CONFIG.h"
 #include "CPP_OPTIONS.h"  
6    
7  CBOI  CBOI
8  C  C
# Line 33  c         |-- grdchk_loc      - determin Line 32  c         |-- grdchk_loc      - determin
32  c         |  c         |
33  c         |-- grdchk_getxx    - get control vector component from file  c         |-- grdchk_getxx    - get control vector component from file
34  c         |                     perturb it and write back to file  c         |                     perturb it and write back to file
35  c         |-- grdchk_getadxx  - get gradient component calculated  c         |-- grdchk_getadxx  - get gradient component calculated
36  c         |                     via adjoint  c         |                     via adjoint
37  c         |-- the_main_loop   - forward run and cost evaluation  c         |-- the_main_loop   - forward run and cost evaluation
38  c         |                     with perturbed control vector element  c         |                     with perturbed control vector element
# Line 66  c              heimbach@mit.edu 24-Feb-2 Line 65  c              heimbach@mit.edu 24-Feb-2
65  c              - added tangent linear gradient checks  c              - added tangent linear gradient checks
66  c              - fixes for multiproc. gradient checks  c              - fixes for multiproc. gradient checks
67  c              - added more control variables  c              - added more control variables
68  c      c
69  c     ==================================================================  c     ==================================================================
70  c     SUBROUTINE grdchk_main  c     SUBROUTINE grdchk_main
71  c     ==================================================================  c     ==================================================================
# Line 81  c     == global variables == Line 80  c     == global variables ==
80  #include "PARAMS.h"  #include "PARAMS.h"
81  #include "grdchk.h"  #include "grdchk.h"
82  #include "cost.h"  #include "cost.h"
83    #include "ctrl.h"
84  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
85  #include "g_cost.h"  #include "g_cost.h"
86  #endif  #endif
87    
88  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
89  c     == routine arguments ==  c     == routine arguments ==
90        integer mythid        integer mythid
91    
92  #ifdef ALLOW_GRDCHK  #ifdef ALLOW_GRDCHK
93  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
94  c     == local variables ==  c     == local variables ==
95        integer myiter        integer myiter
96        _RL     mytime        _RL     mytime
97        integer bi, itlo, ithi        integer bi, itlo, ithi
98        integer bj, jtlo, jthi        integer bj, jtlo, jthi
99        integer i,  imin, imax        integer i,  imin, imax
# Line 109  c     == local variables == Line 109  c     == local variables ==
109        integer obcspos        integer obcspos
110        integer itilepos        integer itilepos
111        integer jtilepos        integer jtilepos
112          integer icglo
113        integer itest        integer itest
114        integer ierr        integer ierr
115        integer ierr_grdchk        integer ierr_grdchk
# Line 148  c--   Set the loop ranges. Line 149  c--   Set the loop ranges.
149  c--   initialise variables  c--   initialise variables
150        call grdchk_init( mythid )        call grdchk_init( mythid )
151    
152  c--   Compute the adjoint models' gradients.  c--   Compute the adjoint model gradients.
153  c--   Compute the unperturbed cost function.  c--   Compute the unperturbed cost function.
154  cph   Gradient via adjoint has already been computed,  cph   Gradient via adjoint has already been computed,
155  cph   and so has unperturbed cost function,  cph   and so has unperturbed cost function,
156  cph   assuming all xx_ fields are initialised to zero.  cph   assuming all xx_ fields are initialised to zero.
157    
158          ierr      = 0
159        ierr_grdchk = 0        ierr_grdchk = 0
160  cphadmtlm(        adxxmemo  = 0.
161          ftlxxmemo = 0.
162    #if (defined  (ALLOW_ADMTLM))
163          fcref = objf_state_final(idep,jdep,1,1,1)
164    #elif (defined (ALLOW_AUTODIFF_OPENAD))
165          fcref = fc%v
166    #else
167        fcref = fc        fcref = fc
168  cphadmtlm      fcref = objf_state_final(45,4,1,1,1)  #endif
 cphadmtlm)  
169    
170        print *, 'ph-check fcref = ', fcref        print *, 'ph-check fcref = ', fcref
171    
# Line 182  cphadmtlm) Line 189  cphadmtlm)
189           grdchk_epsfac = 1. _d 0           grdchk_epsfac = 1. _d 0
190        end if        end if
191    
192        print *, 'grad-res -------------------------------'        WRITE(standardmessageunit,'(A)')
193        print ('(2a)'),       &    'grad-res -------------------------------'
194       &     ' grad-res  proc    #    i    j    k            fc ref',        WRITE(standardmessageunit,'(2a)')
195       &     '        fc + eps        fc - eps'       &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
196         &    '               fc ref           fc + eps           fc - eps'
197  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
198        print ('(2a)'),        WRITE(standardmessageunit,'(2a)')
199       &     ' grad-res  proc    #    i    j    k          tlm grad',       &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
200       &     '         fd grad      1 - fd/tlm'       &    '             tlm grad            fd grad         1 - fd/tlm'
201  #else  #else
202        print ('(2a)'),        WRITE(standardmessageunit,'(2a)')
203       &     ' grad-res  proc    #    i    j    k          adj grad',       &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
204       &     '         fd grad      1 - fd/adj'       &    '             adj grad            fd grad         1 - fd/adj'
205  #endif  #endif
206    
207  c--   Compute the finite difference approximations.  c--   Compute the finite difference approximations.
208  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep
209  c--   gradient checks.  c--   gradient checks.
210    
211        if ( nbeg .EQ. 0 ) call grdchk_get_position( mythid )        if ( nbeg .EQ. 0 )
212         &     call grdchk_get_position( mythid )
213    
214        do icomp = nbeg, nend, nstep        do icomp = nbeg, nend, nstep
215    
216           ichknum = (icomp - nbeg)/nstep + 1           ichknum = (icomp - nbeg)/nstep + 1
217             adxxmemo  = 0.
218    
219    cph(
220    cph-print         print *, 'ph-grd _main: nbeg, icomp, ichknum ',
221    cph-print     &        nbeg, icomp, ichknum
222    cph)
223           if (ichknum .le. maxgrdchecks ) then           if (ichknum .le. maxgrdchecks ) then
224    
225  c--         Determine the location of icomp on the grid.  c--         Determine the location of icomp on the grid.
226              if ( myProcId .EQ. grdchkwhichproc ) then              if ( myProcId .EQ. grdchkwhichproc ) then
227                 call grdchk_loc( icomp, ichknum,                 call grdchk_loc( icomp, ichknum,
228       &              icvrec, itile, jtile, layer, obcspos,       &              icvrec, itile, jtile, layer, obcspos,
229       &              itilepos, jtilepos, itest, ierr,       &              itilepos, jtilepos, icglo, itest, ierr,
230       &              mythid )       &              mythid )
231    cph(
232    cph-print               print *, 'ph-grd ----- back from loc -----',
233    cph-print     &             icvrec, itilepos, jtilepos, layer, obcspos
234    cph)
235                else
236                  icvrec   = 0
237                  itile    = 0
238                  jtile    = 0
239                  layer    = 0
240                  obcspos  = 0
241                  itilepos = 0
242                  jtilepos = 0
243                  icglo    = 0
244                  itest    = 0
245              endif              endif
246              _BARRIER  
247                  c make sure that all procs have correct file records, so that useSingleCpuIO works
248          CALL GLOBAL_SUM_INT( icvrec , myThid )
249          CALL GLOBAL_SUM_INT( layer , myThid )
250          CALL GLOBAL_SUM_INT( ierr , myThid )
251    
252  c******************************************************  c******************************************************
253  c--   (A): get gradient component calculated via adjoint  c--   (A): get gradient component calculated via adjoint
254  c******************************************************  c******************************************************
255    
256  c--   get gradient component calculated via adjoint  c--   get gradient component calculated via adjoint
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
257                 call grdchk_getadxx( icvrec,                 call grdchk_getadxx( icvrec,
258       &              itile, jtile, layer,       &              itile, jtile, layer,
259       &              itilepos, jtilepos,       &              itilepos, jtilepos,
260       &              adxxmemo, mythid )       &              adxxmemo, ierr, mythid )
261              endif  C--   Add a global-sum call so that all proc will get the adjoint gradient
262              _BARRIER              _GLOBAL_SUM_RL( adxxmemo, myThid )
263    
264  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
265  c******************************************************  c******************************************************
# Line 238  c*************************************** Line 268  c***************************************
268  c--  c--
269  c--   1. perturb control vector component: xx(i)=1.  c--   1. perturb control vector component: xx(i)=1.
270    
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
271                 localEps = 1. _d 0                 localEps = 1. _d 0
272                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,
273       &              itile, jtile, layer,       &              itile, jtile, layer,
274       &              itilepos, jtilepos,       &              itilepos, jtilepos,
275       &              xxmemo_ref, xxmemo_pert, localEps,       &              xxmemo_ref, xxmemo_pert, localEps,
276       &              mythid )       &              ierr, mythid )
             endif  
             _BARRIER  
277    
278  c--  c--
279  c--   2. perform tangent linear run  c--   2. perform tangent linear run
280              mytime = starttime              mytime = starttime
281              myiter = niter0              myiter = niter0
282  cphadmtlm(  #ifdef ALLOW_ADMTLM
283                do k=1,4*Nr+1
284                 do j=1,sny
285                  do i=1,snx
286                   g_objf_state_final(i,j,1,1,k) = 0.
287                  enddo
288                 enddo
289                enddo
290    #else
291              g_fc = 0.              g_fc = 0.
292  cphadmtlm            do j=1,sny  #endif
293  cphadmtlm               do i=1,snx  
 cphadmtlm                  g_objf_state_final(i,j,1,1,1) = 0.  
 cphadmtlm                  g_objf_state_final(i,j,1,1,2) = 0.  
 cphadmtlm               enddo  
 cphadmtlm            enddo  
 cphadmtlm)  
294              call g_the_main_loop( mytime, myiter, mythid )              call g_the_main_loop( mytime, myiter, mythid )
295  cphadmtlm(  #ifdef ALLOW_ADMTLM
296                ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)
297    #else
298              ftlxxmemo = g_fc              ftlxxmemo = g_fc
299  cphadmtlm            ftlxxmemo = g_objf_state_final(45,4,1,1,1)  #endif
300  cphadmtlm)  
             _BARRIER  
301  c--  c--
302  c--   3. reset control vector  c--   3. reset control vector
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
303                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,
304       &              itile, jtile, layer,       &              itile, jtile, layer,
305       &              itilepos, jtilepos,       &              itilepos, jtilepos,
306       &              xxmemo_ref, mythid )       &              xxmemo_ref, ierr, mythid )
             endif  
             _BARRIER  
307    
308  #endif /* ALLOW_TANGENTLINEAR_RUN */  #endif /* ALLOW_TANGENTLINEAR_RUN */
309    
# Line 290  c--   get control vector component from Line 316  c--   get control vector component from
316  c--   perturb it and write back to file  c--   perturb it and write back to file
317  c--   positive perturbation  c--   positive perturbation
318              localEps = abs(grdchk_eps)              localEps = abs(grdchk_eps)
319              if ( myProcId .EQ. grdchkwhichproc .AND.              call grdchk_getxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                call grdchk_getxx( icvrec, FORWARD_SIMULATION,  
320       &              itile, jtile, layer,       &              itile, jtile, layer,
321       &              itilepos, jtilepos,       &              itilepos, jtilepos,
322       &              xxmemo_ref, xxmemo_pert, localEps,       &              xxmemo_ref, xxmemo_pert, localEps,
323       &              mythid )       &              ierr, mythid )
324              endif  
             _BARRIER  
                       
325  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
326              mytime = starttime              mytime = starttime
327              myiter = niter0              myiter = niter0
328    #ifdef ALLOW_AUTODIFF_OPENAD
329                call OpenAD_the_main_loop( mytime, myiter, mythid )
330    #else
331              call the_main_loop( mytime, myiter, mythid )              call the_main_loop( mytime, myiter, mythid )
332  cphadmtlm(  #endif
333    
334    #if (defined (ALLOW_ADMTLM))
335                fcpertplus = objf_state_final(idep,jdep,1,1,1)
336    #elif (defined (ALLOW_AUTODIFF_OPENAD))
337                fcpertplus = fc%v
338    #else
339              fcpertplus = fc              fcpertplus = fc
340  cphadmtlm            fcpertplus = objf_state_final(45,4,1,1,1)  #endif
341  cphadmtlm)              print *, 'ph-check fcpertplus  = ', fcpertplus
342              print *, 'ph-check fcpertplus = ', fcpertplus  
             _BARRIER  
                     
343  c--   Reset control vector.  c--   Reset control vector.
344              if ( myProcId .EQ. grdchkwhichproc .AND.              call grdchk_setxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                call grdchk_setxx( icvrec, FORWARD_SIMULATION,  
345       &              itile, jtile, layer,       &              itile, jtile, layer,
346       &              itilepos, jtilepos,       &              itilepos, jtilepos,
347       &              xxmemo_ref, mythid )       &              xxmemo_ref, ierr, mythid )
             endif  
             _BARRIER  
348    
349              fcpertminus = fcref              fcpertminus = fcref
350              print *, 'ph-check fcpertminus = ', fcpertminus              print *, 'ph-check fcpertminus = ', fcpertminus
# Line 329  c--   Reset control vector. Line 354  c--   Reset control vector.
354  c--   get control vector component from file  c--   get control vector component from file
355  c--   perturb it and write back to file  c--   perturb it and write back to file
356  c--   repeat the proceedure for a negative perturbation  c--   repeat the proceedure for a negative perturbation
357                 if ( myProcId .EQ. grdchkwhichproc .AND.                 localEps = - abs(grdchk_eps)
358       &           ierr .EQ. 0 ) then                 call grdchk_getxx( icvrec, FORWARD_SIMULATION,
                   localEps = - abs(grdchk_eps)  
                   call grdchk_getxx( icvrec, FORWARD_SIMULATION,  
359       &                 itile, jtile, layer,       &                 itile, jtile, layer,
360       &                 itilepos, jtilepos,       &                 itilepos, jtilepos,
361       &                 xxmemo_ref, xxmemo_pert, localEps,       &                 xxmemo_ref, xxmemo_pert, localEps,
362       &                 mythid )       &                 ierr, mythid )
363                 endif  
                _BARRIER  
                       
364  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
365                 mytime = starttime                 mytime = starttime
366                 myiter = niter0                 myiter = niter0
367    #ifdef ALLOW_AUTODIFF_OPENAD
368                   call OpenAD_the_main_loop( mytime, myiter, mythid )
369    #else
370                 call the_main_loop( mytime, myiter, mythid )                 call the_main_loop( mytime, myiter, mythid )
371                 _BARRIER  #endif
372    
373    #if (defined (ALLOW_ADMTLM))
374                   fcpertminus = objf_state_final(idep,jdep,1,1,1)
375    #elif (defined (ALLOW_AUTODIFF_OPENAD))
376                   fcpertminus = fc%v
377    #else
378                 fcpertminus = fc                 fcpertminus = fc
379                      #endif
380    
381  c--   Reset control vector.  c--   Reset control vector.
382                 if ( myProcId .EQ. grdchkwhichproc .AND.                 call grdchk_setxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                   call grdchk_setxx( icvrec, FORWARD_SIMULATION,  
383       &                 itile, jtile, layer,       &                 itile, jtile, layer,
384       &                 itilepos, jtilepos,       &                 itilepos, jtilepos,
385       &                 xxmemo_ref, mythid )       &                 xxmemo_ref, ierr, mythid )
                endif  
                _BARRIER  
386    
387  c-- end of if useCentralDiff ...  c-- end of if useCentralDiff ...
388              end if              end if
# Line 364  c*************************************** Line 391  c***************************************
391  c--   (D): calculate relative differences between gradients  c--   (D): calculate relative differences between gradients
392  c******************************************************  c******************************************************
393    
394                if ( grdchk_eps .eq. 0. ) then
395                   gfd = (fcpertplus-fcpertminus)
396                else
397                   gfd = (fcpertplus-fcpertminus)
398         &              /(grdchk_epsfac*grdchk_eps)
399                endif
400    
401                if ( adxxmemo .eq. 0. ) then
402                   ratio_ad = abs( adxxmemo - gfd )
403                else
404                   ratio_ad = 1. - gfd/adxxmemo
405                endif
406    
407                if ( ftlxxmemo .eq. 0. ) then
408                   ratio_ftl = abs( ftlxxmemo - gfd )
409                else
410                   ratio_ftl = 1. - gfd/ftlxxmemo
411                endif
412    
413              if ( myProcId .EQ. grdchkwhichproc .AND.              if ( myProcId .EQ. grdchkwhichproc .AND.
414       &           ierr .EQ. 0 ) then       &           ierr .EQ. 0 ) then
   
                if ( grdchk_eps .eq. 0. ) then  
                   gfd = (fcpertplus-fcpertminus)  
                else  
                   gfd = (fcpertplus-fcpertminus)  
      &                 /(grdchk_epsfac*grdchk_eps)  
                endif  
                       
                if ( adxxmemo .eq. 0. ) then  
                   ratio_ad = abs( adxxmemo - gfd )  
                else  
                   ratio_ad = 1. - gfd/adxxmemo  
                endif  
   
                if ( ftlxxmemo .eq. 0. ) then  
                   ratio_ftl = abs( ftlxxmemo - gfd )  
                else  
                   ratio_ftl = 1. - gfd/ftlxxmemo  
                endif  
                     
415                 tmpplot1(itilepos,jtilepos,layer,itile,jtile)                 tmpplot1(itilepos,jtilepos,layer,itile,jtile)
416       &              = gfd       &              = gfd
417                 tmpplot2(itilepos,jtilepos,layer,itile,jtile)                 tmpplot2(itilepos,jtilepos,layer,itile,jtile)
418       &              = ratio_ad       &              = ratio_ad
419                 tmpplot3(itilepos,jtilepos,layer,itile,jtile)                 tmpplot3(itilepos,jtilepos,layer,itile,jtile)
420       &              = ratio_ftl       &              = ratio_ftl
421                endif
422    
423                if ( ierr .EQ. 0 ) then
424                 fcrmem      ( ichknum ) = fcref                 fcrmem      ( ichknum ) = fcref
425                 fcppmem     ( ichknum ) = fcpertplus                 fcppmem     ( ichknum ) = fcpertplus
426                 fcpmmem     ( ichknum ) = fcpertminus                 fcpmmem     ( ichknum ) = fcpertminus
# Line 415  c*************************************** Line 443  c***************************************
443                 ichkmem   ( ichknum ) = ichknum                 ichkmem   ( ichknum ) = ichknum
444                 itestmem  ( ichknum ) = itest                 itestmem  ( ichknum ) = itest
445                 ierrmem   ( ichknum ) = ierr                 ierrmem   ( ichknum ) = ierr
446                                     icglomem  ( ichknum ) = icglo
447                 print *, 'grad-res -------------------------------'              endif
448                 print '(a,5I5,2x,3(1x,E15.9))', ' grad-res ',  
449       &              myprocid,ichknum,itilepos,jtilepos,layer,              if ( myProcId .EQ. grdchkwhichproc .AND.
450         &           ierr .EQ. 0 ) then
451    
452                   WRITE(standardmessageunit,'(A)')
453         &             'grad-res -------------------------------'
454                   WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
455         &              ' grad-res ',myprocid,ichknum,itilepos,jtilepos,
456         &              layer,itile,jtile,obcspos,
457       &              fcref, fcpertplus, fcpertminus       &              fcref, fcpertplus, fcpertminus
458  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
459                 print '(a,5I5,2x,3(1x,E15.9))', ' grad-res ',                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
460       &              myprocid,ichknum,ichkmem(ichknum),       &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
461       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
462         &              bimem(ichknum),bjmem(ichknum),iobcsmem(ichknum),
463       &              ftlxxmemo, gfd, ratio_ftl       &              ftlxxmemo, gfd, ratio_ftl
                WRITE(msgBuf,'(A34,2(1PE24.14,X))')  
      &              'precision_grdchk_result TLM ', fcref, ftlxxmemo  
                CALL PRINT_MESSAGE  
      &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)  
464  #else  #else
465                 print '(a,5I5,2x,3(1x,E15.9))', ' grad-res ',                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
466       &              myprocid,ichknum,ichkmem(ichknum),       &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
467       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
468         &              bimem(ichknum),bjmem(ichknum),obcspos,
469       &              adxxmemo, gfd, ratio_ad       &              adxxmemo, gfd, ratio_ad
                WRITE(msgBuf,'(A34,2(1PE24.14,X))')  
      &              'precision_grdchk_result ADM ', fcref, adxxmemo  
                CALL PRINT_MESSAGE  
      &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)  
470  #endif  #endif
   
471              endif              endif
472    #ifdef ALLOW_TANGENTLINEAR_RUN
473                WRITE(msgBuf,'(A30,1PE22.14)')
474         &              ' TLM  ref_cost_function      =', fcref
475                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
476         &                          SQUEEZE_RIGHT, myThid )
477                WRITE(msgBuf,'(A30,1PE22.14)')
478         &              ' TLM  tangent-lin_grad       =', ftlxxmemo
479                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
480         &                          SQUEEZE_RIGHT, myThid )
481                WRITE(msgBuf,'(A30,1PE22.14)')
482         &              ' TLM  finite-diff_grad       =', gfd
483                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
484         &                          SQUEEZE_RIGHT, myThid )
485    #else
486                WRITE(msgBuf,'(A30,1PE22.14)')
487         &              ' ADM  ref_cost_function      =', fcref
488                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
489         &                          SQUEEZE_RIGHT, myThid )
490                WRITE(msgBuf,'(A30,1PE22.14)')
491         &              ' ADM  adjoint_gradient       =', adxxmemo
492                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
493         &                          SQUEEZE_RIGHT, myThid )
494                WRITE(msgBuf,'(A30,1PE22.14)')
495         &              ' ADM  finite-diff_grad       =', gfd
496                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
497         &                          SQUEEZE_RIGHT, myThid )
498    #endif
499    
500              print *, 'ph-grd  ierr ---------------------------'              print *, 'ph-grd  ierr ---------------------------'
501              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,
502       &           ', ichknum = ', ichknum       &           ', ichknum = ', ichknum
503    
             _BARRIER  
   
504  c-- else of if ( ichknum ...  c-- else of if ( ichknum ...
505           else           else
506              ierr_grdchk = -1              ierr_grdchk = -1
507    
508  c-- end of if ( ichknum ...  c-- end of if ( ichknum ...
509           endif           endif
510    
511  c-- end of do icomp = ...  c-- end of do icomp = ...
512        enddo        enddo
513    
514        if ( myProcId .EQ. grdchkwhichproc ) then        if (myProcId .EQ. grdchkwhichproc .AND. .NOT.useSingleCpuIO) then
515           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
516       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)
517           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
518       &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)       &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)
519           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
520       &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)       &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)
521        endif        endif
522    
523  c--   Everyone has to wait for the component to be reset.  c--   Everyone has to wait for the component to be reset.
524        _BARRIER  c     _BARRIER
525    
526  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
527        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
528    
529  #endif /* ALLOW_GRDCHK */  #endif /* ALLOW_GRDCHK */
530    
531          return
532        end        end
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.40
  ViewVC Help
Powered by ViewVC 1.1.22