/[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.6 by heimbach, Mon Sep 16 18:11:58 2002 UTC revision 1.25 by jmc, Sat Sep 15 17:32:41 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
# Line 115  c     == local variables == Line 126  c     == local variables ==
126        _RL     localEps        _RL     localEps
127        _RL     grdchk_epsfac        _RL     grdchk_epsfac
128    
 #ifdef ALLOW_TANGENTLINEAR_RUN  
       _RL     g_fc  
       common /g_cost_r/ g_fc  
 #endif  
   
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        _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)
132    
133          CHARACTER*(MAX_LEN_MBUF) msgBuf
134    
135  c     == end of interface ==  c     == end of interface ==
136  CEOP  CEOP
137    
# Line 137  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    
153  c--   Compute the adjoint models' gradients.  c--   Compute the adjoint models' gradients.
154  c--   Compute the unperturbed cost function.  c--   Compute the unperturbed cost function.
155  c--   Gradient via adjoint has already been computed,  cph   Gradient via adjoint has already been computed,
156  c--   and so has unperturbed cost function,  cph   and so has unperturbed cost function,
157  c--   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    
168        do bj = jtlo, jthi        do bj = jtlo, jthi
169           do bi = itlo, ithi           do bi = itlo, ithi
# Line 169  c--   assuming all xx_ fields are initia Line 185  c--   assuming all xx_ fields are initia
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                                
                   if ( ierr .eq. 0 ) then  
   
