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)

      character*(80):: indentation='                                        
     +                                         '
      our_indent=our_indent+1

      write(*, '(A,A,A)', ADVANCE='NO') 
     +'JU:',indentation(1:our_indent), 'enter __SRNAME__:'
      call oad_dump_revmod(); call oad_dump_tapestats()
      write(*,*) 

      if (our_rev_mode%plain) then
         write(*,'(A,A,A)') 
     +'JU:',indentation(1:our_indent), 
     +' __SRNAME__: entering plain'
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.
         write(*,'(A,A,A)') 
     +'JU:',indentation(1:our_indent), 
     +' __SRNAME__: runninng plain / down plain'
         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

         write(*,'(A,A,A)') 
     +'JU:',indentation(1:our_indent), 
     +' __SRNAME__: entering tape'
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.
         write(*,'(A,A,A)') 
     +'JU:',indentation(1:our_indent), 
     +' __SRNAME__: runninng plain / down plain'
         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
         write(*,'(A,A,A)') 
     +'JU:',indentation(1:our_indent), 
     +' __SRNAME__: entering adjoint'
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.
         write(*,'(A,A,A)') 
     +'JU:',indentation(1:our_indent), 
     +' __SRNAME__: runninng self adjoint / down plain'
        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 

      write(*,'(A,A,A)', ADVANCE='NO') 
     +'JU:',indentation(1:our_indent), 'leave __SRNAME__:'
      call oad_dump_revmod(); call oad_dump_tapestats()
      write(*,*) 

      our_indent=our_indent-1
      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	utke	1.4	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.1	character*(80):: indentation='
23			+ '
24			our_indent=our_indent+1
25
26	utke	1.2	write(*, '(A,A,A)', ADVANCE='NO')
27			+'JU:',indentation(1:our_indent), 'enter __SRNAME__:'
28			call oad_dump_revmod(); call oad_dump_tapestats()
29			write(,)
30	utke	1.1
31			if (our_rev_mode%plain) then
32			write(*,'(A,A,A)')
33			+'JU:',indentation(1:our_indent),
34			+' __SRNAME__: entering plain'
35			c set up for plain execution
36			our_orig_mode=our_rev_mode
37			our_rev_mode%arg_store=.FALSE.
38			our_rev_mode%arg_restore=.FALSE.
39			our_rev_mode%plain=.TRUE.
40			our_rev_mode%tape=.FALSE.
41			our_rev_mode%adjoint=.FALSE.
42			write(*,'(A,A,A)')
43			+'JU:',indentation(1:our_indent),
44			+' __SRNAME__: runninng plain / down plain'
45	utke	1.4	cg2d_b_p=cg2d_b%v
46			cg2d_x_p=cg2d_x%v
47	utke	1.3	call cg2d (
48	utke	1.4	I cg2d_b_p,
49			U cg2d_x_p,
50	utke	1.3	O firstResidual,
51			O lastResidual,
52			U numIters,
53			I myThid)
54	utke	1.4	cg2d_x%v=cg2d_x_p
55	utke	1.1	c reset the mode
56			our_rev_mode=our_orig_mode
57			end if
58			if (our_rev_mode%tape) then
59
60			numItersHelper=numiters
61			mythidHelper=mythid
62
63			write(*,'(A,A,A)')
64			+'JU:',indentation(1:our_indent),
65			+' __SRNAME__: entering tape'
66			c set up for plain execution
67			our_orig_mode=our_rev_mode
68			our_rev_mode%arg_store=.FALSE.
69			our_rev_mode%arg_restore=.FALSE.
70			our_rev_mode%plain=.TRUE.
71			our_rev_mode%tape=.FALSE.
72			our_rev_mode%adjoint=.FALSE.
73			write(*,'(A,A,A)')
74			+'JU:',indentation(1:our_indent),
75			+' __SRNAME__: runninng plain / down plain'
76	utke	1.4	cg2d_b_p=cg2d_b%v
77			cg2d_x_p=cg2d_x%v
78	utke	1.3	call cg2d (
79	utke	1.4	I cg2d_b_p,
80			U cg2d_x_p,
81	utke	1.3	O firstResidual,
82			O lastResidual,
83			U numIters,
84			I myThid)
85	utke	1.4	cg2d_x%v=cg2d_x_p
86	utke	1.1	c reset the mode
87			our_rev_mode=our_orig_mode
88	utke	1.2	c manually push two integers to the tape:
89			if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
90			oad_it(oad_it_ptr)=numItersHelper; oad_it_ptr=oad_it_ptr+1
91			if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
92			oad_it(oad_it_ptr)=mythidHelper; oad_it_ptr=oad_it_ptr+1
93	utke	1.1	end if
94			if (our_rev_mode%adjoint) then
95			write(*,'(A,A,A)')
96			+'JU:',indentation(1:our_indent),
97			+' __SRNAME__: entering adjoint'
98	utke	1.2	c manually pop two integers from the tape:
99			oad_it_ptr=oad_it_ptr-1
100			mythid=oad_it(oad_it_ptr)
101			oad_it_ptr=oad_it_ptr-1
102			numiters=oad_it(oad_it_ptr)
103	utke	1.1	c selfadjoint:
104			c the original is called with
105			c cg2d(b,x,...)
106			c in the adjoint context if we
107			c use the same code base
108			c we call with
109			c cg2d(x_bar,bh,...
110			c where afterwards
111			c b_bar+=bh and x_bar=0
112			c the adjoint second formal argument cg2d_x should be
113			c the values of the first argument:
114	utke	1.4	cg2d_b_p=cg2d_x%d
115	utke	1.1	c the first formal argument cg2d_b should hold
116			c the increment, i.e. we nullify the second formal
117			c argument (cg2d_x) value:
118	utke	1.4	cg2d_x_p=0.0
119	utke	1.1	c set up for plain execution
120			our_orig_mode=our_rev_mode
121			our_rev_mode%arg_store=.FALSE.
122			our_rev_mode%arg_restore=.FALSE.
123			our_rev_mode%plain=.TRUE.
124			our_rev_mode%tape=.FALSE.
125			our_rev_mode%adjoint=.FALSE.
126			write(*,'(A,A,A)')
127			+'JU:',indentation(1:our_indent),
128			+' __SRNAME__: runninng self adjoint / down plain'
129	utke	1.3	call cg2d (
130	utke	1.4	I cg2d_b_p,
131			U cg2d_x_p,
132	utke	1.3	O firstResidual,
133			O lastResidual,
134			U numIters,
135			I myThid)
136	utke	1.1	c reset the mode
137			our_rev_mode=our_orig_mode
138			c now the adjoint result is the increment
139			c contained in the second formal argument
140	utke	1.4	cg2d_b%d= cg2d_b%d+cg2d_x_p
141	utke	1.3	cg2d_x%d=0.0
142	utke	1.1	end if
143
144	utke	1.2	write(*,'(A,A,A)', ADVANCE='NO')
145			+'JU:',indentation(1:our_indent), 'leave __SRNAME__:'
146			call oad_dump_revmod(); call oad_dump_tapestats()
147			write(,)
148	utke	1.1
149			our_indent=our_indent-1
150			end subroutine template