1 |
C ========== begin copyright notice ============== |
2 |
C This file is part of |
3 |
C --------------- |
4 |
C xaifBooster |
5 |
C --------------- |
6 |
C Distributed under the BSD license as follows: |
7 |
C Copyright (c) 2005, The University of Chicago |
8 |
C All rights reserved. |
9 |
C |
10 |
C Redistribution and use in source and binary forms, |
11 |
C with or without modification, are permitted provided that the following conditions are met: |
12 |
C |
13 |
C - Redistributions of source code must retain the above copyright notice, |
14 |
C this list of conditions and the following disclaimer. |
15 |
C - Redistributions in binary form must reproduce the above copyright notice, |
16 |
C this list of conditions and the following disclaimer in the documentation |
17 |
C and/or other materials provided with the distribution. |
18 |
C - Neither the name of The University of Chicago nor the names of its contributors |
19 |
C may be used to endorse or promote products derived from this software without |
20 |
C specific prior written permission. |
21 |
C |
22 |
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY |
23 |
C EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES |
24 |
C OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT |
25 |
C SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, |
26 |
C INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
27 |
C PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS |
28 |
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
29 |
C LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
30 |
C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
31 |
C |
32 |
C General Information: |
33 |
C xaifBooster is intended for the transformation of |
34 |
C numerical programs represented as xml files according |
35 |
C to the XAIF schema. It is part of the OpenAD framework. |
36 |
C The main application is automatic |
37 |
C differentiation, i.e. the generation of code for |
38 |
C the computation of derivatives. |
39 |
C The following people are the principal authors of the |
40 |
C current version: |
41 |
C Uwe Naumann |
42 |
C Jean Utke |
43 |
C Additional contributors are: |
44 |
C Andrew Lyons |
45 |
C Peter Fine |
46 |
C |
47 |
C For more details about xaifBooster and its use in OpenAD please visit: |
48 |
C http://www.mcs.anl.gov/openad |
49 |
C |
50 |
C This work is partially supported by: |
51 |
C NSF-ITR grant OCE-0205590 |
52 |
C ========== end copyright notice ============== |
53 |
subroutine template() |
54 |
use OpenAD_dct |
55 |
use OpenAD_tape |
56 |
use OpenAD_rev |
57 |
use OpenAD_checkpoints |
58 |
|
59 |
|
60 |
! original arguments get inserted before version |
61 |
! and declared here together with all local variables |
62 |
! generated by xaifBooster |
63 |
|
64 |
!$TEMPLATE_PRAGMA_DECLARATIONS |
65 |
|
66 |
|
67 |
! checkpointing stacks and offsets |
68 |
integer :: cp_loop_variable_1,cp_loop_variable_2, |
69 |
+cp_loop_variable_3,cp_loop_variable_4 |
70 |
! floats 'F' |
71 |
double precision, dimension(:), allocatable, save :: |
72 |
+theArgFStack |
73 |
integer, save :: theArgFStackoffset=0, theArgFStackSize=0 |
74 |
double precision, dimension(:), allocatable, save :: |
75 |
+theResFStack |
76 |
integer, save :: theResFStackoffset=0, theResFStackSize=0 |
77 |
! integers 'I' |
78 |
integer, dimension(:), allocatable, save :: |
79 |
+theArgIStack |
80 |
integer, save :: theArgIStackoffset=0, theArgIStackSize=0 |
81 |
integer, dimension(:), allocatable, save :: |
82 |
+theResIStack |
83 |
integer, save :: theResIStackoffset=0, theResIStackSize=0 |
84 |
! booleans 'B' |
85 |
logical, dimension(:), allocatable, save :: |
86 |
+theArgBStack |
87 |
integer, save :: theArgBStackoffset=0, theArgBStackSize=0 |
88 |
logical, dimension(:), allocatable, save :: |
89 |
+theResBStack |
90 |
integer, save :: theResBStackoffset=0, theResBStackSize=0 |
91 |
! strings 'S' |
92 |
character*(80), dimension(:), allocatable, save :: |
93 |
+theArgSStack |
94 |
integer, save :: theArgSStackoffset=0, theArgSStackSize=0 |
95 |
character*(80), dimension(:), allocatable, save :: |
96 |
+theResSStack |
97 |
integer, save :: theResSStackoffset=0, theResSStackSize=0 |
98 |
|
99 |
type(modeType) :: our_orig_mode |
100 |
|
101 |
! call external C function used in inlined code |
102 |
integer iaddr |
103 |
external iaddr |
104 |
|
105 |
C write(*,'(A,I6,A,I6,A,I6,A,I6,A,I5,A,I5)') |
106 |
C +"b:AF:", theArgFStackoffset, |
107 |
C +" AI:",theArgIStackoffset, |
108 |
C +" RF:",theResFStackoffset, |
109 |
C +" RI:",theResIStackoffset, |
110 |
C +" DT:",double_tape_pointer, |
111 |
C +" IT:",integer_tape_pointer |
112 |
if (our_rev_mode%arg_store) then |
113 |
C print*, " arg_store ", our_rev_mode |
114 |
C store arguments |
115 |
!$PLACEHOLDER_PRAGMA$ id=4 |
116 |
end if |
117 |
if (our_rev_mode%arg_restore) then |
118 |
C print*, " arg_restore", our_rev_mode |
119 |
C restore arguments |
120 |
!$PLACEHOLDER_PRAGMA$ id=6 |
121 |
end if |
122 |
if (our_rev_mode%plain) then |
123 |
C print*, " plain ", our_rev_mode |
124 |
our_orig_mode=our_rev_mode |
125 |
our_rev_mode%arg_store=.FALSE. |
126 |
C original function |
127 |
!$PLACEHOLDER_PRAGMA$ id=1 |
128 |
our_rev_mode=our_orig_mode |
129 |
end if |
130 |
if (our_rev_mode%tape) then |
131 |
C print*, " tape ", our_rev_mode |
132 |
our_rev_mode%arg_store=.TRUE. |
133 |
our_rev_mode%arg_restore=.FALSE. |
134 |
our_rev_mode%res_store=.FALSE. |
135 |
our_rev_mode%res_restore=.FALSE. |
136 |
our_rev_mode%plain=.TRUE. |
137 |
our_rev_mode%tape=.FALSE. |
138 |
our_rev_mode%adjoint=.FALSE. |
139 |
C taping |
140 |
!$PLACEHOLDER_PRAGMA$ id=2 |
141 |
our_rev_mode%arg_store=.FALSE. |
142 |
our_rev_mode%arg_restore=.FALSE. |
143 |
our_rev_mode%res_store=.FALSE. |
144 |
our_rev_mode%res_restore=.FALSE. |
145 |
our_rev_mode%plain=.FALSE. |
146 |
our_rev_mode%tape=.FALSE. |
147 |
our_rev_mode%adjoint=.TRUE. |
148 |
end if |
149 |
if (our_rev_mode%res_restore) then |
150 |
C restore results |
151 |
!$PLACEHOLDER_PRAGMA$ id=7 |
152 |
end if |
153 |
if (our_rev_mode%adjoint) then |
154 |
C print*, " adjoint ", our_rev_mode |
155 |
our_rev_mode%arg_store=.FALSE. |
156 |
our_rev_mode%arg_restore=.TRUE. |
157 |
our_rev_mode%res_store=.FALSE. |
158 |
our_rev_mode%res_restore=.FALSE. |
159 |
our_rev_mode%plain=.FALSE. |
160 |
our_rev_mode%tape=.TRUE. |
161 |
our_rev_mode%adjoint=.FALSE. |
162 |
C adjoint |
163 |
!$PLACEHOLDER_PRAGMA$ id=3 |
164 |
our_rev_mode%arg_store=.FALSE. |
165 |
our_rev_mode%arg_restore=.TRUE. |
166 |
our_rev_mode%res_store=.FALSE. |
167 |
our_rev_mode%res_restore=.FALSE. |
168 |
our_rev_mode%plain=.FALSE. |
169 |
our_rev_mode%tape=.TRUE. |
170 |
our_rev_mode%adjoint=.FALSE. |
171 |
end if |
172 |
if (our_rev_mode%res_store) then |
173 |
C store results |
174 |
C print*, " res_store ", our_rev_mode |
175 |
!$PLACEHOLDER_PRAGMA$ id=5 |
176 |
end if |
177 |
C write(*,'(A,I6,A,I6,A,I6,A,I6,A,I5,A,I5)') |
178 |
C +"a:AF:", theArgFStackoffset, |
179 |
C +" AI:",theArgIStackoffset, |
180 |
C +" RF:",theResFStackoffset, |
181 |
C +" RI:",theResIStackoffset, |
182 |
C +" DT:",double_tape_pointer, |
183 |
C +" IT:",integer_tape_pointer |
184 |
end subroutine template |