/[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.10 by edhill, Thu Oct 23 04:41:40 2003 UTC revision 1.39 by gforget, Tue Aug 21 19:49:41 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_GRADIENT_CHECK  #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 128  c     == local variables == Line 129  c     == local variables ==
129        _RL tmpplot2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)        _RL tmpplot2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
130        _RL tmpplot3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)        _RL tmpplot3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
131    
132          CHARACTER*(MAX_LEN_MBUF) msgBuf
133    
134  c     == end of interface ==  c     == end of interface ==
135  CEOP  CEOP
136    
# Line 141  c--   Set the loop ranges. Line 144  c--   Set the loop ranges.
144        imin = 1        imin = 1
145        imax = snx        imax = snx
146    
147          print *, 'ph-check entering grdchk_main '
148    
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    #ifdef ALLOW_ADMTLM
163          fcref = objf_state_final(idep,jdep,1,1,1)
164    #else
165        fcref = fc        fcref = fc
166  cphadmtlm      fcref = objf_state_final(45,4,1,1)  #endif
 cphadmtlm)  
167    
168        print *, 'ph-check fcref = ', fcref        print *, 'ph-check fcref = ', fcref
169    
# Line 178  cphadmtlm) Line 187  cphadmtlm)
187           grdchk_epsfac = 1. _d 0           grdchk_epsfac = 1. _d 0
188        end if        end if
189    
190        print *, 'ph-grd 3 -------------------------------'        WRITE(standardmessageunit,'(A)')
191        print ('(2a)'),       &    'grad-res -------------------------------'
192       &     ' ph-grd 3  proc    #    i    j    k            fc ref',        WRITE(standardmessageunit,'(2a)')
193       &     '        fc + eps        fc - eps'       &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
194         &    '               fc ref           fc + eps           fc - eps'
195  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
196        print ('(2a)'),        WRITE(standardmessageunit,'(2a)')
197       &     ' ph-grd 3  proc    #    i    j    k          tlm grad',       &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
198       &     '         fd grad      1 - fd/tlm'       &    '             tlm grad            fd grad         1 - fd/tlm'
199  #else  #else
200        print ('(2a)'),        WRITE(standardmessageunit,'(2a)')
201       &     ' ph-grd 3  proc    #    i    j    k          adj grad',       &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
202       &     '         fd grad      1 - fd/adj'       &    '             adj grad            fd grad         1 - fd/adj'
203  #endif  #endif
204    
205  c--   Compute the finite difference approximations.  c--   Compute the finite difference approximations.
206  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep
207  c--   gradient checks.  c--   gradient checks.
208    
209          if ( nbeg .EQ. 0 )
210         &     call grdchk_get_position( mythid )
211    
212        do icomp = nbeg, nend, nstep        do icomp = nbeg, nend, nstep
213    
214           ichknum = (icomp - nbeg)/nstep + 1           ichknum = (icomp - nbeg)/nstep + 1
215             adxxmemo  = 0.
216    
217    cph(
218    cph-print         print *, 'ph-grd _main: nbeg, icomp, ichknum ',
219    cph-print     &        nbeg, icomp, ichknum
220    cph)
221           if (ichknum .le. maxgrdchecks ) then           if (ichknum .le. maxgrdchecks ) then
222    
223  c--         Determine the location of icomp on the grid.  c--         Determine the location of icomp on the grid.
224              if ( myProcId .EQ. grdchkwhichproc ) then              if ( myProcId .EQ. grdchkwhichproc ) then
225                 call grdchk_loc( icomp, ichknum,                 call grdchk_loc( icomp, ichknum,
226       &              icvrec, itile, jtile, layer, obcspos,       &              icvrec, itile, jtile, layer, obcspos,
227       &              itilepos, jtilepos, itest, ierr,       &              itilepos, jtilepos, icglo, itest, ierr,
228       &              mythid )       &              mythid )
229    cph(
230    cph-print               print *, 'ph-grd ----- back from loc -----',
231    cph-print     &             icvrec, itilepos, jtilepos, layer, obcspos
232    cph)
233                else
234                  icvrec   = 0
235                  itile    = 0
236                  jtile    = 0
237                  layer    = 0
238                  obcspos  = 0
239                  itilepos = 0
240                  jtilepos = 0
241                  icglo    = 0
242                  itest    = 0
243              endif              endif
244              _BARRIER  
245                  c make sure that all procs have correct file records, so that useSingleCpuIO works
246          CALL GLOBAL_SUM_INT( icvrec , myThid )
247          CALL GLOBAL_SUM_INT( layer , myThid )
248          CALL GLOBAL_SUM_INT( ierr , myThid )
249    
250  c******************************************************  c******************************************************
251  c--   (A): get gradient component calculated via adjoint  c--   (A): get gradient component calculated via adjoint
252  c******************************************************  c******************************************************
253    
254  c--   get gradient component calculated via adjoint  c--   get gradient component calculated via adjoint
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
255                 call grdchk_getadxx( icvrec,                 call grdchk_getadxx( icvrec,
256       &              itile, jtile, layer,       &              itile, jtile, layer,
257       &              itilepos, jtilepos,       &              itilepos, jtilepos,
258       &              adxxmemo, mythid )       &              adxxmemo, ierr, mythid )
259              endif  C--   Add a global-sum call so that all proc will get the adjoint gradient
260              _BARRIER              _GLOBAL_SUM_RL( adxxmemo, myThid )
261    
262  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
263  c******************************************************  c******************************************************
# Line 232  c*************************************** Line 266  c***************************************
266  c--  c--
267  c--   1. perturb control vector component: xx(i)=1.  c--   1. perturb control vector component: xx(i)=1.
268    
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
269                 localEps = 1. _d 0                 localEps = 1. _d 0
270                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,
271       &              itile, jtile, layer,       &              itile, jtile, layer,
272       &              itilepos, jtilepos,       &              itilepos, jtilepos,
273       &              xxmemo_ref, xxmemo_pert, localEps,       &              xxmemo_ref, xxmemo_pert, localEps,
274       &              mythid )       &              ierr, mythid )
             endif  
             _BARRIER  
