3 # Shell script to create the pup_f.f90 file.
4 # Used to avoid duplicate copy-and-paste code in pup_f.f90.
6 cat > pup_f.f90
<< END_OF_HEADER
7 ! DO NOT EDIT THIS FILE, GENERATE IT FROM RUNNING pup_f.f90.sh
12 function fpup_issizing(p)
16 function fpup_ispacking(p)
18 logical fpup_ispacking
20 function fpup_isunpacking(p)
22 logical fpup_isunpacking
24 function fpup_isdeleting(p)
26 logical fpup_isdeleting
28 function fpup_isuserlevel(p)
30 logical fpup_isuserlevel
33 subroutine fpup_char(p, d)
37 subroutine fpup_short(p, d)
41 subroutine fpup_int(p, d)
45 subroutine fpup_long(p, d)
49 subroutine fpup_real(p, d)
53 subroutine fpup_double(p, d)
57 subroutine fpup_logical(p, d)
62 subroutine fpup_complex(p, d)
67 subroutine fpup_doublecomplex(p, d)
76 for t
in chars ints longs reals doubles logicals complexes doublecomplexes
78 echo " interface fpup_${t}" >> pup_f.f90
81 echo " module procedure fpup_${t}_0" >> pup_f.f90
83 for i
in 1 2 3 4 5 6 7
85 echo " module procedure fpup_${t}_${i}" >> pup_f.f90
87 echo " end interface fpup_${t}" >> pup_f.f90
91 cat >> pup_f.f90
<< END_OF_HEADER
93 module procedure pi,pia1d,pia2d,pia3d,pia4d,pia5d,pia6d,pia7d
94 module procedure pc,pca1d,pca2d,pca3d,pca4d,pca5d,pca6d,pca7d
95 module procedure ps,psa1d,psa2d,psa3d,psa4d,psa5d,psa6d,psa7d
96 module procedure pr,pra1d,pra2d,pra3d,pra4d,pra5d,pra6d,pra7d
97 module procedure pd,pda1d,pda2d,pda3d,pda4d,pda5d,pda6d,pda7d
98 module procedure pl,pla1d,pla2d,pla3d,pla4d,pla5d,pla6d,pla7d
99 module procedure px,pxa1d,pxa2d,pxa3d,pxa4d,pxa5d,pxa6d,pxa7d
100 module procedure py,pya1d,pya2d,pya3d,pya4d,pya5d,pya6d,pya7d
103 module procedure apia1d,apia2d,apia3d,apia4d,apia5d,apia6d,apia7d
104 module procedure apca1d,apca2d,apca3d,apca4d,apca5d,apca6d,apca7d
105 module procedure apsa1d,apsa2d,apsa3d,apsa4d,apsa5d,apsa6d,apsa7d
106 module procedure apra1d,apra2d,apra3d,apra4d,apra5d,apra6d,apra7d
107 module procedure apda1d,apda2d,apda3d,apda4d,apda5d,apda6d,apda7d
108 module procedure apla1d,apla2d,apla3d,apla4d,apla5d,apla6d,apla7d
109 module procedure apxa1d,apxa2d,apxa3d,apxa4d,apxa5d,apxa6d,apxa7d
110 module procedure apya1d,apya2d,apya3d,apya4d,apya5d,apya6d,apya7d
112 ! NOTE: for compilers with full Fortran2003 support (GNU-4.9+, IC-15.0+, etc.)
113 ! ... we can provide a single apup interface for both pointers and allocatables
114 ! ... by simply removing the next two lines.
117 module procedure apia1d_al,apia2d_al,apia3d_al,apia4d_al,apia5d_al,apia6d_al,apia7d_al
118 module procedure apca1d_al,apca2d_al,apca3d_al,apca4d_al,apca5d_al,apca6d_al,apca7d_al
119 module procedure apsa1d_al,apsa2d_al,apsa3d_al,apsa4d_al,apsa5d_al,apsa6d_al,apsa7d_al
120 module procedure apra1d_al,apra2d_al,apra3d_al,apra4d_al,apra5d_al,apra6d_al,apra7d_al
121 module procedure apda1d_al,apda2d_al,apda3d_al,apda4d_al,apda5d_al,apda6d_al,apda7d_al
122 module procedure apla1d_al,apla2d_al,apla3d_al,apla4d_al,apla5d_al,apla6d_al,apla7d_al
123 module procedure apxa1d_al,apxa2d_al,apxa3d_al,apxa4d_al,apxa5d_al,apxa6d_al,apxa7d_al
124 module procedure apya1d_al,apya2d_al,apya3d_al,apya4d_al,apya5d_al,apya6d_al,apya7d_al
130 pup_issz = fpup_issizing(p)
135 pup_ispk = fpup_ispacking(p)
137 function pup_isupk(p)
140 pup_isupk = fpup_isunpacking(p)
142 function pup_isdel(p)
145 pup_isdel = fpup_isdeleting(p)
150 pup_isul = fpup_isuserlevel(p)
154 subroutine fpup_chars_0(p, d, c)
158 call fpup_charsg(p, d, c)
162 for data
in "chars/character" "shorts/integer(kind=2)" "ints/integer(kind=4)" "longs/integer(kind=8)" "reals/real(kind=4)" "doubles/real(kind=8)" "logicals/logical"\
163 "complexes/complex*8" "doublecomplexes/complex*16"
165 pupname
=`echo $data | awk -F/ '{print $1}'`
166 typename
=`echo $data | awk -F/ '{print $2}'`
167 for i
in 1 2 3 4 5 6 7
169 echo " subroutine fpup_${pupname}_${i}(p, d, c)" >> pup_f.f90
170 echo " INTEGER :: p" >> pup_f.f90
171 echo -n " ${typename}, intent(inout), dimension(:" >> pup_f.f90
175 echo -n ",:" >> pup_f.f90
178 echo ") :: d" >> pup_f.f90
179 echo " INTEGER :: c" >> pup_f.f90
180 echo " call fpup_${pupname}g(p, d, c)" >> pup_f.f90
181 echo " end subroutine" >> pup_f.f90
187 # Create pup routines for each data type:
188 # The "p" routines just copy the data.
189 # The "ap" routines also allocate and free the buffer.
190 # suffix _al means input is allocatable, otherwise its pointer
192 for data
in "int/ints/i/integer" "short/shorts/s/integer(kind=2)" "char/chars/c/character" "real/reals/r/real(kind=4)" "double/doubles/d/real(kind=8)" "logical/logicals/l/logical"\
193 "complex/complexes/x/complex*8" "doublecomplex/doublecomplexes/y/complex*16"
195 pupname
=`echo $data | awk -F/ '{print $1}'`
196 pupnames
=`echo $data | awk -F/ '{print $2}'`
197 cname
=`echo $data | awk -F/ '{print $3}'`
198 fname
=`echo $data | awk -F/ '{print $4}'`
199 echo "Making pup routines for data type $pupname/$cname/$fname"
200 cat >> pup_f.f90
<< END_OF_DATATYPE
203 subroutine p${cname}(p, i)
205 $fname, intent(inout) :: i
206 call fpup_${pupname}(p, i)
209 subroutine p${cname}a1d(p, arr)
211 $fname, intent(inout), dimension(:) :: arr
212 call fpup_${pupnames}(p, arr, size(arr))
214 subroutine p${cname}a2d(p, arr)
216 $fname, intent(inout), dimension(:,:) :: arr
217 call fpup_${pupnames}(p, arr, size(arr))
219 subroutine p${cname}a3d(p, arr)
221 $fname, intent(inout), dimension(:,:,:) :: arr
222 call fpup_${pupnames}(p, arr, size(arr))
224 subroutine p${cname}a4d(p, arr)
226 $fname, intent(inout), dimension(:,:,:,:) :: arr
227 call fpup_${pupnames}(p, arr, size(arr))
229 subroutine p${cname}a5d(p, arr)
231 $fname, intent(inout), dimension(:,:,:,:,:) :: arr
232 call fpup_${pupnames}(p, arr, size(arr))
234 subroutine p${cname}a6d(p, arr)
236 $fname, intent(inout), dimension(:,:,:,:,:,:) :: arr
237 call fpup_${pupnames}(p, arr, size(arr))
239 subroutine p${cname}a7d(p, arr)
241 $fname, intent(inout), dimension(:,:,:,:,:,:,:) :: arr
242 call fpup_${pupnames}(p, arr, size(arr))
248 for arrkind
in "pointer/associated/NULLIFY(arr)/" "allocatable/allocated/ /_al"
250 pointer
=`echo $arrkind | awk -F/ '{print $1}'`
251 associated
=`echo $arrkind | awk -F/ '{print $2}'`
252 NULLIFY
=`echo $arrkind | awk -F/ '{print $3}'`
253 suffix
=`echo $arrkind | awk -F/ '{print $4}'`
254 for data
in "int/ints/i/integer" "short/shorts/s/integer(kind=2)" "char/chars/c/character" "real/reals/r/real(kind=4)" "double/doubles/d/real(kind=8)" "logical/logicals/l/logical"\
255 "complex/complexes/x/complex*8" "doublecomplex/doublecomplexes/y/complex*16"
257 pupname
=`echo $data | awk -F/ '{print $1}'`
258 pupnames
=`echo $data | awk -F/ '{print $2}'`
259 cname
=`echo $data | awk -F/ '{print $3}'`
260 fname
=`echo $data | awk -F/ '{print $4}'`
261 echo "Making pup routines for data type $pupname/$cname/$fname"
262 cat >> pup_f.f90
<< END_OF_DATATYPE
264 subroutine ap${cname}a1d$suffix(p, arr)
266 $fname, $pointer, dimension(:) :: arr
268 IF (fpup_isunpacking(p)) THEN
269 CALL fpup_ints(p,n,1)
272 call fpup_${pupnames}(p, arr, n(1))
277 If ($associated(arr)) THEN
279 CALL fpup_ints(p,n,1)
280 call fpup_${pupnames}(p, arr, n(1))
283 CALL fpup_ints(p,n,1)
286 IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
291 subroutine ap${cname}a2d$suffix(p, arr)
293 $fname, $pointer, dimension(:,:) :: arr
295 IF (fpup_isunpacking(p)) THEN
296 CALL fpup_ints(p,n,2)
298 ALLOCATE(arr(n(1),n(2)))
299 call fpup_${pupnames}(p, arr, size(arr))
304 If ($associated(arr)) THEN
307 CALL fpup_ints(p,n,2)
308 call fpup_${pupnames}(p, arr, size(arr))
312 CALL fpup_ints(p,n,2)
315 IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
320 subroutine ap${cname}a3d$suffix(p, arr)
322 $fname, $pointer, dimension(:,:,:) :: arr
324 IF (fpup_isunpacking(p)) THEN
325 CALL fpup_ints(p,n,3)
327 ALLOCATE(arr(n(1),n(2),n(3)))
328 call fpup_${pupnames}(p, arr, size(arr))
333 If ($associated(arr)) THEN
337 CALL fpup_ints(p,n,3)
338 call fpup_${pupnames}(p, arr, size(arr))
343 CALL fpup_ints(p,n,3)
346 IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
351 subroutine ap${cname}a4d$suffix(p, arr)
353 $fname, $pointer, dimension(:,:,:,:) :: arr
355 IF (fpup_isunpacking(p)) THEN
356 CALL fpup_ints(p,n,4)
358 ALLOCATE(arr(n(1),n(2),n(3),n(4)))
359 call fpup_${pupnames}(p, arr, size(arr))
364 If ($associated(arr)) THEN
369 CALL fpup_ints(p,n,4)
370 call fpup_${pupnames}(p, arr, size(arr))
376 CALL fpup_ints(p,n,4)
379 IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
384 subroutine ap${cname}a5d$suffix(p, arr)
386 $fname, $pointer, dimension(:,:,:,:,:) :: arr
388 IF (fpup_isunpacking(p)) THEN
389 CALL fpup_ints(p,n,5)
391 ALLOCATE(arr(n(1),n(2),n(3),n(4),n(5)))
392 call fpup_${pupnames}(p, arr, size(arr))
397 If ($associated(arr)) THEN
403 CALL fpup_ints(p,n,5)
404 call fpup_${pupnames}(p, arr, size(arr))
411 CALL fpup_ints(p,n,5)
414 IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
419 subroutine ap${cname}a6d$suffix(p, arr)
421 $fname, $pointer, dimension(:,:,:,:,:,:) :: arr
423 IF (fpup_isunpacking(p)) THEN
424 CALL fpup_ints(p,n,6)
426 ALLOCATE(arr(n(1),n(2),n(3),n(4),n(5),n(6)))
427 call fpup_${pupnames}(p, arr, size(arr))
432 If ($associated(arr)) THEN
439 CALL fpup_ints(p,n,6)
440 call fpup_${pupnames}(p, arr, size(arr))
448 CALL fpup_ints(p,n,6)
451 IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
456 subroutine ap${cname}a7d$suffix(p, arr)
458 $fname, $pointer, dimension(:,:,:,:,:,:,:) :: arr
460 IF (fpup_isunpacking(p)) THEN
461 CALL fpup_ints(p,n,7)
463 ALLOCATE(arr(n(1),n(2),n(3),n(4),n(5),n(6),n(7)))
464 call fpup_${pupnames}(p, arr, size(arr))
469 If ($associated(arr)) THEN
477 CALL fpup_ints(p,n,7)
478 call fpup_${pupnames}(p, arr, size(arr))
487 CALL fpup_ints(p,n,7)
490 IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
500 echo " end module" >> pup_f.f90