/[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.37 by jmc, Wed Aug 15 23:05:48 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 59  c     changed: mlosch@ocean.mit.edu: 09- Line 61  c     changed: mlosch@ocean.mit.edu: 09-
61  c              - added centered difference vs. 1-sided difference option  c              - added centered difference vs. 1-sided difference option
62  c              - improved output format for readability  c              - improved output format for readability
63  c              - added control variable hFacC  c              - added control variable hFacC
64  c      c              heimbach@mit.edu 24-Feb-2003
65    c              - added tangent linear gradient checks
66    c              - fixes for multiproc. gradient checks
67    c              - added more control variables
68    c
69  c     ==================================================================  c     ==================================================================
70  c     SUBROUTINE grdchk_main  c     SUBROUTINE grdchk_main
71  c     ==================================================================  c     ==================================================================
# Line 74  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
100        integer j,  jmin, jmax        integer j,  jmin, jmax
101        integer k        integer k
102    
       integer jprocs  
       integer proc_grdchk  
103        integer icomp        integer icomp
104        integer ichknum        integer ichknum
105        integer icvrec        integer icvrec
106        integer jtile        integer jtile
107        integer itile        integer itile
108        integer layer        integer layer
109          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 115  c     == local variables == Line 125  c     == local variables ==
125        _RL     localEps        _RL     localEps
126        _RL     grdchk_epsfac        _RL     grdchk_epsfac
127    
 #ifdef ALLOW_TANGENTLINEAR_RUN  
       _RL     g_fc  
       common /g_cost_r/ g_fc  
 #endif  
   
128        _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)
129        _RL tmpplot2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)        _RL tmpplot2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
130        _RL tmpplot3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)        _RL tmpplot3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
131    
132          CHARACTER*(MAX_LEN_MBUF) msgBuf
133    
134  c     == end of interface ==  c     == end of interface ==
135  CEOP  CEOP
136    
# Line 137  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  c--   Gradient via adjoint has already been computed,  cph   Gradient via adjoint has already been computed,
155  c--   and so has unperturbed cost function,  cph   and so has unperturbed cost function,
156  c--   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 169  c--   assuming all xx_ fields are initia Line 187  c--   assuming all xx_ fields are initia
187           grdchk_epsfac = 1. _d 0           grdchk_epsfac = 1. _d 0
188        end if        end if
189    
190          WRITE(standardmessageunit,'(A)')
191         &    'grad-res -------------------------------'
192          WRITE(standardmessageunit,'(2a)')
193         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
194         &    '               fc ref           fc + eps           fc - eps'
195    #ifdef ALLOW_TANGENTLINEAR_RUN
196          WRITE(standardmessageunit,'(2a)')
197         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
198         &    '             tlm grad            fd grad         1 - fd/tlm'
199    #else
200          WRITE(standardmessageunit,'(2a)')
201         &    ' grad-res  proc    #    i    j    k   bi   bj iobc',
202         &    '             adj grad            fd grad         1 - fd/adj'
203    #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.
       do jprocs = 1,numberOfProcs  
          proc_grdchk = jprocs - 1  
