/[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.5 by heimbach, Sat Jul 13 02:55:58 2002 UTC revision 1.24 by heimbach, Fri Sep 14 20:40:20 2007 UTC
# Line 1  Line 1 
1    C
2  C $Header$  C $Header$
3    C $Name$
4    
5    #include "AD_CONFIG.h"
6  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
7    
8  CBOI  CBOI
# Line 59  c     changed: mlosch@ocean.mit.edu: 09- Line 62  c     changed: mlosch@ocean.mit.edu: 09-
62  c              - added centered difference vs. 1-sided difference option  c              - added centered difference vs. 1-sided difference option
63  c              - improved output format for readability  c              - improved output format for readability
64  c              - added control variable hFacC  c              - added control variable hFacC
65    c              heimbach@mit.edu 24-Feb-2003
66    c              - added tangent linear gradient checks
67    c              - fixes for multiproc. gradient checks
68    c              - added more control variables
69  c      c    
70  c     ==================================================================  c     ==================================================================
71  c     SUBROUTINE grdchk_main  c     SUBROUTINE grdchk_main
# Line 74  c     == global variables == Line 81  c     == global variables ==
81  #include "PARAMS.h"  #include "PARAMS.h"
82  #include "grdchk.h"  #include "grdchk.h"
83  #include "cost.h"  #include "cost.h"
84    #include "ctrl.h"
85    #ifdef ALLOW_TANGENTLINEAR_RUN
86    #include "g_cost.h"
87    #endif
88    
89  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
90  c     == routine arguments ==  c     == routine arguments ==
91        integer mythid        integer mythid
92    
93  #ifdef ALLOW_GRADIENT_CHECK  #ifdef ALLOW_GRDCHK
94  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
95  c     == local variables ==  c     == local variables ==
96        integer myiter        integer myiter
# Line 90  c     == local variables == Line 101  c     == local variables ==
101        integer j,  jmin, jmax        integer j,  jmin, jmax
102        integer k        integer k
103    
       integer jprocs  
       integer proc_grdchk  
104        integer icomp        integer icomp
105        integer ichknum        integer ichknum
106        integer icvrec        integer icvrec
107        integer jtile        integer jtile
108        integer itile        integer itile
109        integer layer        integer layer
110          integer obcspos
111        integer itilepos        integer itilepos
112        integer jtilepos        integer jtilepos
113          integer icglo
114        integer itest        integer itest
115        integer ierr        integer ierr
116        integer ierr_grdchk        integer ierr_grdchk
117        _RL     gfd        _RL     gfd
118        _RL     fcref        _RL     fcref
119        _RL     fcpertplus, fcpertminus        _RL     fcpertplus, fcpertminus
120        _RL     ratio        _RL     ratio_ad
121          _RL     ratio_ftl
122        _RL     xxmemo_ref        _RL     xxmemo_ref
123        _RL     xxmemo_pert        _RL     xxmemo_pert
124        _RL     adxxmemo        _RL     adxxmemo
125          _RL     ftlxxmemo
126          _RL     localEps
127          _RL     grdchk_epsfac
128    
 cph(  
129        _RL tmpplot1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)        _RL tmpplot1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
130        _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)
131  cph)        _RL tmpplot3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
132    
133  Cml(        CHARACTER*(MAX_LEN_MBUF) msgBuf
       _RL     grdchk_epsfac  
 Cml)  
134    
135  c     == end of interface ==  c     == end of interface ==
136  CEOP  CEOP
# Line 133  c--   Set the loop ranges. Line 145  c--   Set the loop ranges.
145        imin = 1        imin = 1
146        imax = snx        imax = snx
147    
148          print *, 'ph-check entering grdchk_main '
149    
150  c--   initialise variables  c--   initialise variables
151        call grdchk_init( mythid )        call grdchk_init( mythid )
152    
# Line 142  cph   Gradient via adjoint has already b Line 156  cph   Gradient via adjoint has already b
156  cph   and so has unperturbed cost function,  cph   and so has unperturbed cost function,
157  cph   assuming all xx_ fields are initialised to zero.  cph   assuming all xx_ fields are initialised to zero.
158    
       fcref = fc  
