/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/OAD_support/ad_template.joint.F
ViewVC logotype

Annotation of /MITgcm_contrib/heimbach/OpenAD/OAD_support/ad_template.joint.F

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


Revision 1.3 - (hide annotations) (download)
Thu Dec 19 16:04:50 2013 UTC (12 years, 8 months ago) by utke
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +0 -0 lines
FILE REMOVED
obsolete duplicates

1 utke 1.1 subroutine template()
2     use OAD_tape
3     use OAD_rev
4     use OAD_cp
5    
6    
7     ! original arguments get inserted before version
8     ! and declared here together with all local variables
9     ! generated by xaifBooster
10    
11     !$TEMPLATE_PRAGMA_DECLARATIONS
12    
13    
14     ! checkpointing stacks and offsets
15     integer :: cp_loop_variable_1,cp_loop_variable_2,
16     +cp_loop_variable_3,cp_loop_variable_4
17     ! floats 'F'
18     double precision, dimension(:), allocatable, save ::
19     +theArgFStack
20     integer, save :: theArgFStackoffset=0, theArgFStackSize=0
21     double precision, dimension(:), allocatable, save ::
22     +theResFStack
23     integer, save :: theResFStackoffset=0, theResFStackSize=0
24     ! integers 'I'
25     integer, dimension(:), allocatable, save ::
26     +theArgIStack
27     integer, save :: theArgIStackoffset=0, theArgIStackSize=0
28     integer, dimension(:), allocatable, save ::
29     +theResIStack
30     integer, save :: theResIStackoffset=0, theResIStackSize=0
31     ! booleans 'B'
32     logical, dimension(:), allocatable, save ::
33     +theArgBStack
34     integer, save :: theArgBStackoffset=0, theArgBStackSize=0
35     logical, dimension(:), allocatable, save ::
36     +theResBStack
37     integer, save :: theResBStackoffset=0, theResBStackSize=0
38     ! strings 'S'
39     character*(80), dimension(:), allocatable, save ::
40     +theArgSStack
41     integer, save :: theArgSStackoffset=0, theArgSStackSize=0
42     character*(80), dimension(:), allocatable, save ::
43     +theResSStack
44     integer, save :: theResSStackoffset=0, theResSStackSize=0
45    
46     type(modeType) :: our_orig_mode
47    
48     ! call external C function used in inlined code
49     integer iaddr
50     external iaddr
51    
52     if (our_rev_mode%arg_store) then
53     C print*, " arg_store ", our_rev_mode
54     C store arguments
55     !$PLACEHOLDER_PRAGMA$ id=4
56     end if
57     if (our_rev_mode%arg_restore) then
58     C print*, " arg_restore", our_rev_mode
59     C restore arguments
60     !$PLACEHOLDER_PRAGMA$ id=6
61     end if
62     if (our_rev_mode%plain) then
63     C print*, " plain ", our_rev_mode
64     our_orig_mode=our_rev_mode
65     our_rev_mode%arg_store=.FALSE.
66     C original function
67     !$PLACEHOLDER_PRAGMA$ id=1
68     our_rev_mode=our_orig_mode
69     end if
70     if (our_rev_mode%tape) then
71     C print*, " tape ", our_rev_mode
72     our_rev_mode%arg_store=.TRUE.
73     our_rev_mode%arg_restore=.FALSE.
74     our_rev_mode%res_store=.FALSE.
75     our_rev_mode%res_restore=.FALSE.
76     our_rev_mode%plain=.TRUE.
77     our_rev_mode%tape=.FALSE.
78     our_rev_mode%adjoint=.FALSE.
79     C taping
80     !$PLACEHOLDER_PRAGMA$ id=2
81     our_rev_mode%arg_store=.FALSE.
82     our_rev_mode%arg_restore=.FALSE.
83     our_rev_mode%res_store=.FALSE.
84     our_rev_mode%res_restore=.FALSE.
85     our_rev_mode%plain=.FALSE.
86     our_rev_mode%tape=.FALSE.
87     our_rev_mode%adjoint=.TRUE.
88     end if
89     if (our_rev_mode%res_restore) then
90     C restore results
91     !$PLACEHOLDER_PRAGMA$ id=7
92     end if
93     if (our_rev_mode%adjoint) then
94     C print*, " adjoint ", our_rev_mode
95     our_rev_mode%arg_store=.FALSE.
96     our_rev_mode%arg_restore=.TRUE.
97     our_rev_mode%res_store=.FALSE.
98     our_rev_mode%res_restore=.FALSE.
99     our_rev_mode%plain=.FALSE.
100     our_rev_mode%tape=.TRUE.
101     our_rev_mode%adjoint=.FALSE.
102     C adjoint
103     !$PLACEHOLDER_PRAGMA$ id=3
104     our_rev_mode%arg_store=.FALSE.
105     our_rev_mode%arg_restore=.TRUE.
106     our_rev_mode%res_store=.FALSE.
107     our_rev_mode%res_restore=.FALSE.
108     our_rev_mode%plain=.FALSE.
109     our_rev_mode%tape=.TRUE.
110     our_rev_mode%adjoint=.FALSE.
111     end if
112     if (our_rev_mode%res_store) then
113     C store results
114     C print*, " res_store ", our_rev_mode
115     !$PLACEHOLDER_PRAGMA$ id=5
116     end if
117     end subroutine template

  ViewVC Help
Powered by ViewVC 1.1.22