208    
209           if ( myProcId .eq. proc_grdchk ) then        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                 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                    if ( ierr .eq. 0 ) then  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
244    
245  c******************************************************  c******************************************************
246  c--   (A): get gradient component calculated via adjoint  c--   (A): get gradient component calculated via adjoint
247  c******************************************************  c******************************************************
248                       call grdchk_getadxx( icvrec,  
249       &                    itile, jtile, layer,  c--   get gradient component calculated via adjoint
250       &                    itilepos, jtilepos,              if ( myProcId .EQ. grdchkwhichproc .AND.
251       &                    adxxmemo, mythid )       &           ierr .EQ. 0 ) then
252                       _BARRIER                 call grdchk_getadxx( icvrec,
253         &              itile, jtile, layer,
254         &              itilepos, jtilepos,
255         &              adxxmemo, mythid )
256                endif
257    C--   Add a global-sum call so that all proc will get the adjoint gradient
258                _GLOBAL_SUM_RL( adxxmemo, myThid )
259    
260  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
261  c******************************************************  c******************************************************
# Line 207  c*************************************** Line 264  c***************************************
264  c--  c--
265  c--   1. perturb control vector component: xx(i)=1.  c--   1. perturb control vector component: xx(i)=1.
266    
267                       localEps = 1.              if ( myProcId .EQ. grdchkwhichproc .AND.
268                       call grdchk_getxx( icvrec, TANGENT_SIMULATION,       &           ierr .EQ. 0 ) then
269       &                    itile, jtile, layer,                 localEps = 1. _d 0
270       &                    itilepos, jtilepos,                 call grdchk_getxx( icvrec, TANGENT_SIMULATION,
271       &                    xxmemo_ref, xxmemo_pert, localEps,       &              itile, jtile, layer,
272       &                    mythid )       &              itilepos, jtilepos,
273                       _BARRIER       &              xxmemo_ref, xxmemo_pert, localEps,
274         &              mythid )
275                else
276                  xxmemo_ref  = 0.
277                  xxmemo_pert = 0.
278                endif
279    
280  c--  c--
281  c--   2. perform tangent linear run  c--   2. perform tangent linear run
282                       mytime = starttime              mytime = starttime
283                       myiter = niter0              myiter = niter0
284                       g_fc = 0.  #ifdef ALLOW_ADMTLM
285                       call g_the_main_loop( mytime, myiter, mythid )              do k=1,4*Nr+1
286                       ftlxxmemo = g_fc               do j=1,sny
287                  do i=1,snx
288                   g_objf_state_final(i,j,1,1,k) = 0.
289                  enddo
290                 enddo
291                enddo
292    #else
293                g_fc = 0.
294    #endif
295    
296                call g_the_main_loop( mytime, myiter, mythid )
297    #ifdef ALLOW_ADMTLM
298                ftlxxmemo = g_objf_state_final(idep,jdep,1,1,1)
299    #else
300                ftlxxmemo = g_fc
301    #endif
302    
303  c--  c--
304  c--   3. reset control vector  c--   3. reset control vector
305                       call grdchk_setxx( icvrec, TANGENT_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
306       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
307       &                    itilepos, jtilepos,                 call grdchk_setxx( icvrec, TANGENT_SIMULATION,
308       &                    xxmemo_ref, mythid )       &              itile, jtile, layer,
309                       _BARRIER       &              itilepos, jtilepos,
310  #endif       &              xxmemo_ref, mythid )
311                endif
312    
313    #endif /* ALLOW_TANGENTLINEAR_RUN */
314    
315    
316  c******************************************************  c******************************************************
317  c--   (C): Get gradient via finite difference perturbation  c--   (C): Get gradient via finite difference perturbation
318  c******************************************************  c******************************************************
319    
320  c--   get control vector component from file  c--   get control vector component from file
321  c--   perturb it and write back to file:  c--   perturb it and write back to file
322  c--   positive perturbation  c--   positive perturbation
323                       localEps = abs(grdchk_eps)              localEps = abs(grdchk_eps)
324                       call grdchk_getxx( icvrec, FORWARD_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
325       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
326       &                    itilepos, jtilepos,                 call grdchk_getxx( icvrec, FORWARD_SIMULATION,
327       &                    xxmemo_ref, xxmemo_pert, localEps,       &              itile, jtile, layer,
328       &                    mythid )       &              itilepos, jtilepos,
329                       _BARRIER       &              xxmemo_ref, xxmemo_pert, localEps,
330                             &              mythid )
331                else
332                  xxmemo_ref  = 0.
333                  xxmemo_pert = 0.
334                endif
335    
336  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
337                       mytime = starttime              mytime = starttime
338                       myiter = niter0              myiter = niter0
339                       call the_main_loop( mytime, myiter, mythid )              call the_main_loop( mytime, myiter, mythid )
340                       fcpertplus = fc  #ifdef ALLOW_ADMTLM
341                                  fcpertplus = objf_state_final(idep,jdep,1,1,1)
342    #else
343                fcpertplus = fc
344    #endif
345                print *, 'ph-check fcpertplus  = ', fcpertplus
346    
347  c--   Reset control vector.  c--   Reset control vector.
348                       call grdchk_setxx( icvrec, FORWARD_SIMULATION,              if ( myProcId .EQ. grdchkwhichproc .AND.
349       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
350       &                    itilepos, jtilepos,                 call grdchk_setxx( icvrec, FORWARD_SIMULATION,
351       &                    xxmemo_ref, mythid )       &              itile, jtile, layer,
352                       _BARRIER       &              itilepos, jtilepos,
353         &              xxmemo_ref, mythid )
354                endif
355    
356                       fcpertminus = fcref              fcpertminus = fcref
357                print *, 'ph-check fcpertminus = ', fcpertminus
358    
359                       if ( useCentralDiff ) then              if ( useCentralDiff ) then
360    
361  c--   get control vector component from file  c--   get control vector component from file
362  c--   perturb it and write back to file:  c--   perturb it and write back to file
363  c--   repeat the proceedure for a negative perturbation  c--   repeat the proceedure for a negative perturbation
364                          localEps = - abs(grdchk_eps)                 if ( myProcId .EQ. grdchkwhichproc .AND.
365                          call grdchk_getxx( icvrec, FORWARD_SIMULATION,       &           ierr .EQ. 0 ) then
366       &                    itile, jtile, layer,                    localEps = - abs(grdchk_eps)
367       &                    itilepos, jtilepos,                    call grdchk_getxx( icvrec, FORWARD_SIMULATION,
368       &                    xxmemo_ref, xxmemo_pert, localEps,       &                 itile, jtile, layer,
369       &                    mythid )       &                 itilepos, jtilepos,
370                          _BARRIER       &                 xxmemo_ref, xxmemo_pert, localEps,
371                             &                 mythid )
372                   else
373                     xxmemo_ref  = 0.
374                     xxmemo_pert = 0.
375                   endif
376    
377  c--   forward run with perturbed control vector  c--   forward run with perturbed control vector
378                          mytime = starttime                 mytime = starttime
379                          myiter = niter0                 myiter = niter0
380                          call the_main_loop( mytime, myiter, mythid )                 call the_main_loop( mytime, myiter, mythid )
381                          fcpertminus = fc  #ifdef ALLOW_ADMTLM
382                                     fcpertminus = objf_state_final(idep,jdep,1,1,1)
383    #else
384                   fcpertminus = fc
385    #endif
386    
387  c--   Reset control vector.  c--   Reset control vector.
388                          call grdchk_setxx( icvrec, FORWARD_SIMULATION,                 if ( myProcId .EQ. grdchkwhichproc .AND.
389       &                    itile, jtile, layer,       &           ierr .EQ. 0 ) then
390       &                    itilepos, jtilepos,                    call grdchk_setxx( icvrec, FORWARD_SIMULATION,
391       &                    xxmemo_ref, mythid )       &                 itile, jtile, layer,
392                          _BARRIER       &                 itilepos, jtilepos,
393         &                 xxmemo_ref, mythid )
394                   endif
395    
396    c-- end of if useCentralDiff ...
397                end if
398    
                      end if  
 c--  
399  c******************************************************  c******************************************************
400  c--   (D): calculate relative differences between gradients  c--   (D): calculate relative differences between gradients
401  c******************************************************  c******************************************************
402    
403                       if ( grdchk_eps .eq. 0. ) then              if ( grdchk_eps .eq. 0. ) then
404                          gfd = (fcpertplus-fcpertminus)                 gfd = (fcpertplus-fcpertminus)
405                       else              else
406                          gfd = (fcpertplus-fcpertminus)                 gfd = (fcpertplus-fcpertminus)
407       &                       /(grdchk_epsfac*grdchk_eps)       &              /(grdchk_epsfac*grdchk_eps)
408                       endif              endif
409    
410                       if ( adxxmemo .eq. 0. ) then              if ( adxxmemo .eq. 0. ) then
411                          ratio_ad = abs( adxxmemo - gfd )                 ratio_ad = abs( adxxmemo - gfd )
412                       else              else
413                          ratio_ad = 1. - gfd/adxxmemo                 ratio_ad = 1. - gfd/adxxmemo
414                       endif              endif
415                      
416                       if ( ftlxxmemo .eq. 0. ) then              if ( ftlxxmemo .eq. 0. ) then
417                          ratio_ftl = abs( ftlxxmemo - gfd )                 ratio_ftl = abs( ftlxxmemo - gfd )
418                       else              else
419                          ratio_ftl = 1. - gfd/ftlxxmemo                 ratio_ftl = 1. - gfd/ftlxxmemo
420                       endif              endif
421                      
422                       tmpplot1(itilepos,jtilepos,layer,itile,jtile) =              if ( myProcId .EQ. grdchkwhichproc .AND.
423       &                    gfd       &           ierr .EQ. 0 ) then
424                       tmpplot2(itilepos,jtilepos,layer,itile,jtile) =                 tmpplot1(itilepos,jtilepos,layer,itile,jtile)
425       &                    ratio_ad       &              = gfd
426                       tmpplot3(itilepos,jtilepos,layer,itile,jtile) =                 tmpplot2(itilepos,jtilepos,layer,itile,jtile)
427       &                    ratio_ftl       &              = ratio_ad
428                   tmpplot3(itilepos,jtilepos,layer,itile,jtile)
429                             &              = ratio_ftl
430                       fcrmem      ( ichknum ) = fcref              endif
431                       fcppmem     ( ichknum ) = fcpertplus  
432                       fcpmmem     ( ichknum ) = fcpertminus              if ( ierr .EQ. 0 ) then
433                       xxmemref    ( ichknum ) = xxmemo_ref                 fcrmem      ( ichknum ) = fcref
434                       xxmempert   ( ichknum ) = xxmemo_pert                 fcppmem     ( ichknum ) = fcpertplus
435                       gfdmem      ( ichknum ) = gfd                 fcpmmem     ( ichknum ) = fcpertminus
436                       adxxmem     ( ichknum ) = adxxmemo                 xxmemref    ( ichknum ) = xxmemo_ref
437                       ftlxxmem    ( ichknum ) = ftlxxmemo                 xxmempert   ( ichknum ) = xxmemo_pert
438                       ratioadmem  ( ichknum ) = ratio_ad                 gfdmem      ( ichknum ) = gfd
439                       ratioftlmem ( ichknum ) = ratio_ftl                 adxxmem     ( ichknum ) = adxxmemo
440                   ftlxxmem    ( ichknum ) = ftlxxmemo
441                       irecmem   ( ichknum ) = icvrec                 ratioadmem  ( ichknum ) = ratio_ad
442                       bimem     ( ichknum ) = itile                 ratioftlmem ( ichknum ) = ratio_ftl
443                       bjmem     ( ichknum ) = jtile  
444                       ilocmem   ( ichknum ) = itilepos                 irecmem   ( ichknum ) = icvrec
445                       jlocmem   ( ichknum ) = jtilepos                 bimem     ( ichknum ) = itile
446                       klocmem   ( ichknum ) = layer                 bjmem     ( ichknum ) = jtile
447                       icompmem  ( ichknum ) = icomp                 ilocmem   ( ichknum ) = itilepos
448                       ichkmem   ( ichknum ) = ichknum                 jlocmem   ( ichknum ) = jtilepos
449                       itestmem  ( ichknum ) = itest                 klocmem   ( ichknum ) = layer
450                       ierrmem   ( ichknum ) = ierr                 iobcsmem  ( ichknum ) = obcspos
451                                     icompmem  ( ichknum ) = icomp
452  cph(                 ichkmem   ( ichknum ) = ichknum
453                       print *, 'ph-grd 3 -------------------------------'                 itestmem  ( ichknum ) = itest
454                       print '(a,4I5,3(1x,E15.9))', 'ph-grd 3 ',                 ierrmem   ( ichknum ) = ierr
455       &                    ichknum,itilepos,jtilepos,layer,                 icglomem  ( ichknum ) = icglo
456       &                    fcref, fcpertplus, fcpertminus              endif
457                       print '(a,4I5,3(1x,E15.9))', 'ph-grd 3 ',  
458       &                    ichknum,ichkmem(ichknum),              if ( myProcId .EQ. grdchkwhichproc .AND.
459       &                    icompmem(ichknum),itestmem(ichknum),       &           ierr .EQ. 0 ) then
460       &                    adxxmemo, gfd, ratio_ad  
461                       print '(a,4I5,3(1x,E15.9))', 'ph-grd 3 ',                 WRITE(standardmessageunit,'(A)')
462       &                    ichknum,ichkmem(ichknum),       &             'grad-res -------------------------------'
463       &                    icompmem(ichknum),itestmem(ichknum),                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
464       &                    ftlxxmemo, gfd, ratio_ftl       &              ' grad-res ',myprocid,ichknum,itilepos,jtilepos,
465  cph)       &              layer,itile,jtile,obcspos,
466                    else       &              fcref, fcpertplus, fcpertminus
467  c  #ifdef ALLOW_TANGENTLINEAR_RUN
468                       print *, 'ph-grd 3 -------------------------------'                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
469                       print *, 'ph-grd 3 : ierr = ', ierr,       &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
470       &                                 ', icomp = ', icomp       &              icompmem(ichknum),itestmem(ichknum),
471                    endif       &              bimem(ichknum),bjmem(ichknum),iobcsmem(ichknum),
472                 else       &              ftlxxmemo, gfd, ratio_ftl
473                    ierr_grdchk = -1  #else
474                 endif                 WRITE(standardmessageunit,'(A,8I5,1x,1P3E19.11)')
475                     &              ' grad-res ',myprocid,ichknum,ichkmem(ichknum),
476              enddo       &              icompmem(ichknum),itestmem(ichknum),
477           endif       &              bimem(ichknum),bjmem(ichknum),obcspos,
478         &              adxxmemo, gfd, ratio_ad
479    #endif
480                endif
481    #ifdef ALLOW_TANGENTLINEAR_RUN
482                WRITE(msgBuf,'(A30,1PE22.14)')
483         &              ' TLM  ref_cost_function      =', fcref
484                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
485         &                          SQUEEZE_RIGHT, myThid )
486                WRITE(msgBuf,'(A30,1PE22.14)')
487         &              ' TLM  tangent-lin_grad       =', ftlxxmemo
488                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
489         &                          SQUEEZE_RIGHT, myThid )
490                WRITE(msgBuf,'(A30,1PE22.14)')
491         &              ' TLM  finite-diff_grad       =', gfd
492                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
493         &                          SQUEEZE_RIGHT, myThid )
494    #else
495                WRITE(msgBuf,'(A30,1PE22.14)')
496         &              ' ADM  ref_cost_function      =', fcref
497                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
498         &                          SQUEEZE_RIGHT, myThid )
499                WRITE(msgBuf,'(A30,1PE22.14)')
500         &              ' ADM  adjoint_gradient       =', adxxmemo
501                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
502         &                          SQUEEZE_RIGHT, myThid )
503                WRITE(msgBuf,'(A30,1PE22.14)')
504         &              ' ADM  finite-diff_grad       =', gfd
505                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
506         &                          SQUEEZE_RIGHT, myThid )
507    #endif
508    
509  c--   Everyone has to wait for the component to be reset.              print *, 'ph-grd  ierr ---------------------------'
510           _BARRIER              print *, 'ph-grd  ierr = ', ierr, ', icomp = ', icomp,
511         &           ', ichknum = ', ichknum
512    
513    c-- else of if ( ichknum ...
514             else
515                ierr_grdchk = -1
516    
517    c-- end of if ( ichknum ...
518             endif
519    
520    c-- end of do icomp = ...
521        enddo        enddo
522    
523        CALL WRITE_REC_XYZ_RL( 'grd_findiff'   , tmpplot1, 1, 0, myThid)        if ( myProcId .EQ. grdchkwhichproc ) then
524        CALL WRITE_REC_XYZ_RL( 'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)           CALL WRITE_REC_XYZ_RL(
525        CALL WRITE_REC_XYZ_RL( 'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)       &        'grd_findiff'   , tmpplot1, 1, 0, myThid)
526             CALL WRITE_REC_XYZ_RL(
527         &        'grd_ratio_ad'  , tmpplot2, 1, 0, myThid)
528             CALL WRITE_REC_XYZ_RL(
529         &        'grd_ratio_ftl' , tmpplot3, 1, 0, myThid)
530          endif
531    
532    c--   Everyone has to wait for the component to be reset.
533    c     _BARRIER
534    
535  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
536        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
537    
538  #endif /* ALLOW_GRADIENT_CHECK */  #endif /* ALLOW_GRDCHK */
539    
540          return
541        end        end
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.37
  ViewVC Help
Powered by ViewVC 1.1.22