/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/OAD_support/OAD_active.F90
ViewVC logotype

Annotation of /MITgcm_contrib/heimbach/OpenAD/OAD_support/OAD_active.F90

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


Revision 1.3 - (hide annotations) (download)
Tue Apr 21 15:54:06 2009 UTC (17 years, 4 months ago) by utke
Branch: MAIN
Changes since 1.2: +152 -8 lines
extended propagation options

1 utke 1.1 module OAD_active
2     use w2f__types
3     implicit none
4     private
5 utke 1.3 public :: active, saxpy, sax, zero_deriv, &
6     setderiv, set_neg_deriv, inc_deriv, dec_deriv, &
7     convert_p2a_scalar, convert_a2p_scalar, &
8     convert_p2a_vector, convert_a2p_vector, &
9     convert_p2a_matrix, convert_a2p_matrix, &
10     convert_p2a_three_tensor, convert_a2p_three_tensor, &
11     convert_p2a_four_tensor, convert_a2p_four_tensor, &
12     convert_p2a_five_tensor, convert_a2p_five_tensor, &
13     convert_p2a_six_tensor, convert_a2p_six_tensor, &
14     convert_p2a_seven_tensor, convert_a2p_seven_tensor, &
15     oad_allocateMatching
16 utke 1.1
17    
18     !
19     ! active needs to be a sequence type
20     ! with no initialization
21     !
22     type active
23     sequence
24     real(w2f__8) :: v
25     ! initialization does not work for active variables
26     ! inside of common block, such as in boxmodel
27     ! initialization is required for correct adjoint
28     real(w2f__8) :: d=0.0
29     ! real(w2f__8) :: d
30     end type active
31    
32     interface saxpy
33     module procedure saxpy_a_a
34     end interface
35    
36     interface setderiv
37     module procedure setderiv_a_a
38     end interface
39    
40 utke 1.3 interface set_neg_deriv
41     module procedure set_neg_deriv_a_a
42     end interface set_neg_deriv
43    
44     interface inc_deriv
45     module procedure inc_deriv_a_a
46     end interface inc_deriv
47    
48     interface dec_deriv
49     module procedure dec_deriv_a_a
50     end interface dec_deriv
51    
52 utke 1.1 interface zero_deriv
53     module procedure zero_deriv_a
54     end interface
55    
56     interface sax
57     module procedure sax_d_a_a, sax_i_a_a
58     end interface
59    
60     interface convert_p2a_scalar
61 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
62 utke 1.1 module procedure convert_sp2a_scalar_impl
63 utke 1.2 #endif
64 utke 1.1 module procedure convert_p2a_scalar_impl
65     end interface
66     interface convert_a2p_scalar
67 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
68 utke 1.1 module procedure convert_a2sp_scalar_impl
69 utke 1.2 #endif
70 utke 1.1 module procedure convert_a2p_scalar_impl
71     end interface
72    
73     interface convert_p2a_vector
74 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
75 utke 1.1 module procedure convert_sp2a_vector_impl
76 utke 1.2 #endif
77 utke 1.1 module procedure convert_p2a_vector_impl
78     end interface
79     interface convert_a2p_vector
80 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
81 utke 1.1 module procedure convert_a2sp_vector_impl
82 utke 1.2 #endif
83 utke 1.1 module procedure convert_a2p_vector_impl
84     end interface
85    
86     interface convert_p2a_matrix
87 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
88 utke 1.1 module procedure convert_sp2a_matrix_impl
89 utke 1.2 #endif
90 utke 1.1 module procedure convert_p2a_matrix_impl
91     end interface
92     interface convert_a2p_matrix
93 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
94 utke 1.1 module procedure convert_a2sp_matrix_impl
95 utke 1.2 #endif
96 utke 1.1 module procedure convert_a2p_matrix_impl
97     end interface
98    
99     interface convert_p2a_three_tensor
100 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
101 utke 1.1 module procedure convert_sp2a_three_tensor_impl
102 utke 1.2 #endif
103 utke 1.1 module procedure convert_p2a_three_tensor_impl
104     end interface
105     interface convert_a2p_three_tensor
106 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
107 utke 1.1 module procedure convert_a2sp_three_tensor_impl
108 utke 1.2 #endif
109 utke 1.1 module procedure convert_a2p_three_tensor_impl
110     end interface
111    
112     interface convert_p2a_four_tensor
113 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
114 utke 1.1 module procedure convert_sp2a_four_tensor_impl
115 utke 1.2 #endif
116 utke 1.1 module procedure convert_p2a_four_tensor_impl
117     end interface
118     interface convert_a2p_four_tensor
119 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
120 utke 1.1 module procedure convert_a2sp_four_tensor_impl
121 utke 1.2 #endif
122 utke 1.1 module procedure convert_a2p_four_tensor_impl
123     end interface
124    
125     interface convert_p2a_five_tensor
126 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
127 utke 1.1 module procedure convert_sp2a_five_tensor_impl
128 utke 1.2 #endif
129 utke 1.1 module procedure convert_p2a_five_tensor_impl
130     end interface
131     interface convert_a2p_five_tensor
132 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
133 utke 1.1 module procedure convert_a2sp_five_tensor_impl
134 utke 1.2 #endif
135 utke 1.1 module procedure convert_a2p_five_tensor_impl
136     end interface
137    
138 utke 1.3 interface convert_p2a_six_tensor
139     #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
140     module procedure convert_sp2a_six_tensor_impl
141     #endif
142     module procedure convert_p2a_six_tensor_impl
143     end interface
144     interface convert_a2p_six_tensor
145     #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
146     module procedure convert_a2sp_six_tensor_impl
147     #endif
148     module procedure convert_a2p_six_tensor_impl
149     end interface
150    
151     interface convert_p2a_seven_tensor
152     #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
153     module procedure convert_sp2a_seven_tensor_impl
154     #endif
155     module procedure convert_p2a_seven_tensor_impl
156     end interface
157     interface convert_a2p_seven_tensor
158     #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
159     module procedure convert_a2sp_seven_tensor_impl
160     #endif
161     module procedure convert_a2p_seven_tensor_impl
162     end interface
163    
164     interface oad_allocateMatching
165     module procedure oad_allocateMatchingV
166     end interface
167    
168 utke 1.1 contains
169    
170     !
171     ! chain rule saxpy to be used in forward and reverse modes
172     !
173    
174     subroutine saxpy_a_a(a,x,y)
175     real(w2f__8), intent(in) :: a
176     type(active), intent(in) :: x
177     type(active), intent(inout) :: y
178     y%d=y%d+x%d*a
179     end subroutine saxpy_a_a
180    
181     !
182     ! chain rule saxpy to be used in forward and reverse modes
183     ! derivative component of y is equal to zero initially
184     ! note: y needs to be inout as otherwise value component gets
185     ! zeroed out
186     !
187    
188     subroutine sax_d_a_a(a,x,y)
189     real(w2f__8), intent(in) :: a
190     type(active), intent(in) :: x
191     type(active), intent(inout) :: y
192     y%d=x%d*a
193     end subroutine sax_d_a_a
194    
195     subroutine sax_i_a_a(a,x,y)
196     integer(kind=w2f__i8), intent(in) :: a
197     type(active), intent(in) :: x
198     type(active), intent(inout) :: y
199     y%d=x%d*a
200     end subroutine sax_i_a_a
201    
202     !
203     ! set derivative of y to be equal to derivative of x
204     ! note: making y inout allows for already existing active
205     ! variables to become the target of a derivative assignment
206     !
207    
208     subroutine setderiv_a_a(y,x)
209     type(active), intent(inout) :: y
210     type(active), intent(in) :: x
211     y%d=x%d
212     end subroutine setderiv_a_a
213    
214     !
215 utke 1.3 ! set the derivative of y to be the negated derivative of x
216     ! note: making y inout allows for already existing active
217     ! variables to become the target of a derivative assignment
218     !
219    
220     subroutine set_neg_deriv_a_a(y,x)
221     type(active), intent(inout) :: y
222     type(active), intent(in) :: x
223     y%d = -x%d
224     end subroutine set_neg_deriv_a_a
225    
226     !
227     ! increment the derivative of y by the derivative of x
228     ! note: making y inout allows for already existing active
229     ! variables to become the target of a derivative assignment
230     !
231    
232     subroutine inc_deriv_a_a(y,x)
233     type(active), intent(inout) :: y
234     type(active), intent(in) :: x
235     y%d = y%d + x%d
236     end subroutine inc_deriv_a_a
237    
238     !
239     ! decrement the derivative of y by the derivative of x
240     ! note: making y inout allows for already existing active
241     ! variables to become the target of a derivative assignment
242     !
243    
244     subroutine dec_deriv_a_a(y,x)
245     type(active), intent(inout) :: y
246     type(active), intent(in) :: x
247     y%d = y%d - x%d
248     end subroutine dec_deriv_a_a
249    
250     !
251 utke 1.1 ! set derivative components to 0.0
252     !
253     subroutine zero_deriv_a(x)
254     type(active), intent(inout) :: x
255     x%d=0.0d0
256     end subroutine zero_deriv_a
257    
258     !
259     ! active/passive conversions
260     !
261 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
262 utke 1.1 subroutine convert_a2sp_scalar_impl(convertTo, convertFrom)
263     real(w2f__4), intent(out) :: convertTo
264     type(active), intent(in) :: convertFrom
265     convertTo=convertFrom%v
266     end subroutine
267 utke 1.2 #endif
268 utke 1.1
269     subroutine convert_a2p_scalar_impl(convertTo, convertFrom)
270     real(w2f__8), intent(out) :: convertTo
271     type(active), intent(in) :: convertFrom
272     convertTo=convertFrom%v
273     end subroutine
274    
275 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
276 utke 1.1 subroutine convert_sp2a_scalar_impl(convertTo, convertFrom)
277     real(w2f__4), intent(in) :: convertFrom
278     type(active), intent(inout) :: convertTo
279     convertTo%v=convertFrom
280     end subroutine
281 utke 1.2 #endif
282 utke 1.1
283     subroutine convert_p2a_scalar_impl(convertTo, convertFrom)
284     real(w2f__8), intent(in) :: convertFrom
285     type(active), intent(inout) :: convertTo
286     convertTo%v=convertFrom
287     end subroutine
288    
289 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
290 utke 1.1 subroutine convert_a2sp_vector_impl(convertTo, convertFrom)
291     type(active), dimension(:), intent(in) :: convertFrom
292     real(w2f__4), dimension(:), intent(out) :: convertTo
293     convertTo=convertFrom%v
294     end subroutine
295 utke 1.2 #endif
296 utke 1.1
297     subroutine convert_a2p_vector_impl(convertTo, convertFrom)
298     type(active), dimension(:), intent(in) :: convertFrom
299     real(w2f__8), dimension(:), intent(out) :: convertTo
300     convertTo=convertFrom%v
301     end subroutine
302    
303 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
304 utke 1.1 subroutine convert_sp2a_vector_impl(convertTo, convertFrom)
305     real(w2f__4), dimension(:), intent(in) :: convertFrom
306     type(active), dimension(:), intent(inout) :: convertTo
307     convertTo%v=convertFrom
308     end subroutine
309 utke 1.2 #endif
310 utke 1.1
311     subroutine convert_p2a_vector_impl(convertTo, convertFrom)
312     real(w2f__8), dimension(:), intent(in) :: convertFrom
313     type(active), dimension(:), intent(inout) :: convertTo
314     convertTo%v=convertFrom
315     end subroutine
316    
317 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
318 utke 1.1 subroutine convert_a2sp_matrix_impl(convertTo, convertFrom)
319     type(active), dimension(:,:), intent(in) :: convertFrom
320     real(w2f__4), dimension(:,:), intent(out) :: convertTo
321     convertTo=convertFrom%v
322     end subroutine
323 utke 1.2 #endif
324 utke 1.1
325     subroutine convert_a2p_matrix_impl(convertTo, convertFrom)
326     type(active), dimension(:,:), intent(in) :: convertFrom
327     real(w2f__8), dimension(:,:), intent(out) :: convertTo
328     convertTo=convertFrom%v
329     end subroutine
330    
331 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
332     subroutine convert_sp2a_matrix_impl(convertTo, convertFrom)
333     real(w2f__4), dimension(:,:), intent(in) :: convertFrom
334     type(active), dimension(:,:), intent(inout) :: convertTo
335     convertTo%v=convertFrom
336     end subroutine
337     #endif
338 utke 1.1 subroutine convert_p2a_matrix_impl(convertTo, convertFrom)
339     real(w2f__8), dimension(:,:), intent(in) :: convertFrom
340     type(active), dimension(:,:), intent(inout) :: convertTo
341     convertTo%v=convertFrom
342     end subroutine
343    
344 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
345 utke 1.1 subroutine convert_a2sp_three_tensor_impl(convertTo, convertFrom)
346     type(active), dimension(:,:,:), intent(in) :: convertFrom
347     real(w2f__4), dimension(:,:,:), intent(out) :: convertTo
348     convertTo=convertFrom%v
349     end subroutine
350 utke 1.2 #endif
351 utke 1.1
352     subroutine convert_a2p_three_tensor_impl(convertTo, convertFrom)
353     type(active), dimension(:,:,:), intent(in) :: convertFrom
354     real(w2f__8), dimension(:,:,:), intent(out) :: convertTo
355     convertTo=convertFrom%v
356     end subroutine
357    
358 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
359 utke 1.1 subroutine convert_sp2a_three_tensor_impl(convertTo, convertFrom)
360     real(w2f__4), dimension(:,:,:), intent(in) :: convertFrom
361     type(active), dimension(:,:,:), intent(inout) :: convertTo
362     convertTo%v=convertFrom
363     end subroutine
364 utke 1.2 #endif
365 utke 1.1
366     subroutine convert_p2a_three_tensor_impl(convertTo, convertFrom)
367     real(w2f__8), dimension(:,:,:), intent(in) :: convertFrom
368     type(active), dimension(:,:,:), intent(inout) :: convertTo
369     convertTo%v=convertFrom
370     end subroutine
371    
372 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
373 utke 1.1 subroutine convert_a2sp_four_tensor_impl(convertTo, convertFrom)
374     type(active), dimension(:,:,:,:), intent(in) :: convertFrom
375     real(w2f__4), dimension(:,:,:,:), intent(out) :: convertTo
376     convertTo=convertFrom%v
377     end subroutine
378 utke 1.2 #endif
379 utke 1.1
380     subroutine convert_a2p_four_tensor_impl(convertTo, convertFrom)
381     type(active), dimension(:,:,:,:), intent(in) :: convertFrom
382     real(w2f__8), dimension(:,:,:,:), intent(out) :: convertTo
383     convertTo=convertFrom%v
384     end subroutine
385    
386 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
387 utke 1.1 subroutine convert_sp2a_four_tensor_impl(convertTo, convertFrom)
388     real(w2f__4), dimension(:,:,:,:), intent(in) :: convertFrom
389     type(active), dimension(:,:,:,:), intent(inout) :: convertTo
390     convertTo%v=convertFrom
391     end subroutine
392 utke 1.2 #endif
393 utke 1.1
394     subroutine convert_p2a_four_tensor_impl(convertTo, convertFrom)
395     real(w2f__8), dimension(:,:,:,:), intent(in) :: convertFrom
396     type(active), dimension(:,:,:,:), intent(inout) :: convertTo
397     convertTo%v=convertFrom
398     end subroutine
399    
400 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
401 utke 1.1 subroutine convert_a2sp_five_tensor_impl(convertTo, convertFrom)
402     type(active), dimension(:,:,:,:,:), intent(in) :: convertFrom
403     real(w2f__4), dimension(:,:,:,:,:), intent(out) :: convertTo
404     convertTo=convertFrom%v
405     end subroutine
406 utke 1.2 #endif
407 utke 1.1
408     subroutine convert_a2p_five_tensor_impl(convertTo, convertFrom)
409     type(active), dimension(:,:,:,:,:), intent(in) :: convertFrom
410     real(w2f__8), dimension(:,:,:,:,:), intent(out) :: convertTo
411     convertTo=convertFrom%v
412     end subroutine
413    
414 utke 1.2 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
415 utke 1.1 subroutine convert_sp2a_five_tensor_impl(convertTo, convertFrom)
416     real(w2f__4), dimension(:,:,:,:,:), intent(in) :: convertFrom
417     type(active), dimension(:,:,:,:,:), intent(inout) :: convertTo
418     convertTo%v=convertFrom
419     end subroutine
420 utke 1.2 #endif
421 utke 1.1
422     subroutine convert_p2a_five_tensor_impl(convertTo, convertFrom)
423     real(w2f__8), dimension(:,:,:,:,:), intent(in) :: convertFrom
424     type(active), dimension(:,:,:,:,:), intent(inout) :: convertTo
425     convertTo%v=convertFrom
426     end subroutine
427    
428 utke 1.3 #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
429     subroutine convert_a2sp_six_tensor_impl(convertTo, convertFrom)
430     type(active), dimension(:,:,:,:,:,:), intent(in) :: convertFrom
431     real(w2f__4), dimension(:,:,:,:,:,:), intent(out) :: convertTo
432     convertTo=convertFrom%v
433     end subroutine
434     #endif
435    
436     subroutine convert_a2p_six_tensor_impl(convertTo, convertFrom)
437     type(active), dimension(:,:,:,:,:,:), intent(in) :: convertFrom
438     real(w2f__8), dimension(:,:,:,:,:,:), intent(out) :: convertTo
439     convertTo=convertFrom%v
440     end subroutine
441    
442     #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
443     subroutine convert_sp2a_six_tensor_impl(convertTo, convertFrom)
444     real(w2f__4), dimension(:,:,:,:,:,:), intent(in) :: convertFrom
445     type(active), dimension(:,:,:,:,:,:), intent(inout) :: convertTo
446     convertTo%v=convertFrom
447     end subroutine
448     #endif
449    
450     subroutine convert_p2a_six_tensor_impl(convertTo, convertFrom)
451     real(w2f__8), dimension(:,:,:,:,:,:), intent(in) :: convertFrom
452     type(active), dimension(:,:,:,:,:,:), intent(inout) :: convertTo
453     convertTo%v=convertFrom
454     end subroutine
455    
456     #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
457     subroutine convert_a2sp_seven_tensor_impl(convertTo, convertFrom)
458     type(active), dimension(:,:,:,:,:,:,:), intent(in) :: convertFrom
459     real(w2f__4), dimension(:,:,:,:,:,:,:), intent(out) :: convertTo
460     convertTo=convertFrom%v
461     end subroutine
462     #endif
463    
464     subroutine convert_a2p_seven_tensor_impl(convertTo, convertFrom)
465     type(active), dimension(:,:,:,:,:,:,:), intent(in) :: convertFrom
466     real(w2f__8), dimension(:,:,:,:,:,:,:), intent(out) :: convertTo
467     convertTo=convertFrom%v
468     end subroutine
469    
470     #ifdef ALLOW_AUTODIFF_MIXED_PRECISION
471     subroutine convert_sp2a_seven_tensor_impl(convertTo, convertFrom)
472     real(w2f__4), dimension(:,:,:,:,:,:,:), intent(in) :: convertFrom
473     type(active), dimension(:,:,:,:,:,:,:), intent(inout) :: convertTo
474     convertTo%v=convertFrom
475     end subroutine
476     #endif
477    
478     subroutine convert_p2a_seven_tensor_impl(convertTo, convertFrom)
479     real(w2f__8), dimension(:,:,:,:,:,:,:), intent(in) :: convertFrom
480     type(active), dimension(:,:,:,:,:,:,:), intent(inout) :: convertTo
481     convertTo%v=convertFrom
482     end subroutine
483    
484     subroutine oad_allocateMatchingV(toBeAllocated,allocateMatching)
485     implicit none
486     type(active), dimension(:), allocatable :: toBeAllocated
487     type(active), dimension(:) :: allocateMatching
488     allocate(toBeAllocated(size(allocateMatching)));
489     end subroutine
490    
491 utke 1.1 end module
492    

  ViewVC Help
Powered by ViewVC 1.1.22