tools/OAD_support/ad_template.revolve.F

#include "PACKAGES_CONFIG.h"
#include "OPENAD_OPTIONS.h"

      subroutine template()
      use OAD_cp
      use OAD_tape
      use OAD_rev
      use revolve

c we may need these for the checkpointing
      use SIZE_mod
      use EEPARAMS_mod
      use PARAMS_mod
      use BAR2_mod
      use BARRIER_mod
#ifdef ALLOW_CD_CODE
      use CD_CODE_VARS_mod
#endif
      use CG2D_mod
      use CG3D_mod
      use DYNVARS_mod
      use EESUPPORT_mod
      use EOS_mod
      use EXCH_mod
      use FC_NAMEMANGLE_mod
      use FFIELDS_mod
#ifdef ALLOW_GENERIC_ADVDIFF
      use GAD_mod
#endif
      use GLOBAL_MAX_mod
      use GLOBAL_SUM_mod
#ifdef ALLOW_GGL90
      use GGL90_mod
      use GGL90_TAVE_mod
#endif
#ifdef ALLOW_GMREDI
      use GMREDI_mod
      use GMREDI_TAVE_mod
#endif
      use GRID_mod
#ifdef ALLOW_KPP
      use KPP_mod
      use KPP_PARAMS_mod
      use KPP_TAVE_mod
#endif
#ifdef ALLOW_MOM_COMMON
      use MOM_VISC_mod
#endif
      use MPI_INFO_mod
#ifdef ALLOW_SHAP_FILT
      use SHAP_FILT_mod
#endif
#ifdef ALLOW_STREAMICE
      use STREAMICE_mod
      use STREAMICE_ADV_mod
      use STREAMICE_BDRY_mod
      use STREAMICE_CG_mod
#endif
      use SOLVE_FOR_PRESSURE3D_mod
      use SOLVE_FOR_PRESSURE_mod
      use SURFACE_mod
      use tamc_mod
      use tamc_keys_mod
      use cost_mod
      use g_cost_mod
      use ctrl_mod
      use ctrl_dummy_mod
      use ctrl_weights_mod
      use optim_mod
      use grdchk_mod
      
!$TEMPLATE_PRAGMA_DECLARATIONS
      LOGICAL :: initialized=.FALSE.
      TYPE(rvAction),save :: theAction
      CHARACTER(80) :: errorMsg
      integer, save :: jointCPCount
      integer, save :: currIter

      integer :: cp_loop_variable_1,cp_loop_variable_2,
     +     cp_loop_variable_3,cp_loop_variable_4,cp_loop_variable_5

      type(modeType) :: our_orig_mode

      integer iaddr
      external iaddr

#ifdef OAD_DEBUG_JOINT
      character*(80):: indentation='                                        
     +                                         '
      our_indent=our_indent+1

      write(standardmessageunit, '(A,A,A)', ADVANCE='NO') 
     +'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
      call oad_dump_revmod(); call oad_dump_tapestats()
      write(standardmessageunit,*) 
#endif

      nIter0 = NINT( (startTime-baseTime)/deltaTClock )
      if (our_rev_mode%arg_store) then 
        call cp_write_open()
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: entering arg store'
#endif
!$PLACEHOLDER_PRAGMA$ id=8
       call cp_close()
      end if 
      if (our_rev_mode%arg_restore) then
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: entering arg restore'
#endif
        call cp_read_open()