275    
276  c--  c--
277  c--   2. perform tangent linear run  c--   2. perform tangent linear run
278              mytime = starttime              mytime = starttime
279              myiter = niter0              myiter = niter0
280  cphadmtlm(  #ifdef ALLOW_ADMTLM
281                do k=1,4*Nr+1
282                 do j=1,sny
283                  do i=1,snx
284                   g_objf_state_final(i,j,1,1,k) = 0.
285                  enddo
286                 enddo
287                enddo
288    #else
289              g_fc = 0.              g_fc = 0.
290  cphadmtlm            do j=1,sny  #endif
291  cphadmtlm               do i=1,snx  
 cphadmtlm                  g_objf_state_final(i,j,1,1) = 0.  
 cphadmtlm               enddo  
 cphadmtlm            enddo  
 cphadmtlm)  
292              call g_the_main_loop( mytime, myiter, mythid )              call g_the_main_loop( mytime, myiter, mythid )
293  cphadmtlm(  #ifdef ALLOW_ADMTLM
294                ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)
295    #else
296              ftlxxmemo = g_fc              ftlxxmemo = g_fc
297  cphadmtlm            ftlxxmemo = g_objf_state_final(45,4,1,1)  #endif
298  cphadmtlm)  
             _BARRIER  
299  c--  c--
300  c--   3. reset control vector  c--   3. reset control vector
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
301                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,
302       &              itile, jtile, layer,       &              itile, jtile, layer,
303       &              itilepos, jtilepos,       &              itilepos, jtilepos,
304       &              xxmemo_ref, mythid )       &              xxmemo_ref, ierr, mythid )
             endif  
             _BARRIER  
305    
306  #endif /* ALLOW_TANGENTLINEAR_RUN */  #endif /* ALLOW_TANGENTLINEAR_RUN */
307    
# Line 283  c--   get control vector component from Line 314  c--   get control vector component from
314  c--   perturb it and write back to file  c--   perturb it and write back to file
315  c--   positive perturbation  c--   positive perturbation
316              localEps = abs(grdchk_eps)              localEps = abs(grdchk_eps)
317              if ( myProcId .EQ. grdchkwhichproc .AND.              call grdchk_getxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                call grdchk_getxx( icvrec, FORWARD_SIMULATION,  
318       &              itile, jtile, layer,       &              itile, jtile, layer,
319       &              itilepos, jtilepos,       &              itilepos, jtilepos,
320       &              xxmemo_ref, xxmemo_pert, localEps,       &              xxmemo_ref, xxmemo_pert, localEps,
321       &              mythid )       &              ierr, mythid )
322              endif  
             _BARRIER  
                       
323  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
324              mytime = starttime              mytime = starttime
325              myiter = niter0              myiter = niter0
326              call the_main_loop( mytime, myiter, mythid )              call the_main_loop( mytime, myiter, mythid )
327  cphadmtlm(  #ifdef ALLOW_ADMTLM
328                fcpertplus = objf_state_final(idep,jdep,1,1,1)
329    #else
330              fcpertplus = fc              fcpertplus = fc
331  cphadmtlm            fcpertplus = objf_state_final(45,4,1,1)  #endif
332  cphadmtlm)              print *, 'ph-check fcpertplus  = ', fcpertplus
333              _BARRIER  
                     
