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

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