!$PLACEHOLDER_PRAGMA$ id=9
        call cp_close()
      end if
      if (our_rev_mode%plain) then
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: run plain, down plain'
#endif
#ifdef ALLOW_OPENAD_DIVA
      DO iloop1 = 1, nTimeSteps
        PROD = (ILOOP1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
        print *, 'DIVA Revolve Plain PROD = ', PROD
        CALL OpenAD_forward_step( PROD, mytime, myiter, mythid )
      enddo
#else 
      DO iloop = 1, nTimeSteps
        CALL OpenAD_forward_step( iloop, mytime, myiter, mythid )
      enddo
#endif
      end if
      if (our_rev_mode%tape) then
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: run tape, down revolve until first U turn'
#endif
         currIter=0
         jointCPcount=cp_fNumber()
         initialized=rvInit(nTimeSteps,120,
     +                      errorMsg,theAction)
         IF (.NOT.initialized) WRITE(*,'(A,A)') 'Error: ', errorMsg
         do while (theAction%actionFlag/=rvDone)
           theAction=rvNextAction()
           select case (theAction%actionFlag) 
             case (rvStore)
                call cp_write_open(theAction%cpNum+jointCPCount)
!$PLACEHOLDER_PRAGMA$ id=8
                call cp_close
             case (rvForward)
                call OAD_revPlain
                do currIter=currIter,theAction%iteration-1
#ifdef ALLOW_OPENAD_DIVA 
                   PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
                   print *, 'DIVA Revolve Tape rvForward PROD = ', PROD
                   CALL OpenAD_forward_step( PROD, mytime, 
     +myiter, mythid )
#else
                   CALL OpenAD_forward_step( currIter+1, mytime,
     +myiter, mythid ) 
#endif
                end do
                call OAD_revTape
             case (rvFirstUTurn)
#ifdef ALLOW_OPENAD_DIVA 
                PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
                print *, 'DIVA Revolve Tape rvFirstUTurn PROD = ', PROD
                CALL OpenAD_forward_step( PROD, mytime, myiter, 
     +mythid )
#else
                CALL OpenAD_forward_step( currIter+1, mytime, myiter,
     +mythid )
#endif
! get out now ...
                exit                
             end select   
          end do
      end if 
      if (our_rev_mode%adjoint) then
        IF (.NOT.initialized) WRITE(*,'(A)') 'Error: not initialized'
        do while (theAction%actionFlag/=rvDone)
           select case (theAction%actionFlag) 
             case (rvFirstUTurn)
!we taped already ... see above
#ifdef ALLOW_OPENAD_DIVA 
                PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1))) 
                print *, 'DIVA Revolve Adjoint rvFirstUTurn PROD = ', PROD
                CALL OpenAD_forward_step( PROD, mytime, myiter, 
     +mythid )
#else
                CALL OpenAD_forward_step( currIter+1, mytime, myiter, 
     +mythid )
#endif
             case (rvStore)
                call cp_write_open(theAction%cpNum+jointCPCount)
!$PLACEHOLDER_PRAGMA$ id=8
                call cp_close
             case (rvRestore)
                call cp_read_open(theAction%cpNum+jointCPCount)
!$PLACEHOLDER_PRAGMA$ id=9
                currIter=theAction%iteration
                call cp_close
             case (rvForward)
                call OAD_revPlain
                do currIter=currIter,theAction%iteration-1
#ifdef ALLOW_OPENAD_DIVA
                   PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
                   print *, 'DIVA Revolve Adjoint rvForward PROD = ', PROD 
                   CALL OpenAD_forward_step( PROD, mytime, myiter,
     + mythid )
#else
                   CALL OpenAD_forward_step( currIter+1, mytime, myiter,
     + mythid )
#endif
                end do
                call OAD_revAdjoint
             case (rvUTurn)
#ifdef ALLOW_OPENAD_DIVA
                PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1))) 
#endif
                call OAD_revTape
#ifdef ALLOW_OPENAD_DIVA
                print *, 'DIVA Revolve Adjoint rvUTurn tp PROD = ', PROD 
                CALL OpenAD_forward_step( PROD, mytime, myiter, 
     +mythid )
#else
                CALL OpenAD_forward_step( currIter+1, mytime, myiter,
     +mythid )
#endif
                call OAD_revAdjoint
#ifdef ALLOW_OPENAD_DIVA
                print *, 'DIVA Revolve Adjoint rvUTurn ad PROD = ', PROD 
                CALL OpenAD_forward_step( PROD, mytime, myiter, 
     +mythid )
#else
                CALL OpenAD_forward_step( currIter+1, mytime, myiter,
     +mythid )
#endif
           end select   
           theAction=rvNextAction()
        end do
      end if 

#ifdef OAD_DEBUG_JOINT
      write(standardmessageunit,'(A,A,A)', ADVANCE='NO') 
     +'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
      call oad_dump_revmod(); call oad_dump_tapestats()
      write(standardmessageunit,*) 

      our_indent=our_indent-1
#endif

      end subroutine template
