/[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.29 by jmc, Mon Mar 22 02:20:43 2010 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 model 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    
159        fcref = fc        ierr      = 0
160        ierr_grdchk = 0        ierr_grdchk = 0
161          adxxmemo  = 0.
162          ftlxxmemo = 0.
163    #ifdef ALLOW_ADMTLM
164          fcref = objf_state_final(idep,jdep,1,1,1)
165    #else
166          fcref = fc
167    #endif
168    
169          print *, 'ph-check fcref = ', fcref
170    
171        do bj = jtlo, jthi        do bj = jtlo, jthi
172           do bi = itlo, ithi           do bi = itlo, ithi
# Line 169  c--   assuming all xx_ fields are initia Line 188  c--   assuming all xx_ fields are initia
188           grdchk_epsfac = 1. _d 0           grdchk_epsfac = 1. _d 0
189        end if        end if
190    
191          WRITE(standardmessageunit,'(A)')
192         &    'grad-res -------------------------------'
193          WRITE(standardmessageunit,'(2a)')
194         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
195         &    '               fc ref           fc + eps           fc - eps'
196    #ifdef ALLOW_TANGENTLINEAR_RUN
197          WRITE(standardmessageunit,'(2a)')
198         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
199         &    '             tlm grad            fd grad         1 - fd/tlm'
200    #else
201          WRITE(standardmessageunit,'(2a)')
202         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
203         &    '             adj grad            fd grad         1 - fd/adj'
204    #endif
205    
206  c--   Compute the finite difference approximations.  c--   Compute the finite difference approximations.
207  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep  c--   Cycle through all processes doing NINT(nend-nbeg+1)/nstep
208  c--   gradient checks.  c--   gradient checks.
       do jprocs = 1,numberOfProcs  
          proc_grdchk = jprocs - 1  
209    
210           if ( myProcId .eq. proc_grdchk ) then        if ( nbeg .EQ. 0 )
211         &     call grdchk_get_position( mythid )
212    
213              do icomp = nbeg, nend, nstep        do icomp = nbeg, nend, nstep
214    
215                 ichknum = (icomp - nbeg)/nstep + 1           ichknum = (icomp - nbeg)/nstep + 1
216    
217                 if (ichknum .le. maxgrdchecks ) then  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
222    
223  c--   Determine the location of icomp on the grid.  c--         Determine the location of icomp on the grid.
224                    call grdchk_loc( icomp, ichknum,              if ( myProcId .EQ. grdchkwhichproc ) then
225       &                 icvrec, itile, jtile, layer,                 call grdchk_loc( icomp, ichknum,
226       &                 itilepos, jtilepos, itest, ierr,       &              icvrec, itile, jtile, layer, obcspos,
227       &                 mythid )       &              itilepos, jtilepos, icglo, itest, ierr,
228         &              mythid )
229    cph(
230    cph-print               print *, 'ph-grd ----- back from loc -----',
231    cph-print     &             icvrec, itilepos, jtilepos, layer, obcspos
232    cph)
233                endif
234                _BARRIER
235                                
                   if ( ierr .eq. 0 ) then  
   
236  c******************************************************  c******************************************************
237  c--   (A): get gradient component calculated via adjoint  c--   (A): get gradient component calculated via adjoint
238  c******************************************************  c******************************************************
239                       call grdchk_getadxx( icvrec,  
240       &                    itile, jtile, layer,  c--   get gradient component calculated via adjoint
241       &                    itilepos, jtilepos,              if ( myProcId .EQ. grdchkwhichproc .AND.
242       &                    adxxmemo, mythid )       &           ierr .EQ. 0 ) then
243                       _BARRIER                 call grdchk_getadxx( icvrec,
244         &              itile, jtile, layer,
245         &              itilepos, jtilepos,
246         &              adxxmemo, mythid )
247                endif
248                _BARRIER
249    
250  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
251  c******************************************************  c******************************************************
# Line 207  c*************************************** Line 254  c***************************************
254  c--  c--
255  c--   1. perturb control vector component: xx(i)=1.  c--   1. perturb control vector component: xx(i)=1.
256    
257                       localEps = 1.              if ( myProcId .EQ. grdchkwhichproc .AND.
258                       call grdchk_getxx( icvrec, TANGENT_SIMULATION,       &           ierr .EQ. 0 ) then
259       &                    itile, jtile, layer,                 localEps = 1. _d 0
260       &                    itilepos, jtilepos,                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,
261       &                    xxmemo_ref, xxmemo_pert, localEps,       &              itile, jtile, layer,
262       &                    mythid )       &              itilepos, jtilepos,
263                       _BARRIER       &              xxmemo_ref, xxmemo_pert, localEps,
264         &              mythid )
265                endif
266                _BARRIER
267    
268  c--  c--
269  c--   2. perform tangent linear run  c--   2. perform tangent linear run
270                       mytime = starttime              mytime = starttime
271                       myiter = niter0              myiter = niter0
272                       g_fc = 0.  #ifdef ALLOW_ADMTLM
273                       call g_the_main_loop( mytime, myiter, mythid )              do k=1,4*Nr+1
274                       ftlxxmemo = g_fc               do j=1,sny
275                  do i=1,snx
276                   g_objf_state_final(i,j,1,1,k) = 0.
277                  enddo
278                 enddo
279                enddo
280    #else
281                g_fc = 0.
282    #endif
283    
284                call g_the_main_loop( mytime, myiter, mythid )
285                _BARRIER
286    #ifdef ALLOW_ADMTLM
287                ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)
288    #else
289                ftlxxmemo = g_fc
290    #endif
291    
292  c--  c--
293  c--   3. reset control vector  c--   3. reset control vector
294                       call grdchk_setxx( icvrec, TANGENT_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
295       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
296       &                    itilepos, jtilepos,                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,
297       &                    xxmemo_ref, mythid )       &              itile, jtile, layer,
298                       _BARRIER       &              itilepos, jtilepos,
299  #endif       &              xxmemo_ref, mythid )
300                endif
301                _BARRIER
302    
303    #endif /* ALLOW_TANGENTLINEAR_RUN */
304    
305    
306  c******************************************************  c******************************************************
307  c--   (C): Get gradient via finite difference perturbation  c--   (C): Get gradient via finite difference perturbation
308  c******************************************************  c******************************************************
309    
310  c--   get control vector component from file  c--   get control vector component from file
311  c--   perturb it and write back to file:  c--   perturb it and write back to file
312  c--   positive perturbation  c--   positive perturbation
313                       localEps = abs(grdchk_eps)              localEps = abs(grdchk_eps)
314                       call grdchk_getxx( icvrec, FORWARD_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
315       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
316       &                    itilepos, jtilepos,                 call grdchk_getxx( icvrec, FORWARD_SIMULATION,
317       &                    xxmemo_ref, xxmemo_pert, localEps,       &              itile, jtile, layer,
318       &                    mythid )       &              itilepos, jtilepos,
319                       _BARRIER       &              xxmemo_ref, xxmemo_pert, localEps,
320         &              mythid )
321                endif
322                _BARRIER
323                                            
324  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
325                       mytime = starttime              mytime = starttime
326                       myiter = niter0              myiter = niter0
327                       call the_main_loop( mytime, myiter, mythid )              call the_main_loop( mytime, myiter, mythid )
328                       fcpertplus = fc  #ifdef ALLOW_ADMTLM
329                fcpertplus = objf_state_final(idep,jdep,1,1,1)
330    #else
331                fcpertplus = fc
332    #endif
333                print *, 'ph-check fcpertplus = ', fcpertplus
334                _BARRIER
335                                        
336  c--   Reset control vector.  c--   Reset control vector.
337                       call grdchk_setxx( icvrec, FORWARD_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
338       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
339       &                    itilepos, jtilepos,                 call grdchk_setxx( icvrec, FORWARD_SIMULATION,
340       &                    xxmemo_ref, mythid )       &              itile, jtile, layer,
341                       _BARRIER       &              itilepos, jtilepos,
342         &              xxmemo_ref, mythid )
343                endif
344                _BARRIER
345    
346                       fcpertminus = fcref              fcpertminus = fcref
347                print *, 'ph-check fcpertminus = ', fcpertminus
348    
349                       if ( useCentralDiff ) then              if ( useCentralDiff ) then
350    
351  c--   get control vector component from file  c--   get control vector component from file
352  c--   perturb it and write back to file:  c--   perturb it and write back to file
353  c--   repeat the proceedure for a negative perturbation  c--   repeat the proceedure for a negative perturbation
354                          localEps = - abs(grdchk_eps)                 if ( myProcId .EQ. grdchkwhichproc .AND.
355                          call grdchk_getxx( icvrec, FORWARD_SIMULATION,       &           ierr .EQ. 0 ) then
356       &                    itile, jtile, layer,                    localEps = - abs(grdchk_eps)
357       &                    itilepos, jtilepos,                    call grdchk_getxx( icvrec, FORWARD_SIMULATION,
358       &                    xxmemo_ref, xxmemo_pert, localEps,       &                 itile, jtile, layer,
359       &                    mythid )       &                 itilepos, jtilepos,
360                          _BARRIER       &                 xxmemo_ref, xxmemo_pert, localEps,
361         &                 mythid )
362                   endif
363                   _BARRIER
364                                            
365  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
366                          mytime = starttime                 mytime = starttime
367                          myiter = niter0                 myiter = niter0
368                          call the_main_loop( mytime, myiter, mythid )                 call the_main_loop( mytime, myiter, mythid )
369                          fcpertminus = fc                 _BARRIER
370    #ifdef ALLOW_ADMTLM
371                   fcpertminus = objf_state_final(idep,jdep,1,1,1)
372    #else
373                   fcpertminus = fc
374    #endif
375                                        
376  c--   Reset control vector.  c--   Reset control vector.
377                          call grdchk_setxx( icvrec, FORWARD_SIMULATION,                 if ( myProcId .EQ. grdchkwhichproc .AND.
378       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
379       &                    itilepos, jtilepos,                    call grdchk_setxx( icvrec, FORWARD_SIMULATION,
380       &                    xxmemo_ref, mythid )       &                 itile, jtile, layer,
381                          _BARRIER       &                 itilepos, jtilepos,
382         &                 xxmemo_ref, mythid )
383                   endif
384                   _BARRIER
385    
386    c-- end of if useCentralDiff ...
387                end if
388    
                      end if  
 c--  
389  c******************************************************  c******************************************************
390  c--   (D): calculate relative differences between gradients  c--   (D): calculate relative differences between gradients
391  c******************************************************  c******************************************************
392    
393                       if ( grdchk_eps .eq. 0. ) then              if ( myProcId .EQ. grdchkwhichproc .AND.
394                          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  
395    
396                   if ( grdchk_eps .eq. 0. ) then
397                      gfd = (fcpertplus-fcpertminus)
398                   else
399                      gfd = (fcpertplus-fcpertminus)
400         &                 /(grdchk_epsfac*grdchk_eps)
401                   endif
402                                            
403                       fcrmem      ( ichknum ) = fcref                 if ( adxxmemo .eq. 0. ) then
404                       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  
405                 else                 else
406                    ierr_grdchk = -1                    ratio_ad = 1. - gfd/adxxmemo
407                 endif                 endif
               
             enddo  
          endif  
408    
409  c--   Everyone has to wait for the component to be reset.                 if ( ftlxxmemo .eq. 0. ) then
410           _BARRIER                    ratio_ftl = abs( ftlxxmemo - gfd )
411                   else
412                      ratio_ftl = 1. - gfd/ftlxxmemo
413                   endif
414                      
415                   tmpplot1(itilepos,jtilepos,layer,itile,jtile)
416         &              = gfd
417                   tmpplot2(itilepos,jtilepos,layer,itile,jtile)
418         &              = ratio_ad
419                   tmpplot3(itilepos,jtilepos,layer,itile,jtile)
420         &              = ratio_ftl
421    
422                   fcrmem      ( ichknum ) = fcref
423                   fcppmem     ( ichknum ) = fcpertplus
424                   fcpmmem     ( ichknum ) = fcpertminus
425                   xxmemref    ( ichknum ) = xxmemo_ref
426                   xxmempert   ( ichknum ) = xxmemo_pert
427                   gfdmem      ( ichknum ) = gfd
428                   adxxmem     ( ichknum ) = adxxmemo
429                   ftlxxmem    ( ichknum ) = ftlxxmemo
430                   ratioadmem  ( ichknum ) = ratio_ad
431                   ratioftlmem ( ichknum ) = ratio_ftl
432    
433                   irecmem   ( ichknum ) = icvrec
434                   bimem     ( ichknum ) = itile
435                   bjmem     ( ichknum ) = jtile
436                   ilocmem   ( ichknum ) = itilepos
437                   jlocmem   ( ichknum ) = jtilepos
438                   klocmem   ( ichknum ) = layer
439                   iobcsmem  ( ichknum ) = obcspos
440                   icompmem  ( ichknum ) = icomp
441                   ichkmem   ( ichknum ) = ichknum
442                   itestmem  ( ichknum ) = itest
443                   ierrmem   ( ichknum ) = ierr
444                   icglomem  ( ichknum ) = icglo
445    
446                   WRITE(standardmessageunit,'(A)')
447         &             'grad-res -------------------------------'
448                   WRITE(standardmessageunit,'(a,8I5,2x,3(1x,E18.12))')
449         &              ' grad-res ',myprocid,ichknum,itilepos,jtilepos,
450         &              layer,itile,jtile,obcspos,
451         &              fcref, fcpertplus, fcpertminus
452    #ifdef ALLOW_TANGENTLINEAR_RUN
453                   WRITE(standardmessageunit,'(a,8I5,2x,3(1x,E18.12))')
454         &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
455         &              icompmem(ichknum),itestmem(ichknum),
456         &              bimem(ichknum),bjmem(ichknum),iobcsmem(ichknum),
457         &              ftlxxmemo, gfd, ratio_ftl
458                   WRITE(msgBuf,'(A34,2(1PE24.14,X))')
459         &              'precision_grdchk_result TLM ', fcref, ftlxxmemo
460                   CALL PRINT_MESSAGE
461         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
462    c        
463                   WRITE(msgBuf,'(A34,1PE24.14)')
464         &              ' TLM  precision_derivative_cost =', fcref
465                   CALL PRINT_MESSAGE
466         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
467                   WRITE(msgBuf,'(A34,1PE24.14)')
468         &              ' TLM  precision_derivative_grad =', ftlxxmemo
469                   CALL PRINT_MESSAGE
470         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
471    #else
472                   WRITE(standardmessageunit,'(a,8I5,2x,3(1x,E18.12))')
473         &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
474         &              icompmem(ichknum),itestmem(ichknum),
475         &              bimem(ichknum),bjmem(ichknum),obcspos,
476         &              adxxmemo, gfd, ratio_ad
477    c              WRITE(msgBuf,'(A34,2(1PE24.14,X))')
478    c    &              'precision_grdchk_result ADM ', fcref, adxxmemo
479    c              CALL PRINT_MESSAGE
480    c    &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
481                   WRITE(msgBuf,'(A34,1PE24.14)')
482         &              ' ADM  precision_derivative_cost =', fcref
483                   CALL PRINT_MESSAGE
484         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
485                   WRITE(msgBuf,'(A34,1PE24.14)')
486         &              ' ADM  precision_derivative_grad =', adxxmemo
487                   CALL PRINT_MESSAGE
488         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
489    #endif
490    
491                endif
492    
493                print *, 'ph-grd  ierr ---------------------------'
494                print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,
495         &           ', ichknum = ', ichknum
496    
497                _BARRIER
498    
499    c-- else of if ( ichknum ...
500             else
501                ierr_grdchk = -1
502    
503    c-- end of if ( ichknum ...
504             endif
505    
506    c-- end of do icomp = ...
507        enddo        enddo
508    
509        CALL WRITE_REC_XYZ_RL( 'grd_findiff'   , tmpplot1, 1, 0, myThid)        if ( myProcId .EQ. grdchkwhichproc ) then
510        CALL WRITE_REC_XYZ_RL( 'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)           CALL WRITE_REC_XYZ_RL(
511        CALL WRITE_REC_XYZ_RL( 'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)
512             CALL WRITE_REC_XYZ_RL(
513         &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)
514             CALL WRITE_REC_XYZ_RL(
515         &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)
516          endif
517    
518    c--   Everyone has to wait for the component to be reset.
519          _BARRIER
520    
521  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
522        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
523    
524  #endif /* ALLOW_GRADIENT_CHECK */  #endif /* ALLOW_GRDCHK */
525    
526        end        end
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.22