159        ierr_grdchk = 0        ierr_grdchk = 0
160    #ifdef ALLOW_ADMTLM
161          fcref = objf_state_final(idep,jdep,1,1,1)
162    #else
163          fcref = fc
164    #endif
165    
166          print *, 'ph-check fcref = ', fcref
167    
 cph(  
168        do bj = jtlo, jthi        do bj = jtlo, jthi
169           do bi = itlo, ithi           do bi = itlo, ithi
170              do k = 1, nr              do k = 1, nr
# Line 153  cph( Line 172  cph(
172                    do i = imin, imax                    do i = imin, imax
173                       tmpplot1(i,j,k,bi,bj) = 0. _d 0                       tmpplot1(i,j,k,bi,bj) = 0. _d 0
174                       tmpplot2(i,j,k,bi,bj) = 0. _d 0                       tmpplot2(i,j,k,bi,bj) = 0. _d 0
175                         tmpplot3(i,j,k,bi,bj) = 0. _d 0
176                    end do                    end do
177                 end do                 end do
178              end do              end do
179           end do           end do
180        end do        end do
 cph)  
181    
182        if ( useCentralDiff ) then        if ( useCentralDiff ) then
183           grdchk_epsfac = 2. _d 0           grdchk_epsfac = 2. _d 0
# Line 166  cph) Line 185  cph)
185           grdchk_epsfac = 1. _d 0           grdchk_epsfac = 1. _d 0
186        end if        end if
187    
188          WRITE(standardmessageunit,'(A)')
189         &    'grad-res -------------------------------'
190          WRITE(standardmessageunit,'(2a)')
191         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
192         &    '               fc ref           fc + eps           fc - eps'
193    #ifdef ALLOW_TANGENTLINEAR_RUN
194          WRITE(standardmessageunit,'(2a)')
195         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
196         &    '             tlm grad            fd grad         1 - fd/tlm'
197    #else
198          WRITE(standardmessageunit,'(2a)')
199         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
200         &    '             adj grad            fd grad         1 - fd/adj'
201    #endif
202    
203  c--   Compute the finite difference approximations.  c--   Compute the finite difference approximations.
204  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep
205  c--   gradient checks.  c--   gradient checks.
       do jprocs = 1,numberOfProcs  
          proc_grdchk = jprocs - 1  
206    
207           if ( myProcId .eq. proc_grdchk ) then        if ( nbeg .EQ. 0 )
208         &     call grdchk_get_position( mythid )
209    
210              do icomp = nbeg, nend, nstep        do icomp = nbeg, nend, nstep
211    
212                 ichknum = (icomp - nbeg)/nstep + 1           ichknum = (icomp - nbeg)/nstep + 1
213    
214                 if (ichknum .le. maxgrdchecks ) then  cph(
215    cph-print         print *, 'ph-grd _main: nbeg, icomp, ichknum ',
216    cph-print     &        nbeg, icomp, ichknum
217    cph)
218             if (ichknum .le. maxgrdchecks ) then
219    
220  c--         Determine the location of icomp on the grid.  c--         Determine the location of icomp on the grid.
221                    call grdchk_loc( icomp, ichknum,              if ( myProcId .EQ. grdchkwhichproc ) then
222       &                 icvrec, itile, jtile, layer,                 call grdchk_loc( icomp, ichknum,
223       &                 itilepos, jtilepos, itest, ierr,       &              icvrec, itile, jtile, layer, obcspos,
224       &                 mythid )       &              itilepos, jtilepos, icglo, itest, ierr,
225         &              mythid )
226    cph(
227    cph-print               print *, 'ph-grd ----- back from loc -----',
228    cph-print     &             icvrec, itilepos, jtilepos, layer, obcspos
229    cph)
230                endif
231                _BARRIER
232                                
233                    if ( ierr .eq. 0 ) then  c******************************************************
234    c--   (A): get gradient component calculated via adjoint
235  c--   positive perturbation  c******************************************************
                      grdchk_eps = abs(grdchk_eps)  
