tools/OAD_support/ad_template.sa_cg2d.F

      subroutine template()
      use OAD_cp
      use OAD_tape
      use OAD_rev

!$TEMPLATE_PRAGMA_DECLARATIONS

      integer :: cp_loop_variable_1,cp_loop_variable_2,
     +     cp_loop_variable_3,cp_loop_variable_4

      type(modeType) :: our_orig_mode

      integer iaddr
      external iaddr

      INTEGER numItersHelper
      INTEGER myThidHelper

      Real*8  cg2d_b_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      Real*8  cg2d_x_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)

#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
      if (our_rev_mode%plain) then
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: entering plain'
#endif
c set up for plain execution
         our_orig_mode=our_rev_mode
         our_rev_mode%arg_store=.FALSE.
         our_rev_mode%arg_restore=.FALSE.
         our_rev_mode%plain=.TRUE.
         our_rev_mode%tape=.FALSE.
         our_rev_mode%adjoint=.FALSE.
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: runninng plain / down plain'
#endif
         cg2d_b_p=cg2d_b%v
         cg2d_x_p=cg2d_x%v
        call cg2d (
     I                cg2d_b_p,
     U                cg2d_x_p,
     O                firstResidual,
     O                minResidualSq,
     O                lastResidual,
     U                numIters,
     O                nIterMin,
     I                myThid) 
        cg2d_x%v=cg2d_x_p        
c reset the mode
         our_rev_mode=our_orig_mode
      end if
      if (our_rev_mode%tape) then

         numItersHelper=numiters
         mythidHelper=mythid
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: entering tape'
#endif
c set up for plain execution
         our_orig_mode=our_rev_mode
         our_rev_mode%arg_store=.FALSE.
         our_rev_mode%arg_restore=.FALSE.
         our_rev_mode%plain=.TRUE.
         our_rev_mode%tape=.FALSE.
         our_rev_mode%adjoint=.FALSE.
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: runninng plain / down plain'
#endif
         cg2d_b_p=cg2d_b%v
         cg2d_x_p=cg2d_x%v
        call cg2d (
     I                cg2d_b_p,
     U                cg2d_x_p,
     O                firstResidual,
     O                minResidualSq,
     O                lastResidual,
     U                numIters,
     O                nIterMin,
     I                myThid) 
        cg2d_x%v=cg2d_x_p        
c reset the mode
         our_rev_mode=our_orig_mode
c manually push two integers to the tape:        
         if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
         oad_it(oad_it_ptr)=numItersHelper; oad_it_ptr=oad_it_ptr+1
         if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
         oad_it(oad_it_ptr)=mythidHelper; oad_it_ptr=oad_it_ptr+1
      end if
      if (our_rev_mode%adjoint) then
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: entering adjoint'
#endif
c manually pop two integers from the tape:        
      oad_it_ptr=oad_it_ptr-1
      mythid=oad_it(oad_it_ptr)
      oad_it_ptr=oad_it_ptr-1
      numiters=oad_it(oad_it_ptr)
