/[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.3.6.5 by heimbach, Fri Jun 20 19:38:59 2003 UTC revision 1.38 by gforget, Tue Aug 21 14:00:04 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "GRDCHK_OPTIONS.h"
5    #include "AD_CONFIG.h"
6    
7  CBOI  CBOI
8  C  C
# Line 30  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 63  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 78  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
85    #include "g_cost.h"
86    #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 103  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 122  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  #ifdef ALLOW_TANGENTLINEAR_RUN        CHARACTER*(MAX_LEN_MBUF) msgBuf
       _RL     g_fc  
       common /g_cost_r/ g_fc  
 #endif  
133    
134  c     == end of interface ==  c     == end of interface ==
135  CEOP  CEOP
# Line 140  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        fcref = fc        ierr      = 0
159        ierr_grdchk = 0        ierr_grdchk = 0
160          adxxmemo  = 0.
161          ftlxxmemo = 0.
162    #ifdef ALLOW_ADMTLM
163          fcref = objf_state_final(idep,jdep,1,1,1)
164    #else
165          fcref = fc
166    #endif
167    
168          print *, 'ph-check fcref = ', fcref
169    
170        do bj = jtlo, jthi        do bj = jtlo, jthi
171           do bi = itlo, ithi           do bi = itlo, ithi
# Line 172  cph   assuming all xx_ fields are initia Line 187  cph   assuming all xx_ fields are initia
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    
249  c******************************************************  c******************************************************
250  c--   (A): get gradient component calculated via adjoint  c--   (A): get gradient component calculated via adjoint
251  c******************************************************  c******************************************************
252    
253  c--   get gradient component calculated via adjoint  c--   get gradient component calculated via adjoint
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
254                 call grdchk_getadxx( icvrec,                 call grdchk_getadxx( icvrec,
255       &              itile, jtile, layer,       &              itile, jtile, layer,
256       &              itilepos, jtilepos,       &              itilepos, jtilepos,
257       &              adxxmemo, mythid )       &              adxxmemo, ierr, mythid )
258              endif  C--   Add a global-sum call so that all proc will get the adjoint gradient
259              _BARRIER              _GLOBAL_SUM_RL( adxxmemo, myThid )
260    
261  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
262  c******************************************************  c******************************************************
# Line 226  c*************************************** Line 265  c***************************************
265  c--  c--
266  c--   1. perturb control vector component: xx(i)=1.  c--   1. perturb control vector component: xx(i)=1.
267    
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
268                 localEps = 1. _d 0                 localEps = 1. _d 0
269                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,
270       &              itile, jtile, layer,       &              itile, jtile, layer,
271       &              itilepos, jtilepos,       &              itilepos, jtilepos,
272       &              xxmemo_ref, xxmemo_pert, localEps,       &              xxmemo_ref, xxmemo_pert, localEps,
273       &              mythid )       &              ierr, mythid )
             endif  
             _BARRIER  
274    
275  c--  c--
276  c--   2. perform tangent linear run  c--   2. perform tangent linear run
277              mytime = starttime              mytime = starttime
278              myiter = niter0              myiter = niter0
279    #ifdef ALLOW_ADMTLM
280                do k=1,4*Nr+1
281                 do j=1,sny
282                  do i=1,snx
283                   g_objf_state_final(i,j,1,1,k) = 0.
284                  enddo
285                 enddo
286                enddo
287    #else
288              g_fc = 0.              g_fc = 0.
289    #endif
290    
291              call g_the_main_loop( mytime, myiter, mythid )              call g_the_main_loop( mytime, myiter, mythid )
292    #ifdef ALLOW_ADMTLM
293                ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)
294    #else
295              ftlxxmemo = g_fc              ftlxxmemo = g_fc
296              _BARRIER  #endif
297    
298  c--  c--
299  c--   3. reset control vector  c--   3. reset control vector
             if ( myProcId .EQ. grdchkwhichproc .AND.  
      &           ierr .EQ. 0 ) then  
300                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,
301       &              itile, jtile, layer,       &              itile, jtile, layer,
302       &              itilepos, jtilepos,       &              itilepos, jtilepos,
303       &              xxmemo_ref, mythid )       &              xxmemo_ref, ierr, mythid )
             endif  
             _BARRIER  
304    
305  #endif /* ALLOW_TANGENTLINEAR_RUN */  #endif /* ALLOW_TANGENTLINEAR_RUN */
306    
# Line 267  c--   get control vector component from Line 313  c--   get control vector component from
313  c--   perturb it and write back to file  c--   perturb it and write back to file
314  c--   positive perturbation  c--   positive perturbation
315              localEps = abs(grdchk_eps)              localEps = abs(grdchk_eps)
316              if ( myProcId .EQ. grdchkwhichproc .AND.              call grdchk_getxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                call grdchk_getxx( icvrec, FORWARD_SIMULATION,  
317       &              itile, jtile, layer,       &              itile, jtile, layer,
318       &              itilepos, jtilepos,       &              itilepos, jtilepos,
319       &              xxmemo_ref, xxmemo_pert, localEps,       &              xxmemo_ref, xxmemo_pert, localEps,
320       &              mythid )       &              ierr, mythid )
321              endif  
             _BARRIER  
                       