334  c--   Reset control vector.  c--   Reset control vector.
335              if ( myProcId .EQ. grdchkwhichproc .AND.              call grdchk_setxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                call grdchk_setxx( icvrec, FORWARD_SIMULATION,  
336       &              itile, jtile, layer,       &              itile, jtile, layer,
337       &              itilepos, jtilepos,       &              itilepos, jtilepos,
338       &              xxmemo_ref, mythid )       &              xxmemo_ref, ierr, mythid )
             endif  
             _BARRIER  
339    
340              fcpertminus = fcref              fcpertminus = fcref
341                print *, 'ph-check fcpertminus = ', fcpertminus
342    
343              if ( useCentralDiff ) then              if ( useCentralDiff ) then
344    
345  c--   get control vector component from file  c--   get control vector component from file
346  c--   perturb it and write back to file  c--   perturb it and write back to file
347  c--   repeat the proceedure for a negative perturbation  c--   repeat the proceedure for a negative perturbation
348                 if ( myProcId .EQ. grdchkwhichproc .AND.                 localEps = - abs(grdchk_eps)
349       &           ierr .EQ. 0 ) then                 call grdchk_getxx( icvrec, FORWARD_SIMULATION,
                   localEps = - abs(grdchk_eps)  
                   call grdchk_getxx( icvrec, FORWARD_SIMULATION,  
350       &                 itile, jtile, layer,       &                 itile, jtile, layer,
351       &                 itilepos, jtilepos,       &                 itilepos, jtilepos,
352       &                 xxmemo_ref, xxmemo_pert, localEps,       &                 xxmemo_ref, xxmemo_pert, localEps,
353       &                 mythid )       &                 ierr, mythid )
354                 endif  
                _BARRIER  
                       
355  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
356                 mytime = starttime                 mytime = starttime
357                 myiter = niter0                 myiter = niter0
358                 call the_main_loop( mytime, myiter, mythid )                 call the_main_loop( mytime, myiter, mythid )
359                 _BARRIER  #ifdef ALLOW_ADMTLM
360                   fcpertminus = objf_state_final(idep,jdep,1,1,1)
361    #else
362                 fcpertminus = fc                 fcpertminus = fc
363                      #endif
364    
365  c--   Reset control vector.  c--   Reset control vector.
366                 if ( myProcId .EQ. grdchkwhichproc .AND.                 call grdchk_setxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                   call grdchk_setxx( icvrec, FORWARD_SIMULATION,  
367       &                 itile, jtile, layer,       &                 itile, jtile, layer,
368       &                 itilepos, jtilepos,       &                 itilepos, jtilepos,
369       &                 xxmemo_ref, mythid )       &                 xxmemo_ref, ierr, mythid )
                endif  
                _BARRIER  
