tools/OAD_support/ad_template.revolve.F

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