322  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
323              mytime = starttime              mytime = starttime
324              myiter = niter0              myiter = niter0
325              call the_main_loop( mytime, myiter, mythid )              call the_main_loop( mytime, myiter, mythid )
326    #ifdef ALLOW_ADMTLM
327                fcpertplus = objf_state_final(idep,jdep,1,1,1)
328    #else
329              fcpertplus = fc              fcpertplus = fc
330              _BARRIER  #endif
331                                  print *, 'ph-check fcpertplus  = ', fcpertplus
332    
333  c--   Reset control vector.  c--   Reset control vector.
334              if ( myProcId .EQ. grdchkwhichproc .AND.              call grdchk_setxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                call grdchk_setxx( icvrec, FORWARD_SIMULATION,  
335       &              itile, jtile, layer,       &              itile, jtile, layer,
336       &              itilepos, jtilepos,       &              itilepos, jtilepos,
337       &              xxmemo_ref, mythid )       &              xxmemo_ref, ierr, mythid )
             endif  
             _BARRIER  
338    
339              fcpertminus = fcref              fcpertminus = fcref
340                print *, 'ph-check fcpertminus = ', fcpertminus
341    
342              if ( useCentralDiff ) then              if ( useCentralDiff ) then
343    
344  c--   get control vector component from file  c--   get control vector component from file
345  c--   perturb it and write back to file  c--   perturb it and write back to file
346  c--   repeat the proceedure for a negative perturbation  c--   repeat the proceedure for a negative perturbation
347                 if ( myProcId .EQ. grdchkwhichproc .AND.                 localEps = - abs(grdchk_eps)
348       &           ierr .EQ. 0 ) then                 call grdchk_getxx( icvrec, FORWARD_SIMULATION,
                   localEps = - abs(grdchk_eps)  
                   call grdchk_getxx( icvrec, FORWARD_SIMULATION,  
349       &                 itile, jtile, layer,       &                 itile, jtile, layer,
350       &                 itilepos, jtilepos,       &                 itilepos, jtilepos,
351       &                 xxmemo_ref, xxmemo_pert, localEps,       &                 xxmemo_ref, xxmemo_pert, localEps,
352       &                 mythid )       &                 ierr, mythid )
353                 endif  
                _BARRIER  
                       
354  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
355                 mytime = starttime                 mytime = starttime
356                 myiter = niter0                 myiter = niter0
357                 call the_main_loop( mytime, myiter, mythid )                 call the_main_loop( mytime, myiter, mythid )
358                 _BARRIER  #ifdef ALLOW_ADMTLM
359                   fcpertminus = objf_state_final(idep,jdep,1,1,1)
360    #else
361                 fcpertminus = fc                 fcpertminus = fc
362                      #endif
363    
364  c--   Reset control vector.  c--   Reset control vector.
365                 if ( myProcId .EQ. grdchkwhichproc .AND.                 call grdchk_setxx( icvrec, FORWARD_SIMULATION,
      &           ierr .EQ. 0 ) then  
                   call grdchk_setxx( icvrec, FORWARD_SIMULATION,  
366       &                 itile, jtile, layer,       &                 itile, jtile, layer,
367       &                 itilepos, jtilepos,       &                 itilepos, jtilepos,
368       &                 xxmemo_ref, mythid )       &                 xxmemo_ref, ierr, mythid )
                endif  
                _BARRIER  