370    
371  c-- end of if useCentralDiff ...  c-- end of if useCentralDiff ...
372              end if              end if
# Line 355  c*************************************** Line 375  c***************************************
375  c--   (D): calculate relative differences between gradients  c--   (D): calculate relative differences between gradients
376  c******************************************************  c******************************************************
377    
378                if ( grdchk_eps .eq. 0. ) then
379                   gfd = (fcpertplus-fcpertminus)
380                else
381                   gfd = (fcpertplus-fcpertminus)
382         &              /(grdchk_epsfac*grdchk_eps)
383                endif
384    
385                if ( adxxmemo .eq. 0. ) then
386                   ratio_ad = abs( adxxmemo - gfd )
387                else
388                   ratio_ad = 1. - gfd/adxxmemo
389                endif
390    
391                if ( ftlxxmemo .eq. 0. ) then
392                   ratio_ftl = abs( ftlxxmemo - gfd )
393                else
394                   ratio_ftl = 1. - gfd/ftlxxmemo
395                endif
396    
397              if ( myProcId .EQ. grdchkwhichproc .AND.              if ( myProcId .EQ. grdchkwhichproc .AND.
398       &           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  
                     
399                 tmpplot1(itilepos,jtilepos,layer,itile,jtile)                 tmpplot1(itilepos,jtilepos,layer,itile,jtile)
400       &              = gfd       &              = gfd
401                 tmpplot2(itilepos,jtilepos,layer,itile,jtile)                 tmpplot2(itilepos,jtilepos,layer,itile,jtile)
402       &              = ratio_ad       &              = ratio_ad
403                 tmpplot3(itilepos,jtilepos,layer,itile,jtile)                 tmpplot3(itilepos,jtilepos,layer,itile,jtile)
404       &              = ratio_ftl       &              = ratio_ftl
405                endif
406    
407                if ( ierr .EQ. 0 ) then
408                 fcrmem      ( ichknum ) = fcref                 fcrmem      ( ichknum ) = fcref
409                 fcppmem     ( ichknum ) = fcpertplus                 fcppmem     ( ichknum ) = fcpertplus
410                 fcpmmem     ( ichknum ) = fcpertminus                 fcpmmem     ( ichknum ) = fcpertminus
# Line 406  c*************************************** Line 427  c***************************************
427                 ichkmem   ( ichknum ) = ichknum                 ichkmem   ( ichknum ) = ichknum
428                 itestmem  ( ichknum ) = itest                 itestmem  ( ichknum ) = itest
429                 ierrmem   ( ichknum ) = ierr                 ierrmem   ( ichknum ) = ierr
430                                     icglomem  ( ichknum ) = icglo
431                 print *, 'ph-grd 3 -------------------------------'              endif
432                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',  
433       &              myprocid,ichknum,itilepos,jtilepos,layer,              if ( myProcId .EQ. grdchkwhichproc .AND.
434         &           ierr .EQ. 0 ) then
435    
436                   WRITE(standardmessageunit,'(A)')
437         &             'grad-res -------------------------------'
438                   WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
439         &              ' grad-res ',myprocid,ichknum,itilepos,jtilepos,
440         &              layer,itile,jtile,obcspos,
441       &              fcref, fcpertplus, fcpertminus       &              fcref, fcpertplus, fcpertminus
442  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
443                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
444       &              myprocid,ichknum,ichkmem(ichknum),       &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
445       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
446         &              bimem(ichknum),bjmem(ichknum),iobcsmem(ichknum),
447       &              ftlxxmemo, gfd, ratio_ftl       &              ftlxxmemo, gfd, ratio_ftl
448  #else  #else
449                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
450       &              myprocid,ichknum,ichkmem(ichknum),       &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
451       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
452         &              bimem(ichknum),bjmem(ichknum),obcspos,
453       &              adxxmemo, gfd, ratio_ad       &              adxxmemo, gfd, ratio_ad
454  #endif  #endif
   
455              endif              endif
456    #ifdef ALLOW_TANGENTLINEAR_RUN
457                WRITE(msgBuf,'(A30,1PE22.14)')
458         &              ' TLM  ref_cost_function      =', fcref
459                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
460         &                          SQUEEZE_RIGHT, myThid )
461                WRITE(msgBuf,'(A30,1PE22.14)')
462         &              ' TLM  tangent-lin_grad       =', ftlxxmemo
463                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
464         &                          SQUEEZE_RIGHT, myThid )
465                WRITE(msgBuf,'(A30,1PE22.14)')
466         &              ' TLM  finite-diff_grad       =', gfd
467                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
468         &                          SQUEEZE_RIGHT, myThid )
469    #else
470                WRITE(msgBuf,'(A30,1PE22.14)')
471         &              ' ADM  ref_cost_function      =', fcref
472                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
473         &                          SQUEEZE_RIGHT, myThid )
474                WRITE(msgBuf,'(A30,1PE22.14)')
475         &              ' ADM  adjoint_gradient       =', adxxmemo
476                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
477         &                          SQUEEZE_RIGHT, myThid )
478                WRITE(msgBuf,'(A30,1PE22.14)')
479         &              ' ADM  finite-diff_grad       =', gfd
480                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
481         &                          SQUEEZE_RIGHT, myThid )
482    #endif
483    
484              print *, 'ph-grd  ierr ---------------------------'              print *, 'ph-grd  ierr ---------------------------'
485              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,
486       &           ', ichknum = ', ichknum       &           ', ichknum = ', ichknum
487    
             _BARRIER  
   
488  c-- else of if ( ichknum ...  c-- else of if ( ichknum ...
489           else           else
490              ierr_grdchk = -1              ierr_grdchk = -1
491    
492  c-- end of if ( ichknum ...  c-- end of if ( ichknum ...
493           endif           endif
494    
495  c-- end of do icomp = ...  c-- end of do icomp = ...
496        enddo        enddo
497    
498        if ( myProcId .EQ. grdchkwhichproc ) then        if (myProcId .EQ. grdchkwhichproc .AND. .NOT.useSingleCpuIO) then
499           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
500       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)
501           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
502       &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)       &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)
503           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
504       &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)       &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)
505        endif        endif
506    
507  c--   Everyone has to wait for the component to be reset.  c--   Everyone has to wait for the component to be reset.
508        _BARRIER  c     _BARRIER
509    
510  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
511        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
512    
513  #endif /* ALLOW_GRADIENT_CHECK */  #endif /* ALLOW_GRDCHK */
514    
515          return
516        end        end
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.39
  ViewVC Help
Powered by ViewVC 1.1.22