233  c******************************************************  c******************************************************
234  c--   (A): get gradient component calculated via adjoint  c--   (A): get gradient component calculated via adjoint
235  c******************************************************  c******************************************************
236                       call grdchk_getadxx( icvrec,  
237       &                    itile, jtile, layer,  c--   get gradient component calculated via adjoint
238       &                    itilepos, jtilepos,              if ( myProcId .EQ. grdchkwhichproc .AND.
239       &                    adxxmemo, mythid )       &           ierr .EQ. 0 ) then
240                       _BARRIER                 call grdchk_getadxx( icvrec,
241         &              itile, jtile, layer,
242         &              itilepos, jtilepos,
243         &              adxxmemo, mythid )
244                endif
245                _BARRIER
246    
247  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
248  c******************************************************  c******************************************************
# Line 206  c--   (B): Get gradient component g_fc f Line 250  c--   (B): Get gradient component g_fc f
250  c******************************************************  c******************************************************
251  c--  c--
252  c--   1. perturb control vector component: xx(i)=1.  c--   1. perturb control vector component: xx(i)=1.
253                ftlxxmemo = 0.
254    
255                       localEps = 1.              if ( myProcId .EQ. grdchkwhichproc .AND.
256                       call grdchk_getxx( icvrec, TANGENT_SIMULATION,       &           ierr .EQ. 0 ) then
257       &                    itile, jtile, layer,                 localEps = 1. _d 0
258       &                    itilepos, jtilepos,                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,
259       &                    xxmemo_ref, xxmemo_pert, localEps,       &              itile, jtile, layer,
260       &                    mythid )       &              itilepos, jtilepos,
261                       _BARRIER       &              xxmemo_ref, xxmemo_pert, localEps,
262         &              mythid )
263                endif
264                _BARRIER
265    
266  c--  c--
267  c--   2. perform tangent linear run  c--   2. perform tangent linear run
268                       mytime = starttime              mytime = starttime
269                       myiter = niter0              myiter = niter0
270                       g_fc = 0.  #ifdef ALLOW_ADMTLM
271                       call g_the_main_loop( mytime, myiter, mythid )              do k=1,4*Nr+1
272                       ftlxxmemo = g_fc               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--  c--
291  c--   3. reset control vector  c--   3. reset control vector
292                       call grdchk_setxx( icvrec, TANGENT_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
293       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
294       &                    itilepos, jtilepos,                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,
295       &                    xxmemo_ref, mythid )       &              itile, jtile, layer,
296                       _BARRIER       &              itilepos, jtilepos,
297  #endif       &              xxmemo_ref, mythid )
298                endif
299                _BARRIER
300    
301    #endif /* ALLOW_TANGENTLINEAR_RUN */
302    
303    
304  c******************************************************  c******************************************************
305  c--   (C): Get gradient via finite difference perturbation  c--   (C): Get gradient via finite difference perturbation
306  c******************************************************  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  c--   positive perturbation  c--   positive perturbation
311                       localEps = abs(grdchk_eps)              localEps = abs(grdchk_eps)
312                       call grdchk_getxx( icvrec, FORWARD_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
313       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
314       &                    itilepos, jtilepos,                 call grdchk_getxx( icvrec, FORWARD_SIMULATION,
315       &                    xxmemo_ref, xxmemo_pert, localEps,       &              itile, jtile, layer,
316       &                    mythid )       &              itilepos, jtilepos,
317                       _BARRIER       &              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, FORWARD_SIMULATION,              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                endif
342                _BARRIER
343    
344                       fcpertminus = fcref              fcpertminus = fcref
345                print *, 'ph-check fcpertminus = ', fcpertminus
346    
347                       if ( useCentralDiff ) then              if ( useCentralDiff ) then
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  c--   repeat the proceedure for a negative perturbation  c--   repeat the proceedure for a negative perturbation
352                          localEps = - abs(grdchk_eps)                 if ( myProcId .EQ. grdchkwhichproc .AND.
353                          call grdchk_getxx( icvrec, FORWARD_SIMULATION,       &           ierr .EQ. 0 ) then
354       &                    itile, jtile, layer,                    localEps = - abs(grdchk_eps)
355       &                    itilepos, jtilepos,                    call grdchk_getxx( icvrec, FORWARD_SIMULATION,
356       &                    xxmemo_ref, xxmemo_pert, localEps,       &                 itile, jtile, layer,
357       &                    mythid )       &                 itilepos, jtilepos,
358                          _BARRIER       &                 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, FORWARD_SIMULATION,                 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-- end of if useCentralDiff ...
385                end if
386    
                      end if  
 c--  
387  c******************************************************  c******************************************************
388  c--   (D): calculate relative differences between gradients  c--   (D): calculate relative differences between gradients
389  c******************************************************  c******************************************************
390    
391                       if ( grdchk_eps .eq. 0. ) then              if ( myProcId .EQ. grdchkwhichproc .AND.
392                          gfd = (fcpertplus-fcpertminus)       &           ierr .EQ. 0 ) then
                      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  
                     
                      tmpplot1(itilepos,jtilepos,layer,itile,jtile) =  
      &                    gfd  
                      tmpplot2(itilepos,jtilepos,layer,itile,jtile) =  
      &                    ratio_ad  
                      tmpplot3(itilepos,jtilepos,layer,itile,jtile) =  
      &                    ratio_ftl  
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  
                      ftlxxmem    ( ichknum ) = ftlxxmemo  
                      ratioadmem  ( ichknum ) = ratio_ad  
                      ratioftlmem ( ichknum ) = ratio_ftl  
   
                      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_ad  
                      print '(a,4I5,3(1x,E15.9))', 'ph-grd 3 ',  
      &                    ichknum,ichkmem(ichknum),  
      &                    icompmem(ichknum),itestmem(ichknum),  
      &                    ftlxxmemo, gfd, ratio_ftl  
 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         &              ' TLM  precision_derivative_cost =', fcref
463                   CALL PRINT_MESSAGE
464         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
465                   WRITE(msgBuf,'(A34,1PE24.14)')
466         &              ' TLM  precision_derivative_grad =', 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         &              ' ADM  precision_derivative_cost =', fcref
482                   CALL PRINT_MESSAGE
483         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
484                   WRITE(msgBuf,'(A34,1PE24.14)')
485         &              ' ADM  precision_derivative_grad =', adxxmemo
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        CALL WRITE_REC_XYZ_RL( 'grd_findiff'   , tmpplot1, 1, 0, myThid)        if ( myProcId .EQ. grdchkwhichproc ) then
509        CALL WRITE_REC_XYZ_RL( 'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)           CALL WRITE_REC_XYZ_RL(
510        CALL WRITE_REC_XYZ_RL( 'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)
511             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.6  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22