369    
370  c-- end of if useCentralDiff ...  c-- end of if useCentralDiff ...
371              end if              end if
# Line 336  c*************************************** Line 374  c***************************************
374  c--   (D): calculate relative differences between gradients  c--   (D): calculate relative differences between gradients
375  c******************************************************  c******************************************************
376    
377                if ( grdchk_eps .eq. 0. ) then
378                   gfd = (fcpertplus-fcpertminus)
379                else
380                   gfd = (fcpertplus-fcpertminus)
381         &              /(grdchk_epsfac*grdchk_eps)
382                endif
383    
384                if ( adxxmemo .eq. 0. ) then
385                   ratio_ad = abs( adxxmemo - gfd )
386                else
387                   ratio_ad = 1. - gfd/adxxmemo
388                endif
389    
390                if ( ftlxxmemo .eq. 0. ) then
391                   ratio_ftl = abs( ftlxxmemo - gfd )
392                else
393                   ratio_ftl = 1. - gfd/ftlxxmemo
394                endif
395    
396              if ( myProcId .EQ. grdchkwhichproc .AND.              if ( myProcId .EQ. grdchkwhichproc .AND.
397       &           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  
                     
398                 tmpplot1(itilepos,jtilepos,layer,itile,jtile)                 tmpplot1(itilepos,jtilepos,layer,itile,jtile)
399       &              = gfd       &              = gfd
400                 tmpplot2(itilepos,jtilepos,layer,itile,jtile)                 tmpplot2(itilepos,jtilepos,layer,itile,jtile)
401       &              = ratio_ad       &              = ratio_ad
402                 tmpplot3(itilepos,jtilepos,layer,itile,jtile)                 tmpplot3(itilepos,jtilepos,layer,itile,jtile)
403       &              = ratio_ftl       &              = ratio_ftl
404                endif
405    
406                if ( ierr .EQ. 0 ) then
407                 fcrmem      ( ichknum ) = fcref                 fcrmem      ( ichknum ) = fcref
408                 fcppmem     ( ichknum ) = fcpertplus                 fcppmem     ( ichknum ) = fcpertplus
409                 fcpmmem     ( ichknum ) = fcpertminus                 fcpmmem     ( ichknum ) = fcpertminus
# Line 387  c*************************************** Line 426  c***************************************
426                 ichkmem   ( ichknum ) = ichknum                 ichkmem   ( ichknum ) = ichknum
427                 itestmem  ( ichknum ) = itest                 itestmem  ( ichknum ) = itest
428                 ierrmem   ( ichknum ) = ierr                 ierrmem   ( ichknum ) = ierr
429                                     icglomem  ( ichknum ) = icglo
430                 print *, 'ph-grd 3 -------------------------------'              endif
431                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',  
432       &              myprocid,ichknum,itilepos,jtilepos,layer,              if ( myProcId .EQ. grdchkwhichproc .AND.
433         &           ierr .EQ. 0 ) then
434    
435                   WRITE(standardmessageunit,'(A)')
436         &             'grad-res -------------------------------'
437                   WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
438         &              ' grad-res ',myprocid,ichknum,itilepos,jtilepos,
439         &              layer,itile,jtile,obcspos,
440       &              fcref, fcpertplus, fcpertminus       &              fcref, fcpertplus, fcpertminus
441  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
442                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
443       &              myprocid,ichknum,ichkmem(ichknum),       &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
444       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
445         &              bimem(ichknum),bjmem(ichknum),iobcsmem(ichknum),
446       &              ftlxxmemo, gfd, ratio_ftl       &              ftlxxmemo, gfd, ratio_ftl
447  #else  #else
448                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
449       &              myprocid,ichknum,ichkmem(ichknum),       &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
450       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
451         &              bimem(ichknum),bjmem(ichknum),obcspos,
452       &              adxxmemo, gfd, ratio_ad       &              adxxmemo, gfd, ratio_ad
453  #endif  #endif
   
454              endif              endif
455    #ifdef ALLOW_TANGENTLINEAR_RUN
456                WRITE(msgBuf,'(A30,1PE22.14)')
457         &              ' TLM  ref_cost_function      =', fcref
458                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
459         &                          SQUEEZE_RIGHT, myThid )
460                WRITE(msgBuf,'(A30,1PE22.14)')
461         &              ' TLM  tangent-lin_grad       =', ftlxxmemo
462                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
463         &                          SQUEEZE_RIGHT, myThid )
464                WRITE(msgBuf,'(A30,1PE22.14)')
465         &              ' TLM  finite-diff_grad       =', gfd
466                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
467         &                          SQUEEZE_RIGHT, myThid )
468    #else
469                WRITE(msgBuf,'(A30,1PE22.14)')
470         &              ' ADM  ref_cost_function      =', fcref
471                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
472         &                          SQUEEZE_RIGHT, myThid )
473                WRITE(msgBuf,'(A30,1PE22.14)')
474         &              ' ADM  adjoint_gradient       =', adxxmemo
475                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
476         &                          SQUEEZE_RIGHT, myThid )
477                WRITE(msgBuf,'(A30,1PE22.14)')
478         &              ' ADM  finite-diff_grad       =', gfd
479                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
480         &                          SQUEEZE_RIGHT, myThid )
481    #endif
482    
483              print *, 'ph-grd  ierr ---------------------------'              print *, 'ph-grd  ierr ---------------------------'
484              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,
485       &           ', ichknum = ', ichknum       &           ', ichknum = ', ichknum
486    
             _BARRIER  
   
487  c-- else of if ( ichknum ...  c-- else of if ( ichknum ...
488           else           else
489              ierr_grdchk = -1              ierr_grdchk = -1
490    
491  c-- end of if ( ichknum ...  c-- end of if ( ichknum ...
492           endif           endif
493    
494  c-- end of do icomp = ...  c-- end of do icomp = ...
495        enddo        enddo
496    
497        if ( myProcId .EQ. grdchkwhichproc ) then        if (myProcId .EQ. grdchkwhichproc .AND. .NOT.useSingleCpuIO) then
498           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
499       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)
500           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
501       &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)       &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)
502           CALL WRITE_REC_XYZ_RL(           CALL WRITE_REC_XYZ_RL(
503       &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)       &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)
504        endif        endif
505    
506  c--   Everyone has to wait for the component to be reset.  c--   Everyone has to wait for the component to be reset.
507        _BARRIER  c     _BARRIER
508    
509  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
510        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
511    
512  #endif /* ALLOW_GRADIENT_CHECK */  #endif /* ALLOW_GRDCHK */
513    
514          return
515        end        end
Legend:
Removed from v.1.3.6.5  
changed lines
  Added in v.1.38
  ViewVC Help
Powered by ViewVC 1.1.22