OpenAD/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	utke	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	utke	1.2	#ifdef OAD_DEBUG_JOINT
23	utke	1.1	character*(80):: indentation='
24			+ '
25			our_indent=our_indent+1
26
27	utke	1.3	write(standardmessageunit, '(A,A,A)', ADVANCE='NO')
28	utke	1.2	+'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
29	utke	1.1	call oad_dump_revmod(); call oad_dump_tapestats()
30	utke	1.3	write(standardmessageunit,*)
31	utke	1.2	#endif
32	utke	1.1	if (our_rev_mode%plain) then
33	utke	1.2	#ifdef OAD_DEBUG_JOINT
34	utke	1.3	write(standardmessageunit,'(A,A,A)')
35	utke	1.2	+'OAD:',indentation(1:our_indent),
36	utke	1.1	+' __SRNAME__: entering plain'
37	utke	1.2	#endif
38	utke	1.1	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	utke	1.2	#ifdef OAD_DEBUG_JOINT
46	utke	1.3	write(standardmessageunit,'(A,A,A)')
47	utke	1.2	+'OAD:',indentation(1:our_indent),
48	utke	1.1	+' __SRNAME__: runninng plain / down plain'
49	utke	1.2	#endif
50	utke	1.1	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	utke	1.4	O minResidualSq,
57	utke	1.1	O lastResidual,
58			U numIters,
59	utke	1.4	O nIterMin,
60	utke	1.1	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	utke	1.2	#ifdef OAD_DEBUG_JOINT
70	utke	1.3	write(standardmessageunit,'(A,A,A)')
71	utke	1.2	+'OAD:',indentation(1:our_indent),
72	utke	1.1	+' __SRNAME__: entering tape'
73	utke	1.2	#endif
74	utke	1.1	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	utke	1.2	#ifdef OAD_DEBUG_JOINT
82	utke	1.3	write(standardmessageunit,'(A,A,A)')
83	utke	1.2	+'OAD:',indentation(1:our_indent),
84	utke	1.1	+' __SRNAME__: runninng plain / down plain'
85	utke	1.2	#endif
86	utke	1.1	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	utke	1.4	O minResidualSq,
93	utke	1.1	O lastResidual,
94			U numIters,
95	utke	1.4	O nIterMin,
96	utke	1.1	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	utke	1.2	#ifdef OAD_DEBUG_JOINT
108	utke	1.3	write(standardmessageunit,'(A,A,A)')
109	utke	1.2	+'OAD:',indentation(1:our_indent),
110	utke	1.1	+' __SRNAME__: entering adjoint'
111	utke	1.2	#endif
112	utke	1.1	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	utke	1.2	#ifdef OAD_DEBUG_JOINT
141	utke	1.3	write(standardmessageunit,'(A,A,A)')
142	utke	1.2	+'OAD:',indentation(1:our_indent),
143	utke	1.1	+' __SRNAME__: runninng self adjoint / down plain'
144	utke	1.2	#endif
145	utke	1.1	call cg2d (
146			I cg2d_b_p,
147			U cg2d_x_p,
148			O firstResidual,
149	utke	1.4	O minResidualSq,
150	utke	1.1	O lastResidual,
151			U numIters,
152	utke	1.4	O nIterMin,
153	utke	1.1	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	utke	1.2	#ifdef OAD_DEBUG_JOINT
162	utke	1.3	write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
163	utke	1.2	+'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
164	utke	1.1	call oad_dump_revmod(); call oad_dump_tapestats()
165	utke	1.3	write(standardmessageunit,*)
166	utke	1.1
167			our_indent=our_indent-1
168	utke	1.2	#endif
169
170	utke	1.1	end subroutine template