/[MITgcm]/MITgcm/tools/OAD_support/ad_template.streamice_cg_solve.F
ViewVC logotype

Annotation of /MITgcm/tools/OAD_support/ad_template.streamice_cg_solve.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (hide annotations) (download)
Thu Jan 16 15:15:50 2014 UTC (10 years, 2 months ago) by utke
Branch: MAIN
CVS Tags: checkpoint64u, checkpoint64t
Changes since 1.1: +2 -0 lines
tolerance had been missing

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     Real*8 cg_Uin_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
17     Real*8 cg_Vin_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
18     Real*8 cg_Bu_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
19     Real*8 cg_Bv_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
20     Real*8 A_uu_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
21     Real*8 A_vu_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
22     Real*8 A_uv_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
23     Real*8 A_vv_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
24     Real*8 cg_Uin_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
25     Real*8 cg_Vin_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
26     Real*8 cg_Bu_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
27     Real*8 cg_Bv_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
28     Real*8 A_uu_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
29     Real*8 A_vu_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
30     Real*8 A_uv_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
31     Real*8 A_vv_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
32    
33     #ifdef OAD_DEBUG_JOINT
34     character*(80):: indentation='
35     + '
36     our_indent=our_indent+1
37    
38     write(standardmessageunit, '(A,A,A)', ADVANCE='NO')
39     +'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
40     call oad_dump_revmod(); call oad_dump_tapestats()
41     write(standardmessageunit,*)
42     #endif
43     if (our_rev_mode%plain) then
44     #ifdef OAD_DEBUG_JOINT
45     write(standardmessageunit,'(A,A,A)')
46     +'OAD:',indentation(1:our_indent),
47     +' __SRNAME__: entering plain'
48     #endif
49     c set up for plain execution
50     our_orig_mode=our_rev_mode
51     our_rev_mode%arg_store=.FALSE.
52     our_rev_mode%arg_restore=.FALSE.
53     our_rev_mode%plain=.TRUE.
54     our_rev_mode%tape=.FALSE.
55     our_rev_mode%adjoint=.FALSE.
56     #ifdef OAD_DEBUG_JOINT
57     write(standardmessageunit,'(A,A,A)')
58     +'OAD:',indentation(1:our_indent),
59     +' __SRNAME__: runninng plain / down plain'
60     #endif
61     cg_Uin_p = cg_Uin%v
62     cg_Vin_p = cg_Vin%v
63     cg_Bu_p = cg_Bu%v
64     cg_Bv_p = cg_Bv%v
65     A_uu_p = A_uu%v
66     A_uv_p = A_uv%v
67     A_vu_p = A_vu%v
68     A_vv_p = A_vv%v
69     call STREAMICE_CG_SOLVE(
70     U cg_Uin_p,
71     U cg_Vin_p,
72     I cg_Bu_p,
73     I cg_Bv_p,
74     I A_uu_p,
75     I A_uv_p,
76     I A_vu_p,
77     I A_vv_p,
78     I tolerance,
79     O iters,
80     I myThid )
81     cg_Uin%v = cg_Uin_p
82     cg_Vin%v = cg_Vin_p
83     c reset the mode
84     our_rev_mode=our_orig_mode
85     end if
86     if (our_rev_mode%tape) then
87    
88     #ifdef OAD_DEBUG_JOINT
89     write(standardmessageunit,'(A,A,A)')
90     +'OAD:',indentation(1:our_indent),
91     +' __SRNAME__: entering tape'
92     #endif
93     c set up for plain execution
94     our_orig_mode=our_rev_mode
95     our_rev_mode%arg_store=.FALSE.
96     our_rev_mode%arg_restore=.FALSE.
97     our_rev_mode%plain=.TRUE.
98     our_rev_mode%tape=.FALSE.
99     our_rev_mode%adjoint=.FALSE.
100     #ifdef OAD_DEBUG_JOINT
101     write(standardmessageunit,'(A,A,A)')
102     +'OAD:',indentation(1:our_indent),
103     +' __SRNAME__: runninng plain / down plain'
104     #endif
105     cg_Uin_p = cg_Uin%v
106     cg_Vin_p = cg_Vin%v
107     cg_Bu_p = cg_Bu%v
108     cg_Bv_p = cg_Bv%v
109     A_uu_p = A_uu%v
110     A_uv_p = A_uv%v
111     A_vu_p = A_vu%v
112     A_vv_p = A_vv%v
113     call oad_tape_push(cg_Bu_p)
114     call oad_tape_push(cg_Bv_p)
115     call oad_tape_push(A_uu_p)
116     call oad_tape_push(A_uv_p)
117     call oad_tape_push(A_vu_p)
118     call oad_tape_push(A_vv_p)
119 utke 1.2 call oad_tape_push(tolerance)
120 utke 1.1 call oad_tape_push(mythid)
121     call STREAMICE_CG_SOLVE(
122     U cg_Uin_p,
123     U cg_Vin_p,
124     I cg_Bu_p,
125     I cg_Bv_p,
126     I A_uu_p,
127     I A_uv_p,
128     I A_vu_p,
129     I A_vv_p,
130     I tolerance,
131     O iters,
132     I myThid )
133     call oad_tape_push(cg_Uin_p)
134     call oad_tape_push(cg_Vin_p)
135     cg_Uin%v = cg_Uin_p
136     cg_Vin%v = cg_Vin_p
137     c reset the mode
138     our_rev_mode=our_orig_mode
139     end if
140     if (our_rev_mode%adjoint) then
141     #ifdef OAD_DEBUG_JOINT
142     write(standardmessageunit,'(A,A,A)')
143     +'OAD:',indentation(1:our_indent),
144     +' __SRNAME__: entering adjoint'
145     #endif
146     call oad_tape_pop(cg_Vin_p)
147     call oad_tape_pop(cg_Uin_p)
148     call oad_tape_pop(mythid)
149 utke 1.2 call oad_tape_pop(tolerance)
150 utke 1.1 call oad_tape_pop(A_vv_p)
151     call oad_tape_pop(A_vu_p)
152     call oad_tape_pop(A_uv_p)
153     call oad_tape_pop(A_uu_p)
154     call oad_tape_pop(cg_Bv_p)
155     call oad_tape_pop(cg_Bu_p)
156     c set up for plain execution
157     our_orig_mode=our_rev_mode
158     our_rev_mode%arg_store=.FALSE.
159     our_rev_mode%arg_restore=.FALSE.
160     our_rev_mode%plain=.TRUE.
161     our_rev_mode%tape=.FALSE.
162     our_rev_mode%adjoint=.FALSE.
163     #ifdef OAD_DEBUG_JOINT
164     write(standardmessageunit,'(A,A,A)')
165     +'OAD:',indentation(1:our_indent),
166     +' __SRNAME__: runninng self adjoint / down plain'
167     #endif
168     cg_Uin_d = cg_Uin%d
169     cg_Vin_d = cg_Vin%d
170     cg_Bu_d = cg_Bu%d
171     cg_Bv_d = cg_Bv%d
172     A_uu_d = A_uu%d
173     A_uv_d = A_uv%d
174     A_vu_d = A_vu%d
175     A_vv_d = A_vv%d
176     call ADSTREAMICE_CG_SOLVE(
177     U cg_Uin_p, ! velocities - solution
178     I cg_Bu_d, ! adjoint of vel (input)
179     U cg_Vin_p, ! velocities - solution
180     I cg_Bv_d, ! adjoint of vel (input)
181     I cg_Bu_p, ! to recalc velocities
182     U cg_Uin_d, ! adjoint of RHS (output)
183     I cg_Bv_p, ! to recalc velocities
184     U cg_Vin_d, ! adjoint of RHS (output)
185     I A_uu_p, ! section of matrix that multiplies u and projects on u
186     U A_uu_d, ! adjoint of matrix coeffs (output)
187     I A_uv_p, ! section of matrix that multiplies v and projects on u
188     U A_uv_d, ! adjoint of matrix coeffs (output)
189     I A_vu_p, ! section of matrix that multiplies u and projects on v
190     U A_vu_d, ! adjoint of matrix coeffs (output)
191     I A_vv_p, ! section of matrix that multiplies v and projects on v
192     U A_vv_d, ! adjoint of matrix coeffs (output)
193     I tolerance,
194     c I iters,
195     I myThid )
196     c reset the mode
197     cg_Uin%d = cg_Uin_d
198     cg_Vin%d = cg_Vin_d
199     cg_Bu%d = cg_Bu_d
200     cg_Bv%d = cg_Bv_d
201     A_uu%d = A_uu_d
202     A_uv%d = A_uv_d
203     A_vu%d = A_vu_d
204     A_vv%d = A_vv_d
205     our_rev_mode=our_orig_mode
206     end if
207     #ifdef OAD_DEBUG_JOINT
208     write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
209     +'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
210     call oad_dump_revmod(); call oad_dump_tapestats()
211     write(standardmessageunit,*)
212    
213     our_indent=our_indent-1
214     #endif
215    
216     end subroutine template

  ViewVC Help
Powered by ViewVC 1.1.22