1	heimbach	1.3	#include "PACKAGES_CONFIG.h"
2	heimbach	1.7	#include "OPENAD_OPTIONS.h"
3	heimbach	1.3
4	utke	1.1	subroutine template()
5			use OAD_cp
6			use OAD_tape
7			use OAD_rev
8			use revolve
9
10			c we may need these for the checkpointing
11			use SIZE_mod
12			use EEPARAMS_mod
13			use PARAMS_mod
14			use BAR2_mod
15			use BARRIER_mod
16	heimbach	1.3	#ifdef ALLOW_CD_CODE
17	utke	1.1	use CD_CODE_VARS_mod
18	heimbach	1.3	#endif
19	utke	1.1	use CG2D_mod
20			use CG3D_mod
21			use DYNVARS_mod
22			use EESUPPORT_mod
23			use EOS_mod
24			use EXCH_mod
25			use FC_NAMEMANGLE_mod
26			use FFIELDS_mod
27	utke	1.5	#ifdef ALLOW_GENERIC_ADVDIFF
28	utke	1.1	use GAD_mod
29	utke	1.5	#endif
30	utke	1.1	use GLOBAL_MAX_mod
31			use GLOBAL_SUM_mod
32	heimbach	1.6	#ifdef ALLOW_GGL90
33			use GGL90_mod
34			use GGL90_TAVE_mod
35			#endif
36	heimbach	1.3	#ifdef ALLOW_GMREDI
37	utke	1.1	use GMREDI_mod
38			use GMREDI_TAVE_mod
39	heimbach	1.3	#endif
40	utke	1.1	use GRID_mod
41	heimbach	1.8	#ifdef ALLOW_KPP
42			use KPP_mod
43			use KPP_PARAMS_mod
44			use KPP_TAVE_mod
45			#endif
46	utke	1.5	#ifdef ALLOW_MOM_COMMON
47	heimbach	1.3	use MOM_VISC_mod
48	utke	1.5	#endif
49	utke	1.1	use MPI_INFO_mod
50	heimbach	1.3	#ifdef ALLOW_SHAP_FILT
51			use SHAP_FILT_mod
52			#endif
53	heimbach	1.4	#ifdef ALLOW_STREAMICE
54			use STREAMICE_mod
55			use STREAMICE_ADV_mod
56			use STREAMICE_BDRY_mod
57			use STREAMICE_CG_mod
58			#endif
59	utke	1.1	use SOLVE_FOR_PRESSURE3D_mod
60			use SOLVE_FOR_PRESSURE_mod
61			use SURFACE_mod
62			use tamc_mod
63			use tamc_keys_mod
64			use cost_mod
65			use g_cost_mod
66			use ctrl_mod
67			use ctrl_dummy_mod
68			use ctrl_weights_mod
69			use optim_mod
70			use grdchk_mod
71
72			!$TEMPLATE_PRAGMA_DECLARATIONS
73			LOGICAL :: initialized=.FALSE.
74			TYPE(rvAction),save :: theAction
75	utke	1.2	CHARACTER(80) :: errorMsg
76	utke	1.1	integer, save :: jointCPCount
77			integer, save :: currIter
78
79			integer :: cp_loop_variable_1,cp_loop_variable_2,
80			+ cp_loop_variable_3,cp_loop_variable_4,cp_loop_variable_5
81
82			type(modeType) :: our_orig_mode
83
84			integer iaddr
85			external iaddr
86
87			#ifdef OAD_DEBUG_JOINT
88			character*(80):: indentation='
89			+ '
90			our_indent=our_indent+1
91
92			write(standardmessageunit, '(A,A,A)', ADVANCE='NO')
93			+'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
94			call oad_dump_revmod(); call oad_dump_tapestats()
95			write(standardmessageunit,*)
96			#endif
97
98			nIter0 = NINT( (startTime-baseTime)/deltaTClock )
99			if (our_rev_mode%arg_store) then
100			call cp_write_open()
101			#ifdef OAD_DEBUG_JOINT
102			write(standardmessageunit,'(A,A,A)')
103			+'OAD:',indentation(1:our_indent),
104			+' __SRNAME__: entering arg store'
105			#endif
106			!$PLACEHOLDER_PRAGMA$ id=8
107			call cp_close()
108			end if
109			if (our_rev_mode%arg_restore) then
110			#ifdef OAD_DEBUG_JOINT
111			write(standardmessageunit,'(A,A,A)')
112			+'OAD:',indentation(1:our_indent),
113			+' __SRNAME__: entering arg restore'
114			#endif
115			call cp_read_open()
116			!$PLACEHOLDER_PRAGMA$ id=9
117			call cp_close()
118			end if
119			if (our_rev_mode%plain) then
120			#ifdef OAD_DEBUG_JOINT
121			write(standardmessageunit,'(A,A,A)')
122			+'OAD:',indentation(1:our_indent),
123			+' __SRNAME__: run plain, down plain'
124			#endif
125	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
126			DO iloop1 = 1, nTimeSteps
127			PROD = (ILOOP1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
128			print *, 'DIVA Revolve Plain PROD = ', PROD
129			CALL OpenAD_forward_step( PROD, mytime, myiter, mythid )
130			enddo
131			#else
132	utke	1.1	DO iloop = 1, nTimeSteps
133			CALL OpenAD_forward_step( iloop, mytime, myiter, mythid )
134			enddo
135	heimbach	1.7	#endif
136	utke	1.1	end if
137			if (our_rev_mode%tape) then
138			#ifdef OAD_DEBUG_JOINT
139			write(standardmessageunit,'(A,A,A)')
140			+'OAD:',indentation(1:our_indent),
141			+' __SRNAME__: run tape, down revolve until first U turn'
142			#endif
143			currIter=0
144			jointCPcount=cp_fNumber()
145			initialized=rvInit(nTimeSteps,120,
146			+ errorMsg,theAction)
147			IF (.NOT.initialized) WRITE(*,'(A,A)') 'Error: ', errorMsg
148			do while (theAction%actionFlag/=rvDone)
149			theAction=rvNextAction()
150			select case (theAction%actionFlag)
151			case (rvStore)
152			call cp_write_open(theAction%cpNum+jointCPCount)
153			!$PLACEHOLDER_PRAGMA$ id=8
154			call cp_close
155			case (rvForward)
156			call OAD_revPlain
157			do currIter=currIter,theAction%iteration-1
158	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
159			PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
160			print *, 'DIVA Revolve Tape rvForward PROD = ', PROD
161			CALL OpenAD_forward_step( PROD, mytime,
162	utke	1.1	+myiter, mythid )
163	heimbach	1.7	#else
164			CALL OpenAD_forward_step( currIter+1, mytime,
165			+myiter, mythid )
166			#endif
167	utke	1.1	end do
168			call OAD_revTape
169			case (rvFirstUTurn)
170	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
171			PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
172			print *, 'DIVA Revolve Tape rvFirstUTurn PROD = ', PROD
173			CALL OpenAD_forward_step( PROD, mytime, myiter,
174			+mythid )
175			#else
176			CALL OpenAD_forward_step( currIter+1, mytime, myiter,
177	utke	1.1	+mythid )
178	heimbach	1.7	#endif
179	utke	1.1	! get out now ...
180			exit
181			end select
182			end do
183			end if
184			if (our_rev_mode%adjoint) then
185			IF (.NOT.initialized) WRITE(*,'(A)') 'Error: not initialized'
186			do while (theAction%actionFlag/=rvDone)
187			select case (theAction%actionFlag)
188			case (rvFirstUTurn)
189			!we taped already ... see above
190	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
191			PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
192			print *, 'DIVA Revolve Adjoint rvFirstUTurn PROD = ', PROD
193			CALL OpenAD_forward_step( PROD, mytime, myiter,
194			+mythid )
195			#else
196	utke	1.1	CALL OpenAD_forward_step( currIter+1, mytime, myiter,
197			+mythid )
198	heimbach	1.7	#endif
199	utke	1.1	case (rvStore)
200			call cp_write_open(theAction%cpNum+jointCPCount)
201			!$PLACEHOLDER_PRAGMA$ id=8
202			call cp_close
203			case (rvRestore)
204			call cp_read_open(theAction%cpNum+jointCPCount)
205			!$PLACEHOLDER_PRAGMA$ id=9
206			currIter=theAction%iteration
207			call cp_close
208			case (rvForward)
209			call OAD_revPlain
210			do currIter=currIter,theAction%iteration-1
211	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
212			PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
213			print *, 'DIVA Revolve Adjoint rvForward PROD = ', PROD
214			CALL OpenAD_forward_step( PROD, mytime, myiter,
215			+ mythid )
216			#else
217	utke	1.1	CALL OpenAD_forward_step( currIter+1, mytime, myiter,
218			+ mythid )
219	heimbach	1.7	#endif
220	utke	1.1	end do
221			call OAD_revAdjoint
222			case (rvUTurn)
223	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
224			PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
225			#endif
226	utke	1.1	call OAD_revTape
227	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
228			print *, 'DIVA Revolve Adjoint rvUTurn tp PROD = ', PROD
229			CALL OpenAD_forward_step( PROD, mytime, myiter,
230			+mythid )
231			#else
232			CALL OpenAD_forward_step( currIter+1, mytime, myiter,
233	utke	1.1	+mythid )
234	heimbach	1.7	#endif
235	utke	1.1	call OAD_revAdjoint
236	heimbach	1.7	#ifdef ALLOW_OPENAD_DIVA
237			print *, 'DIVA Revolve Adjoint rvUTurn ad PROD = ', PROD
238			CALL OpenAD_forward_step( PROD, mytime, myiter,
239			+mythid )
240			#else
241			CALL OpenAD_forward_step( currIter+1, mytime, myiter,
242	utke	1.1	+mythid )
243	heimbach	1.7	#endif
244	utke	1.1	end select
245			theAction=rvNextAction()
246			end do
247			end if
248
249			#ifdef OAD_DEBUG_JOINT
250			write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
251			+'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
252			call oad_dump_revmod(); call oad_dump_tapestats()
253			write(standardmessageunit,*)
254
255			our_indent=our_indent-1
256			#endif
257
258			end subroutine template