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                lastResidual,
     U                numIters,
     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                lastResidual,
     U                numIters,
     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                lastResidual,
     U                numIters,
     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			O lastResidual,
57			U numIters,
58			I myThid)
59			cg2d_x%v=cg2d_x_p
60			c reset the mode
61			our_rev_mode=our_orig_mode
62			end if
63			if (our_rev_mode%tape) then
64
65			numItersHelper=numiters
66			mythidHelper=mythid
67	utke	1.2	#ifdef OAD_DEBUG_JOINT
68	utke	1.3	write(standardmessageunit,'(A,A,A)')
69	utke	1.2	+'OAD:',indentation(1:our_indent),
70	utke	1.1	+' __SRNAME__: entering tape'
71	utke	1.2	#endif
72	utke	1.1	c set up for plain execution
73			our_orig_mode=our_rev_mode
74			our_rev_mode%arg_store=.FALSE.
75			our_rev_mode%arg_restore=.FALSE.
76			our_rev_mode%plain=.TRUE.
77			our_rev_mode%tape=.FALSE.
78			our_rev_mode%adjoint=.FALSE.
79	utke	1.2	#ifdef OAD_DEBUG_JOINT
80	utke	1.3	write(standardmessageunit,'(A,A,A)')
81	utke	1.2	+'OAD:',indentation(1:our_indent),
82	utke	1.1	+' __SRNAME__: runninng plain / down plain'
83	utke	1.2	#endif
84	utke	1.1	cg2d_b_p=cg2d_b%v
85			cg2d_x_p=cg2d_x%v
86			call cg2d (
87			I cg2d_b_p,
88			U cg2d_x_p,
89			O firstResidual,
90			O lastResidual,
91			U numIters,
92			I myThid)
93			cg2d_x%v=cg2d_x_p
94			c reset the mode
95			our_rev_mode=our_orig_mode
96			c manually push two integers to the tape:
97			if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
98			oad_it(oad_it_ptr)=numItersHelper; oad_it_ptr=oad_it_ptr+1
99			if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
100			oad_it(oad_it_ptr)=mythidHelper; oad_it_ptr=oad_it_ptr+1
101			end if
102			if (our_rev_mode%adjoint) then
103	utke	1.2	#ifdef OAD_DEBUG_JOINT
104	utke	1.3	write(standardmessageunit,'(A,A,A)')
105	utke	1.2	+'OAD:',indentation(1:our_indent),
106	utke	1.1	+' __SRNAME__: entering adjoint'
107	utke	1.2	#endif
108	utke	1.1	c manually pop two integers from the tape:
109			oad_it_ptr=oad_it_ptr-1
110			mythid=oad_it(oad_it_ptr)
111			oad_it_ptr=oad_it_ptr-1
112			numiters=oad_it(oad_it_ptr)
113			c selfadjoint:
114			c the original is called with
115			c cg2d(b,x,...)
116			c in the adjoint context if we
117			c use the same code base
118			c we call with
119			c cg2d(x_bar,bh,...
120			c where afterwards
121			c b_bar+=bh and x_bar=0
122			c the adjoint second formal argument cg2d_x should be
123			c the values of the first argument:
124			cg2d_b_p=cg2d_x%d
125			c the first formal argument cg2d_b should hold
126			c the increment, i.e. we nullify the second formal
127			c argument (cg2d_x) value:
128			cg2d_x_p=0.0
129			c set up for plain execution
130			our_orig_mode=our_rev_mode
131			our_rev_mode%arg_store=.FALSE.
132			our_rev_mode%arg_restore=.FALSE.
133			our_rev_mode%plain=.TRUE.
134			our_rev_mode%tape=.FALSE.
135			our_rev_mode%adjoint=.FALSE.
136	utke	1.2	#ifdef OAD_DEBUG_JOINT
137	utke	1.3	write(standardmessageunit,'(A,A,A)')
138	utke	1.2	+'OAD:',indentation(1:our_indent),
139	utke	1.1	+' __SRNAME__: runninng self adjoint / down plain'
140	utke	1.2	#endif
141	utke	1.1	call cg2d (
142			I cg2d_b_p,
143			U cg2d_x_p,
144			O firstResidual,
145			O lastResidual,
146			U numIters,
147			I myThid)
148			c reset the mode
149			our_rev_mode=our_orig_mode
150			c now the adjoint result is the increment
151			c contained in the second formal argument
152			cg2d_b%d= cg2d_b%d+cg2d_x_p
153			cg2d_x%d=0.0
154			end if
155	utke	1.2	#ifdef OAD_DEBUG_JOINT
156	utke	1.3	write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
157	utke	1.2	+'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
158	utke	1.1	call oad_dump_revmod(); call oad_dump_tapestats()
159	utke	1.3	write(standardmessageunit,*)
160	utke	1.1
161			our_indent=our_indent-1
162	utke	1.2	#endif
163
164	utke	1.1	end subroutine template