Bug 823: Relax compiler requirements for AMPI Fortran apup interface
[charm.git] / src / util / pup_f.f90.sh
1 #!/bin/sh
2 #
3 # Shell script to creat the pup_f.f90 file.
4 #  Used to avoid duplicate copy-and-paste codein pup_f.f90.
5
6 cat > pup_f.f90 << END_OF_HEADER
7 !   DO NOT EDIT THIS FILE, GENERATE IT FROM RUNNING pup_f.f90.sh
8     module pupmod
9       implicit none
10
11       interface
12         function fpup_issizing(p)
13           INTEGER :: p
14           logical fpup_issizing
15         end function
16         function fpup_ispacking(p)
17           INTEGER :: p
18           logical fpup_ispacking
19         end function
20         function fpup_isunpacking(p)
21           INTEGER :: p
22           logical fpup_isunpacking
23         end function
24         function fpup_isdeleting(p)
25           INTEGER :: p
26           logical fpup_isdeleting
27         end function
28         function fpup_isuserlevel(p)
29           INTEGER :: p
30           logical fpup_isuserlevel
31         end function
32
33         subroutine fpup_char(p, d)
34           INTEGER :: p
35           CHARACTER :: d
36         end subroutine
37         subroutine fpup_short(p, d)
38           INTEGER :: p
39           INTEGER (KIND=2) :: d
40         end subroutine
41         subroutine fpup_int(p, d)
42           INTEGER :: p
43           INTEGER (KIND=4) :: d
44         end subroutine
45         subroutine fpup_long(p, d)
46           INTEGER :: p
47           INTEGER (KIND=8) :: d
48         end subroutine
49         subroutine fpup_real(p, d)
50           INTEGER :: p
51           REAL (KIND=4)  :: d
52         end subroutine
53         subroutine fpup_double(p, d)
54           INTEGER :: p
55           REAL (KIND=8)  :: d
56         end subroutine
57         subroutine fpup_logical(p, d)
58           INTEGER :: p
59           LOGICAL :: d
60         end subroutine
61
62         subroutine fpup_complex(p, d)
63           INTEGER :: p
64           COMPLEX*8 :: d
65         end subroutine
66
67         subroutine fpup_doublecomplex(p, d)
68           INTEGER :: p
69           COMPLEX*16 :: d
70         end subroutine
71
72       end interface
73
74 END_OF_HEADER
75
76 for t in chars ints longs reals doubles logicals complexes doublecomplexes
77 do
78   echo "      interface fpup_${t}" >> pup_f.f90
79   if test $t = "chars" 
80   then
81   echo "       module procedure fpup_${t}_0" >> pup_f.f90
82   fi
83   for i in  1 2 3 4 5 6 7
84   do
85   echo "       module procedure fpup_${t}_${i}" >> pup_f.f90
86   done
87   echo "      end interface fpup_${t}" >> pup_f.f90
88   echo >> pup_f.f90
89 done
90
91 cat >> pup_f.f90 << END_OF_HEADER
92       interface pup
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
101       end interface
102       interface apup
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
111
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.
115       end interface
116       interface apup_al
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
125       end interface
126       contains
127       function pup_issz(p)
128         INTEGER :: p
129         logical pup_issz
130         pup_issz = fpup_issizing(p)
131       end function
132       function pup_ispk(p)
133         INTEGER :: p
134         logical pup_ispk
135         pup_ispk = fpup_ispacking(p)
136       end function
137       function pup_isupk(p)
138         INTEGER :: p
139         logical pup_isupk
140         pup_isupk = fpup_isunpacking(p)
141       end function
142       function pup_isdel(p)
143         INTEGER :: p
144         logical pup_isdel
145         pup_isdel = fpup_isdeleting(p)
146       end function
147       function pup_isul(p)
148         INTEGER :: p
149         logical pup_isul
150         pup_isul = fpup_isuserlevel(p)
151       end function
152
153      
154       subroutine fpup_chars_0(p, d, c)
155         INTEGER :: p
156         CHARACTER(LEN=*)     d
157         INTEGER :: c
158         call fpup_charsg(p, d, c)
159       end subroutine
160 END_OF_HEADER
161
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"
164 do
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
168  do
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
172   n=1
173   while [ $n -lt $i ]
174   do
175     echo -n ",:" >> pup_f.f90
176     n=`expr $n + 1`
177   done
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
182  done
183  echo >> pup_f.f90
184 done
185
186 #
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
191 #
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"
194 do
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
201
202
203       subroutine p${cname}(p, i)
204         INTEGER :: p
205         $fname, intent(inout) :: i
206         call fpup_${pupname}(p, i)
207       end subroutine
208       
209       subroutine p${cname}a1d(p, arr)
210         INTEGER :: p
211         $fname, intent(inout), dimension(:) :: arr
212         call fpup_${pupnames}(p, arr, size(arr))
213       end subroutine
214       subroutine p${cname}a2d(p, arr)
215         INTEGER :: p
216         $fname, intent(inout), dimension(:,:) :: arr
217         call fpup_${pupnames}(p, arr, size(arr))
218       end subroutine
219       subroutine p${cname}a3d(p, arr)
220         INTEGER :: p
221         $fname, intent(inout), dimension(:,:,:) :: arr
222         call fpup_${pupnames}(p, arr, size(arr))
223       end subroutine
224       subroutine p${cname}a4d(p, arr)
225         INTEGER :: p
226         $fname, intent(inout), dimension(:,:,:,:) :: arr
227         call fpup_${pupnames}(p, arr, size(arr))
228       end subroutine
229       subroutine p${cname}a5d(p, arr)
230         INTEGER :: p
231         $fname, intent(inout), dimension(:,:,:,:,:) :: arr
232         call fpup_${pupnames}(p, arr, size(arr))
233       end subroutine
234       subroutine p${cname}a6d(p, arr)
235         INTEGER :: p
236         $fname, intent(inout), dimension(:,:,:,:,:,:) :: arr
237         call fpup_${pupnames}(p, arr, size(arr))
238       end subroutine
239       subroutine p${cname}a7d(p, arr)
240         INTEGER :: p
241         $fname, intent(inout), dimension(:,:,:,:,:,:,:) :: arr
242         call fpup_${pupnames}(p, arr, size(arr))
243       end subroutine
244
245 END_OF_DATATYPE
246 done
247
248 for arrkind in "pointer/associated/NULLIFY(arr)/" "allocatable/allocated/ /_al"
249 do
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"
256   do
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
263
264       subroutine ap${cname}a1d$suffix(p, arr)
265         INTEGER :: p
266         $fname, $pointer, dimension(:) :: arr
267         integer :: n(1)
268         IF (fpup_isunpacking(p)) THEN
269           CALL fpup_ints(p,n,1)
270           If (n(1) >= 0) THEN
271             ALLOCATE(arr(n(1)))
272             call fpup_${pupnames}(p, arr, n(1))
273           ELSE
274             $NULLIFY
275           END If
276         ELSE ! packing
277           If ($associated(arr)) THEN
278             n(1)=SIZE(arr,DIM=1)
279             CALL fpup_ints(p,n,1)
280             call fpup_${pupnames}(p, arr, n(1))
281           ELSE
282             n(1) = -1
283             CALL fpup_ints(p,n,1)
284           End If
285         END IF
286         IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
287           deallocate(arr)
288         END IF
289       end subroutine
290
291       subroutine ap${cname}a2d$suffix(p, arr)
292         INTEGER :: p
293         $fname, $pointer, dimension(:,:) :: arr
294         integer :: n(2)
295         IF (fpup_isunpacking(p)) THEN
296           CALL fpup_ints(p,n,2)
297           If (n(1) >= 0) THEN
298             ALLOCATE(arr(n(1),n(2)))
299             call fpup_${pupnames}(p, arr, size(arr))
300           ELSE
301             $NULLIFY
302           END If
303         ELSE ! packing
304           If ($associated(arr)) THEN
305             n(1)=SIZE(arr,DIM=1)
306             n(2)=SIZE(arr,DIM=2)
307             CALL fpup_ints(p,n,2)
308             call fpup_${pupnames}(p, arr, size(arr))
309           ELSE
310             n(1) = -1
311             n(2) = -1
312             CALL fpup_ints(p,n,2)
313           End If
314         END IF
315         IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
316           deallocate(arr)
317         END IF
318       end subroutine
319
320       subroutine ap${cname}a3d$suffix(p, arr)
321         INTEGER :: p
322         $fname, $pointer, dimension(:,:,:) :: arr
323         integer :: n(3)
324         IF (fpup_isunpacking(p)) THEN
325           CALL fpup_ints(p,n,3)
326           If (n(1) >= 0) THEN
327             ALLOCATE(arr(n(1),n(2),n(3)))
328             call fpup_${pupnames}(p, arr, size(arr))
329           ELSE
330             $NULLIFY
331           END If
332         ELSE ! packing
333           If ($associated(arr)) THEN
334             n(1)=SIZE(arr,DIM=1)
335             n(2)=SIZE(arr,DIM=2)
336             n(3)=SIZE(arr,DIM=3)
337             CALL fpup_ints(p,n,3)
338             call fpup_${pupnames}(p, arr, size(arr))
339           ELSE
340             n(1) = -1
341             n(2) = -1
342             n(3) = -1
343             CALL fpup_ints(p,n,3)
344           End If
345         END IF
346         IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
347           deallocate(arr)
348         END IF
349       end subroutine
350
351       subroutine ap${cname}a4d$suffix(p, arr)
352         INTEGER :: p
353         $fname, $pointer, dimension(:,:,:,:) :: arr
354         integer :: n(4)
355         IF (fpup_isunpacking(p)) THEN
356           CALL fpup_ints(p,n,4)
357           If (n(1) >= 0) THEN
358             ALLOCATE(arr(n(1),n(2),n(3),n(4)))
359             call fpup_${pupnames}(p, arr, size(arr))
360           ELSE
361             $NULLIFY
362           END If
363         ELSE ! packing
364           If ($associated(arr)) THEN
365             n(1)=SIZE(arr,DIM=1)
366             n(2)=SIZE(arr,DIM=2)
367             n(3)=SIZE(arr,DIM=3)
368             n(4)=SIZE(arr,DIM=4)
369             CALL fpup_ints(p,n,4)
370             call fpup_${pupnames}(p, arr, size(arr))
371           ELSE
372             n(1) = -1
373             n(2) = -1
374             n(3) = -1
375             n(4) = -1
376             CALL fpup_ints(p,n,4)
377           End If
378         END IF
379         IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
380           deallocate(arr)
381         END IF
382       end subroutine
383
384       subroutine ap${cname}a5d$suffix(p, arr)
385         INTEGER :: p
386         $fname, $pointer, dimension(:,:,:,:,:) :: arr
387         integer :: n(5)
388         IF (fpup_isunpacking(p)) THEN
389           CALL fpup_ints(p,n,5)
390           If (n(1) >= 0) THEN
391             ALLOCATE(arr(n(1),n(2),n(3),n(4),n(5)))
392             call fpup_${pupnames}(p, arr, size(arr))
393           ELSE
394             $NULLIFY
395           END If
396         ELSE ! packing
397           If ($associated(arr)) THEN
398             n(1)=SIZE(arr,DIM=1)
399             n(2)=SIZE(arr,DIM=2)
400             n(3)=SIZE(arr,DIM=3)
401             n(4)=SIZE(arr,DIM=4)
402             n(5)=SIZE(arr,DIM=5)
403             CALL fpup_ints(p,n,5)
404             call fpup_${pupnames}(p, arr, size(arr))
405           ELSE
406             n(1) = -1
407             n(2) = -1
408             n(3) = -1
409             n(4) = -1
410             n(5) = -1
411             CALL fpup_ints(p,n,5)
412           End If
413         END IF
414         IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
415           deallocate(arr)
416         END IF
417       end subroutine
418
419       subroutine ap${cname}a6d$suffix(p, arr)
420         INTEGER :: p
421         $fname, $pointer, dimension(:,:,:,:,:,:) :: arr
422         integer :: n(6)
423         IF (fpup_isunpacking(p)) THEN
424           CALL fpup_ints(p,n,6)
425           If (n(1) >= 0) THEN
426             ALLOCATE(arr(n(1),n(2),n(3),n(4),n(5),n(6)))
427             call fpup_${pupnames}(p, arr, size(arr))
428           ELSE
429             $NULLIFY
430           END If
431         ELSE ! packing
432           If ($associated(arr)) THEN
433             n(1)=SIZE(arr,DIM=1)
434             n(2)=SIZE(arr,DIM=2)
435             n(3)=SIZE(arr,DIM=3)
436             n(4)=SIZE(arr,DIM=4)
437             n(5)=SIZE(arr,DIM=5)
438             n(6)=SIZE(arr,DIM=6)
439             CALL fpup_ints(p,n,6)
440             call fpup_${pupnames}(p, arr, size(arr))
441           ELSE
442             n(1) = -1
443             n(2) = -1
444             n(3) = -1
445             n(4) = -1
446             n(5) = -1
447             n(6) = -1
448             CALL fpup_ints(p,n,6)
449           End If
450         END IF
451         IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
452           deallocate(arr)
453         END IF
454       end subroutine
455
456       subroutine ap${cname}a7d$suffix(p, arr)
457         INTEGER :: p
458         $fname, $pointer, dimension(:,:,:,:,:,:,:) :: arr
459         integer :: n(7)
460         IF (fpup_isunpacking(p)) THEN
461           CALL fpup_ints(p,n,7)
462           If (n(1) >= 0) THEN
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))
465           ELSE
466             $NULLIFY
467           END If
468         ELSE ! packing
469           If ($associated(arr)) THEN
470             n(1)=SIZE(arr,DIM=1)
471             n(2)=SIZE(arr,DIM=2)
472             n(3)=SIZE(arr,DIM=3)
473             n(4)=SIZE(arr,DIM=4)
474             n(5)=SIZE(arr,DIM=5)
475             n(6)=SIZE(arr,DIM=6)
476             n(7)=SIZE(arr,DIM=7)
477             CALL fpup_ints(p,n,7)
478             call fpup_${pupnames}(p, arr, size(arr))
479           ELSE
480             n(1) = -1
481             n(2) = -1
482             n(3) = -1
483             n(4) = -1
484             n(5) = -1
485             n(6) = -1
486             n(7) = -1
487             CALL fpup_ints(p,n,7)
488           End If
489         END IF
490         IF (fpup_isdeleting(p) .and. $associated(arr)) THEN
491           deallocate(arr)
492         END IF
493         end subroutine
494
495 END_OF_DATATYPE
496
497   done
498 done
499
500 echo "    end module" >> pup_f.f90
501