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