/[MITgcm]/MITgcm/pkg/grdchk/grdchk_main.F
ViewVC logotype

Diff of /MITgcm/pkg/grdchk/grdchk_main.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3.6.4 by heimbach, Fri Mar 7 04:01:59 2003 UTC revision 1.13 by heimbach, Mon Feb 23 19:16:16 2004 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 78  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    #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
# Line 100  c     == local variables == Line 106  c     == local variables ==
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 itest        integer itest
# Line 121  c     == local variables == Line 128  c     == local variables ==
128        _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)
129        _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)
130    
131  #ifdef ALLOW_TANGENTLINEAR_RUN        CHARACTER*(MAX_LEN_MBUF) msgBuf
       _RL     g_fc  
       common /g_cost_r/ g_fc  
 #endif  
132    
133  c     == end of interface ==  c     == end of interface ==
134  CEOP  CEOP
# Line 148  cph   Gradient via adjoint has already b Line 152  cph   Gradient via adjoint has already b
152  cph   and so has unperturbed cost function,  cph   and so has unperturbed cost function,
153  cph   assuming all xx_ fields are initialised to zero.  cph   assuming all xx_ fields are initialised to zero.
154    
       fcref = fc  
155        ierr_grdchk = 0        ierr_grdchk = 0
156    cphadmtlm(
157          fcref = fc
158    cphadmtlm      fcref = objf_state_final(45,4,1,1)
159    cphadmtlm)
160    
161          print *, 'ph-check fcref = ', fcref
162    
163        do bj = jtlo, jthi        do bj = jtlo, jthi
164           do bi = itlo, ithi           do bi = itlo, ithi
# Line 171  cph   assuming all xx_ fields are initia Line 180  cph   assuming all xx_ fields are initia
180           grdchk_epsfac = 1. _d 0           grdchk_epsfac = 1. _d 0
181        end if        end if
182    
183        print *, 'ph-grd 3 -------------------------------'        print *, 'grad-res -------------------------------'
184        print ('(2a)'),        print ('(2a)'),
185       &     ' ph-grd 3  proc    #    i    j    k            fc ref',       &     ' grad-res  proc    #    i    j    k            fc ref',
186       &     '        fc + eps        fc - eps'       &     '        fc + eps        fc - eps'
187  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
188        print ('(2a)'),        print ('(2a)'),
189       &     ' ph-grd 3  proc    #    i    j    k          tlm grad',       &     ' grad-res  proc    #    i    j    k          tlm grad',
190       &     '         fd grad      1 - fd/tlm'       &     '         fd grad      1 - fd/tlm'
191  #else  #else
192        print ('(2a)'),        print ('(2a)'),
193       &     ' ph-grd 3  proc    #    i    j    k          adj grad',       &     ' grad-res  proc    #    i    j    k          adj grad',
194       &     '         fd grad      1 - fd/adj'       &     '         fd grad      1 - fd/adj'
195  #endif  #endif
196    
# Line 198  c--   gradient checks. Line 207  c--   gradient checks.
207  c--         Determine the location of icomp on the grid.  c--         Determine the location of icomp on the grid.
208              if ( myProcId .EQ. grdchkwhichproc ) then              if ( myProcId .EQ. grdchkwhichproc ) then
209                 call grdchk_loc( icomp, ichknum,                 call grdchk_loc( icomp, ichknum,
210       &              icvrec, itile, jtile, layer,       &              icvrec, itile, jtile, layer, obcspos,
211       &              itilepos, jtilepos, itest, ierr,       &              itilepos, jtilepos, itest, ierr,
212       &              mythid )       &              mythid )
213              endif              endif
# Line 240  c-- Line 249  c--
249  c--   2. perform tangent linear run  c--   2. perform tangent linear run
250              mytime = starttime              mytime = starttime
251              myiter = niter0              myiter = niter0
252    cphadmtlm(
253              g_fc = 0.              g_fc = 0.
254    cphadmtlm            do j=1,sny
255    cphadmtlm               do i=1,snx
256    cphadmtlm                  g_objf_state_final(i,j,1,1) = 0.
257    cphadmtlm               enddo
258    cphadmtlm            enddo
259    cphadmtlm)
260              call g_the_main_loop( mytime, myiter, mythid )              call g_the_main_loop( mytime, myiter, mythid )
261    cphadmtlm(
262              ftlxxmemo = g_fc              ftlxxmemo = g_fc
263    cphadmtlm            ftlxxmemo = g_objf_state_final(45,4,1,1)
264    cphadmtlm)
265              _BARRIER              _BARRIER
266  c--  c--
267  c--   3. reset control vector  c--   3. reset control vector
# Line 280  c--   forward run with perturbed control Line 299  c--   forward run with perturbed control
299              mytime = starttime              mytime = starttime
300              myiter = niter0              myiter = niter0
301              call the_main_loop( mytime, myiter, mythid )              call the_main_loop( mytime, myiter, mythid )
302    cphadmtlm(
303              fcpertplus = fc              fcpertplus = fc
304    cphadmtlm            fcpertplus = objf_state_final(45,4,1,1)
305    cphadmtlm)
306                print *, 'ph-check fcpertplus = ', fcpertplus
307              _BARRIER              _BARRIER
308                                        
309  c--   Reset control vector.  c--   Reset control vector.
# Line 294  c--   Reset control vector. Line 317  c--   Reset control vector.
317              _BARRIER              _BARRIER
318    
319              fcpertminus = fcref              fcpertminus = fcref
320                print *, 'ph-check fcpertminus = ', fcpertminus
321    
322              if ( useCentralDiff ) then              if ( useCentralDiff ) then
323    
# Line 381  c*************************************** Line 405  c***************************************
405                 ilocmem   ( ichknum ) = itilepos                 ilocmem   ( ichknum ) = itilepos
406                 jlocmem   ( ichknum ) = jtilepos                 jlocmem   ( ichknum ) = jtilepos
407                 klocmem   ( ichknum ) = layer                 klocmem   ( ichknum ) = layer
408                   iobcsmem  ( ichknum ) = obcspos
409                 icompmem  ( ichknum ) = icomp                 icompmem  ( ichknum ) = icomp
410                 ichkmem   ( ichknum ) = ichknum                 ichkmem   ( ichknum ) = ichknum
411                 itestmem  ( ichknum ) = itest                 itestmem  ( ichknum ) = itest
412                 ierrmem   ( ichknum ) = ierr                 ierrmem   ( ichknum ) = ierr
413                                        
414                 print *, 'ph-grd 3 -------------------------------'                 print *, 'grad-res -------------------------------'
415                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',                 print '(a,5I5,2x,3(1x,E15.9))', ' grad-res ',
416       &              myprocid,ichknum,itilepos,jtilepos,layer,       &              myprocid,ichknum,itilepos,jtilepos,layer,
417       &              fcref, fcpertplus, fcpertminus       &              fcref, fcpertplus, fcpertminus
418  #ifdef ALLOW_TANGENTLINEAR_RUN  #ifdef ALLOW_TANGENTLINEAR_RUN
419                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',                 print '(a,5I5,2x,3(1x,E15.9))', ' grad-res ',
420       &              myprocid,ichknum,ichkmem(ichknum),       &              myprocid,ichknum,ichkmem(ichknum),
421       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
422       &              ftlxxmemo, gfd, ratio_ftl       &              ftlxxmemo, gfd, ratio_ftl
423                   WRITE(msgBuf,'(A34,2(1PE24.14,X))')
424         &              'precision_grdchk_result TLM ', fcref, ftlxxmemo
425                   CALL PRINT_MESSAGE
426         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
427  #else  #else
428                 print '(a,5I5,2x,3(1x,E15.9))', ' ph-grd 3 ',                 print '(a,5I5,2x,3(1x,E15.9))', ' grad-res ',
429       &              myprocid,ichknum,ichkmem(ichknum),       &              myprocid,ichknum,ichkmem(ichknum),
430       &              icompmem(ichknum),itestmem(ichknum),       &              icompmem(ichknum),itestmem(ichknum),
431       &              adxxmemo, gfd, ratio_ad       &              adxxmemo, gfd, ratio_ad
432                   WRITE(msgBuf,'(A34,2(1PE24.14,X))')
433         &              'precision_grdchk_result ADM ', fcref, adxxmemo
434                   CALL PRINT_MESSAGE
435         &              (msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
436  #endif  #endif
437    
438              endif              endif
# Line 435  c--   Everyone has to wait for the compo Line 468  c--   Everyone has to wait for the compo
468  c--   Print the results of the gradient check.  c--   Print the results of the gradient check.
469        call grdchk_print( ichknum, ierr_grdchk, mythid )        call grdchk_print( ichknum, ierr_grdchk, mythid )
470    
471  #endif /* ALLOW_GRADIENT_CHECK */  #endif /* ALLOW_GRDCHK */
472    
473        end        end
Legend:
Removed from v.1.3.6.4  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22