c selfadjoint:
c the original is called with 
c  cg2d(b,x,...)
c in the adjoint context if we 
c use the same code base 
c we call with 
c  cg2d(x_bar,bh,...
c where afterwards
c b_bar+=bh  and x_bar=0
c the adjoint second formal argument cg2d_x should be
c the values of the first argument:  
      cg2d_b_p=cg2d_x%d
c the first formal argument cg2d_b should hold 
c the increment, i.e. we nullify the second formal 
c argument (cg2d_x) value:
      cg2d_x_p=0.0
c set up for plain execution
         our_orig_mode=our_rev_mode
         our_rev_mode%arg_store=.FALSE.
         our_rev_mode%arg_restore=.FALSE.
         our_rev_mode%plain=.TRUE.
         our_rev_mode%tape=.FALSE.
         our_rev_mode%adjoint=.FALSE.
#ifdef OAD_DEBUG_JOINT
         write(standardmessageunit,'(A,A,A)') 
     +'OAD:',indentation(1:our_indent), 
     +' __SRNAME__: runninng self adjoint / down plain'
#endif
        call cg2d (
     I                cg2d_b_p,
     U                cg2d_x_p,
     O                firstResidual,
     O                minResidualSq,
     O                lastResidual,
     U                numIters,
     O                nIterMin,
     I                myThid) 
c reset the mode
         our_rev_mode=our_orig_mode
c now the adjoint result is the increment 
c contained in the second formal argument
         cg2d_b%d= cg2d_b%d+cg2d_x_p
         cg2d_x%d=0.0
      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.1	subroutine template()
2			use OAD_cp
3			use OAD_tape
4			use OAD_rev
5
6			!$TEMPLATE_PRAGMA_DECLARATIONS
7
8			integer :: cp_loop_variable_1,cp_loop_variable_2,
9			+ cp_loop_variable_3,cp_loop_variable_4
10
11			type(modeType) :: our_orig_mode
12
13			integer iaddr
14			external iaddr
15
16			INTEGER numItersHelper
17			INTEGER myThidHelper
18
19			Real*8 cg2d_b_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
20			Real*8 cg2d_x_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
21
22			#ifdef OAD_DEBUG_JOINT
23			character*(80):: indentation='
24			+ '
25			our_indent=our_indent+1
26
27			write(standardmessageunit, '(A,A,A)', ADVANCE='NO')
28			+'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
29			call oad_dump_revmod(); call oad_dump_tapestats()
30			write(standardmessageunit,*)
31			#endif
32			if (our_rev_mode%plain) then
33			#ifdef OAD_DEBUG_JOINT
34			write(standardmessageunit,'(A,A,A)')
35			+'OAD:',indentation(1:our_indent),
36			+' __SRNAME__: entering plain'
37			#endif
38			c set up for plain execution
39			our_orig_mode=our_rev_mode
40			our_rev_mode%arg_store=.FALSE.
41			our_rev_mode%arg_restore=.FALSE.
42			our_rev_mode%plain=.TRUE.
43			our_rev_mode%tape=.FALSE.
44			our_rev_mode%adjoint=.FALSE.
45			#ifdef OAD_DEBUG_JOINT
46			write(standardmessageunit,'(A,A,A)')
47			+'OAD:',indentation(1:our_indent),
48			+' __SRNAME__: runninng plain / down plain'
49			#endif
50			cg2d_b_p=cg2d_b%v
51			cg2d_x_p=cg2d_x%v
52			call cg2d (
53			I cg2d_b_p,
54			U cg2d_x_p,
55			O firstResidual,
56			O minResidualSq,
57			O lastResidual,
58			U numIters,
59			O nIterMin,
60			I myThid)
61			cg2d_x%v=cg2d_x_p
62			c reset the mode
63			our_rev_mode=our_orig_mode
64			end if
65			if (our_rev_mode%tape) then
66
67			numItersHelper=numiters
68			mythidHelper=mythid
69			#ifdef OAD_DEBUG_JOINT
70			write(standardmessageunit,'(A,A,A)')
71			+'OAD:',indentation(1:our_indent),
72			+' __SRNAME__: entering tape'
73			#endif
74			c set up for plain execution
75			our_orig_mode=our_rev_mode
76			our_rev_mode%arg_store=.FALSE.
77			our_rev_mode%arg_restore=.FALSE.
78			our_rev_mode%plain=.TRUE.
79			our_rev_mode%tape=.FALSE.
80			our_rev_mode%adjoint=.FALSE.
81			#ifdef OAD_DEBUG_JOINT
82			write(standardmessageunit,'(A,A,A)')
83			+'OAD:',indentation(1:our_indent),
84			+' __SRNAME__: runninng plain / down plain'
85			#endif
86			cg2d_b_p=cg2d_b%v
87			cg2d_x_p=cg2d_x%v
88			call cg2d (
89			I cg2d_b_p,
90			U cg2d_x_p,
91			O firstResidual,
92			O minResidualSq,
93			O lastResidual,
94			U numIters,
95			O nIterMin,
96			I myThid)
97			cg2d_x%v=cg2d_x_p
98			c reset the mode
99			our_rev_mode=our_orig_mode
100			c manually push two integers to the tape:
101			if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
102			oad_it(oad_it_ptr)=numItersHelper; oad_it_ptr=oad_it_ptr+1
103			if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
104			oad_it(oad_it_ptr)=mythidHelper; oad_it_ptr=oad_it_ptr+1
105			end if
106			if (our_rev_mode%adjoint) then
107			#ifdef OAD_DEBUG_JOINT
108			write(standardmessageunit,'(A,A,A)')
109			+'OAD:',indentation(1:our_indent),
110			+' __SRNAME__: entering adjoint'
111			#endif
112			c manually pop two integers from the tape:
113			oad_it_ptr=oad_it_ptr-1
114			mythid=oad_it(oad_it_ptr)
115			oad_it_ptr=oad_it_ptr-1
116			numiters=oad_it(oad_it_ptr)
117			c selfadjoint:
118			c the original is called with
119			c cg2d(b,x,...)
120			c in the adjoint context if we
121			c use the same code base
122			c we call with
123			c cg2d(x_bar,bh,...
124			c where afterwards
125			c b_bar+=bh and x_bar=0
126			c the adjoint second formal argument cg2d_x should be
127			c the values of the first argument:
128			cg2d_b_p=cg2d_x%d
129			c the first formal argument cg2d_b should hold
130			c the increment, i.e. we nullify the second formal
131			c argument (cg2d_x) value:
132			cg2d_x_p=0.0
133			c set up for plain execution
134			our_orig_mode=our_rev_mode
135			our_rev_mode%arg_store=.FALSE.
136			our_rev_mode%arg_restore=.FALSE.
137			our_rev_mode%plain=.TRUE.
138			our_rev_mode%tape=.FALSE.
139			our_rev_mode%adjoint=.FALSE.
140			#ifdef OAD_DEBUG_JOINT
141			write(standardmessageunit,'(A,A,A)')
142			+'OAD:',indentation(1:our_indent),
143			+' __SRNAME__: runninng self adjoint / down plain'
144			#endif
145			call cg2d (
146			I cg2d_b_p,
147			U cg2d_x_p,
148			O firstResidual,
149			O minResidualSq,
150			O lastResidual,
151			U numIters,
152			O nIterMin,
153			I myThid)
154			c reset the mode
155			our_rev_mode=our_orig_mode
156			c now the adjoint result is the increment
157			c contained in the second formal argument
158			cg2d_b%d= cg2d_b%d+cg2d_x_p
159			cg2d_x%d=0.0
160			end if
161			#ifdef OAD_DEBUG_JOINT
162			write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
163			+'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
164			call oad_dump_revmod(); call oad_dump_tapestats()
165			write(standardmessageunit,*)
166
167			our_indent=our_indent-1
168			#endif
169
170			end subroutine template