tools/OAD_support/ad_template.revolve.F

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