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