236    
237  c--   get gradient component calculated via adjoint  c--   get gradient component calculated via adjoint
238                       call grdchk_getadxx( icvrec,              if ( myProcId .EQ. grdchkwhichproc .AND.
239       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
240       &                    itilepos, jtilepos,                 call grdchk_getadxx( icvrec,
241       &                    adxxmemo, mythid )       &              itile, jtile, layer,
242                       _BARRIER       &              itilepos, jtilepos,
243         &              adxxmemo, mythid )
244                endif
245                _BARRIER
246    
247    #ifdef ALLOW_TANGENTLINEAR_RUN
248    c******************************************************
249    c--   (B): Get gradient component g_fc from tangent linear run:
250    c******************************************************
251    c--
252    c--   1. perturb control vector component: xx(i)=1.
253                ftlxxmemo = 0.
254    
255                if ( myProcId .EQ. grdchkwhichproc .AND.
256         &           ierr .EQ. 0 ) then
257                   localEps = 1. _d 0
258                   call grdchk_getxx( icvrec, TANGENT_SIMULATION,
259         &              itile, jtile, layer,
260         &              itilepos, jtilepos,
261         &              xxmemo_ref, xxmemo_pert, localEps,
262         &              mythid )
263                endif
264                _BARRIER
265    
266    c--
267    c--   2. perform tangent linear run
268                mytime = starttime
269                myiter = niter0
270    #ifdef ALLOW_ADMTLM
271                do k=1,4*Nr+1
272                 do j=1,sny
273                  do i=1,snx
274                   g_objf_state_final(i,j,1,1,k) = 0.
275                  enddo
276                 enddo
277                enddo
278    #else
279                g_fc = 0.
280    #endif
281    
282                call g_the_main_loop( mytime, myiter, mythid )
283                _BARRIER
284    #ifdef ALLOW_ADMTLM
285                ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)
286    #else
287                ftlxxmemo = g_fc
288    #endif
289    
290    c--
291    c--   3. reset control vector
292                if ( myProcId .EQ. grdchkwhichproc .AND.
293         &           ierr .EQ. 0 ) then
294                   call grdchk_setxx( icvrec, TANGENT_SIMULATION,
295         &              itile, jtile, layer,
296         &              itilepos, jtilepos,
297         &              xxmemo_ref, mythid )
298                endif
299                _BARRIER
300    
301    #endif /* ALLOW_TANGENTLINEAR_RUN */
302    
303    
304    c******************************************************
305    c--   (C): Get gradient via finite difference perturbation
306    c******************************************************
307    
308  c--   get control vector component from file  c--   get control vector component from file
309  c--   perturb it and write back to file  c--   perturb it and write back to file
310                       call grdchk_getxx( icvrec,  c--   positive perturbation
311       &                    itile, jtile, layer,              localEps = abs(grdchk_eps)
312       &                    itilepos, jtilepos,              if ( myProcId .EQ. grdchkwhichproc .AND.
313       &                    xxmemo_ref, xxmemo_pert, mythid )       &           ierr .EQ. 0 ) then
314                       _BARRIER                 call grdchk_getxx( icvrec, FORWARD_SIMULATION,
315         &              itile, jtile, layer,
316         &              itilepos, jtilepos,
317         &              xxmemo_ref, xxmemo_pert, localEps,
318         &              mythid )
319                endif
320                _BARRIER
321                                            
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                       fcpertplus = fc  #ifdef ALLOW_ADMTLM
327                fcpertplus = objf_state_final(idep,jdep,1,1,1)
328    #else
329                fcpertplus = fc
330    #endif
331                print *, 'ph-check fcpertplus = ', fcpertplus
332                _BARRIER
333                                        
334  c--   Reset control vector.  c--   Reset control vector.
335                       call grdchk_setxx( icvrec,              if ( myProcId .EQ. grdchkwhichproc .AND.
336       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
337       &                    itilepos, jtilepos,                 call grdchk_setxx( icvrec, FORWARD_SIMULATION,
338       &                    xxmemo_ref, mythid )       &              itile, jtile, layer,
339                       _BARRIER       &              itilepos, jtilepos,
340         &              xxmemo_ref, mythid )
341                       fcpertminus = fcref              endif
342                _BARRIER
343    
344                       if ( useCentralDiff ) then              fcpertminus = fcref
345                print *, 'ph-check fcpertminus = ', fcpertminus
346    
347  c--   repeat the proceedure for a negative perturbation              if ( useCentralDiff ) then
                         grdchk_eps = - abs(grdchk_eps)  
348    
349  c--   get control vector component from file  c--   get control vector component from file
350  c--   perturb it and write back to file  c--   perturb it and write back to file
351                          call grdchk_getxx( icvrec,  c--   repeat the proceedure for a negative perturbation
352       &                    itile, jtile, layer,                 if ( myProcId .EQ. grdchkwhichproc .AND.
353       &                    itilepos, jtilepos,       &           ierr .EQ. 0 ) then
354       &                    xxmemo_ref, xxmemo_pert, mythid )                    localEps = - abs(grdchk_eps)
355                          _BARRIER                    call grdchk_getxx( icvrec, FORWARD_SIMULATION,
356         &                 itile, jtile, layer,
357         &                 itilepos, jtilepos,
358         &                 xxmemo_ref, xxmemo_pert, localEps,
359         &                 mythid )
360                   endif
361                   _BARRIER
362                                            
363  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
364                          mytime = starttime                 mytime = starttime
365                          myiter = niter0                 myiter = niter0
366                          call the_main_loop( mytime, myiter, mythid )                 call the_main_loop( mytime, myiter, mythid )
367                          fcpertminus = fc                 _BARRIER
368    #ifdef ALLOW_ADMTLM
369                   fcpertminus = objf_state_final(idep,jdep,1,1,1)
370    #else
371                   fcpertminus = fc
372    #endif
373                                        
374  c--   Reset control vector.  c--   Reset control vector.
375                          call grdchk_setxx( icvrec,                 if ( myProcId .EQ. grdchkwhichproc .AND.
376       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
377       &                    itilepos, jtilepos,                    call grdchk_setxx( icvrec, FORWARD_SIMULATION,
378       &                    xxmemo_ref, mythid )       &                 itile, jtile, layer,
379                          _BARRIER       &                 itilepos, jtilepos,
380         &                 xxmemo_ref, mythid )
381                   endif
382                   _BARRIER
383    
384  c     reset grdchk_eps to a positive value  c-- end of if useCentralDiff ...
385                          grdchk_eps = abs(grdchk_eps)              end if
386    
387                       end if  c******************************************************
388  c--  c--   (D): calculate relative differences between gradients
389                       if ( grdchk_eps .eq. 0. ) then  c******************************************************
390                          gfd = (fcpertplus-fcpertminus)  
391                       else              if ( myProcId .EQ. grdchkwhichproc .AND.
392                          gfd = (fcpertplus-fcpertminus)       &           ierr .EQ. 0 ) then
      &                       /(grdchk_epsfac*grdchk_eps)  
                      endif  
                       
                      if ( adxxmemo .eq. 0. ) then  
                         ratio = abs( adxxmemo - gfd )  
                      else  
                         ratio = 1. - gfd/adxxmemo  
                      endif  
                     
 cph(  
                      tmpplot1(itilepos,jtilepos,layer,itile,jtile) =  
      &                    gfd  
                      tmpplot2(itilepos,jtilepos,layer,itile,jtile) =  
      &                    ratio  
 cph)  
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                       fcrmem    ( ichknum ) = fcref                 if ( adxxmemo .eq. 0. ) then
402                       fcppmem   ( ichknum ) = fcpertplus                    ratio_ad = abs( adxxmemo - gfd )
                      fcpmmem   ( ichknum ) = fcpertminus  
                      xxmemref  ( ichknum ) = xxmemo_ref  
                      xxmempert ( ichknum ) = xxmemo_pert  
                      gfdmem    ( ichknum ) = gfd  
                      adxxmem   ( ichknum ) = adxxmemo  
                      ratiomem  ( ichknum ) = ratio  
   
                      irecmem   ( ichknum ) = icvrec  
                      bimem     ( ichknum ) = itile  
                      bjmem     ( ichknum ) = jtile  
                      ilocmem   ( ichknum ) = itilepos  
                      jlocmem   ( ichknum ) = jtilepos  
                      klocmem   ( ichknum ) = layer  
                      icompmem  ( ichknum ) = icomp  
                      ichkmem   ( ichknum ) = ichknum  
                      itestmem  ( ichknum ) = itest  
                      ierrmem   ( ichknum ) = ierr  
                     
 cph(  
                      print *, 'ph-grd 3 -------------------------------'  
                      print '(a,4I5,3(1x,E15.9))', 'ph-grd 3 ',  
      &                    ichknum,itilepos,jtilepos,layer,  
      &                    fcref, fcpertplus, fcpertminus  
                      print '(a,4I5,3(1x,E15.9))', 'ph-grd 3 ',  
      &                    ichknum,ichkmem(ichknum),  
      &                    icompmem(ichknum),itestmem(ichknum),  
      &                    adxxmemo, gfd, ratio  
 cph)  
                   else  
 c  
                      print *, 'ph-grd 3 -------------------------------'  
                      print *, 'ph-grd 3 : ierr = ', ierr,  
      &                                 ', icomp = ', icomp  
                   endif  
403                 else                 else
404                    ierr_grdchk = -1                    ratio_ad = 1. - gfd/adxxmemo
405                 endif                 endif
               
             enddo  
          endif  
406    
407  c--   Everyone has to wait for the component to be reset.                 if ( ftlxxmemo .eq. 0. ) then
408           _BARRIER                    ratio_ftl = abs( ftlxxmemo - gfd )
409                   else
410                      ratio_ftl = 1. - gfd/ftlxxmemo
411                   endif
412                      
413                   tmpplot1(itilepos,jtilepos,layer,itile,jtile)
414         &              = gfd
415                   tmpplot2(itilepos,jtilepos,layer,itile,jtile)
416         &              = ratio_ad
417                   tmpplot3(itilepos,jtilepos,layer,itile,jtile)
418         &              = ratio_ftl
419    
420                   fcrmem      ( ichknum ) = fcref
421                   fcppmem     ( ichknum ) = fcpertplus
422                   fcpmmem     ( ichknum ) = fcpertminus
423                   xxmemref    ( ichknum ) = xxmemo_ref
424                   xxmempert   ( ichknum ) = xxmemo_pert
425                   gfdmem      ( ichknum ) = gfd
426                   adxxmem     ( ichknum ) = adxxmemo
427                   ftlxxmem    ( ichknum ) = ftlxxmemo
428                   ratioadmem  ( ichknum ) = ratio_ad
429                   ratioftlmem ( ichknum ) = ratio_ftl
430    
431                   irecmem   ( ichknum ) = icvrec
432                   bimem     ( ichknum ) = itile
433                   bjmem     ( ichknum ) = jtile
434                   ilocmem   ( ichknum ) = itilepos
435                   jlocmem   ( ichknum ) = jtilepos
436                   klocmem   ( ichknum ) = layer
437                   iobcsmem  ( ichknum ) = obcspos
438                   icompmem  ( ichknum ) = icomp
439                   ichkmem   ( ichknum ) = ichknum
440                   itestmem  ( ichknum ) = itest
441                   ierrmem   ( ichknum ) = ierr
442                   icglomem  ( ichknum ) = icglo
443    
444                   WRITE(standardmessageunit,'(A)')
445         &             'grad-res -------------------------------'
446                   WRITE(standardmessageunit,'(a,8I5,2x,3(1x,E18.12))')
447         &              ' grad-res ',myprocid,ichknum,itilepos,jtilepos,
448         &              layer,itile,jtile,obcspos,
449         &              fcref, fcpertplus, fcpertminus
450    #ifdef ALLOW_TANGENTLINEAR_RUN
451                   WRITE(standardmessageunit,'(a,8I5,2x,3(1x,E18.12))')
452         &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
453         &              icompmem(ichknum),itestmem(ichknum),
454         &              bimem(ichknum),bjmem(ichknum),iobcsmem(ichknum),
455         &              ftlxxmemo, gfd, ratio_ftl
456                   WRITE(msgBuf,'(A34,2(1PE24.14,X))')
457         &              'precision_grdchk_result TLM ', fcref, ftlxxmemo
458                   CALL PRINT_MESSAGE
459         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
460    c        
461                   WRITE(msgBuf,'(A34,1PE24.14)')
462         &              'precision_derivative_cost TLM ', fcref
463                   CALL PRINT_MESSAGE
464         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
465                   WRITE(msgBuf,'(A34,1PE24.14)')
466         &              'precision_derivative_grad TLM ', ftlxxmemo
467                   CALL PRINT_MESSAGE
468         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
469    #else
470                   WRITE(standardmessageunit,'(a,8I5,2x,3(1x,E18.12))')
471         &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
472         &              icompmem(ichknum),itestmem(ichknum),
473         &              bimem(ichknum),bjmem(ichknum),obcspos,
474         &              adxxmemo, gfd, ratio_ad
475                   WRITE(msgBuf,'(A34,2(1PE24.14,X))')
476         &              'precision_grdchk_result ADM ', fcref, adxxmemo
477                   CALL PRINT_MESSAGE
478         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
479    c
480                   WRITE(msgBuf,'(A34,1PE24.14)')
481         &              'precision_derivative_cost ADM ', fcref
482                   CALL PRINT_MESSAGE
483         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
484                   WRITE(msgBuf,'(A34,1PE24.14)')
485         &              'precision_derivative_grad ADM ', ftlxxmemo
486                   CALL PRINT_MESSAGE
487         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
488    #endif
489    
490                endif
491    
492                print *, 'ph-grd  ierr ---------------------------'
493                print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,
494         &           ', ichknum = ', ichknum
495    
496                _BARRIER
497    
498    c-- else of if ( ichknum ...
499             else
500                ierr_grdchk = -1
501    
502    c-- end of if ( ichknum ...
503             endif
504    
505    c-- end of do icomp = ...
506        enddo        enddo
507    
508  cph(        if ( myProcId .EQ. grdchkwhichproc ) then
509        CALL WRITE_REC_XYZ_RL( 'grd_findiff' , tmpplot1, 1, 0, myThid)           CALL WRITE_REC_XYZ_RL(
510        CALL WRITE_REC_XYZ_RL( 'grd_ratio' , tmpplot2, 1, 0, myThid)       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)
511  cph)           CALL WRITE_REC_XYZ_RL(
512         &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)
513             CALL WRITE_REC_XYZ_RL(
514         &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)
515          endif
516    
517    c--   Everyone has to wait for the component to be reset.
518          _BARRIER
519    
520  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
521        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
522    
523  #endif /* ALLOW_GRADIENT_CHECK */  #endif /* ALLOW_GRDCHK */
524    
525        end        end
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22