-
Notifications
You must be signed in to change notification settings - Fork 14
/
bcast.f
60 lines (58 loc) · 1.74 KB
/
bcast.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
!
!
subroutine bcast(a,val,n)
!implicit integer (i-n), real*8 (a-h,o-z)
implicit none !YuP[2020-01]
real*8 val,a !YuP[2020-01]
integer i,n !YuP[2020-01]
!..................................................................
! Temporary bcast routine until I can find UNICOS equivalent
!..................................................................
dimension a(n)
do 100 i=1,n
a(i)=val
100 continue
return
end
!
!
subroutine ibcast(ia,ival,n)
!implicit integer (i-n), real*8 (a-h,o-z)
implicit none !YuP[2020-01]
integer i,n,ival,ia !YuP[2020-01]
!..................................................................
! Temporary bcast routine until I can find UNICOS equivalent
!..................................................................
dimension ia(n)
do 100 i=1,n
ia(i)=ival
100 continue
return
end
! NME bcast routine for complex arrays
subroutine ccast(c,cval,n)
!implicit integer (i-n), complex*16 (c)
implicit none !YuP[2020-01]
complex*16 cval,c !YuP[2020-01]
integer i,n !YuP[2020-01]
dimension c(n)
do 100 i=1,n
c(i)=cval
100 continue
return
end
subroutine r4bcast(a,val,n)
!implicit integer (i-n), real*4 (a-h,o-z)
implicit none !YuP[2020-01]
real*4 val,a !YuP[2020-01] ![2020-09-05] Corrected to real*4
integer i,n !YuP[2020-01]
!..................................................................
! Temporary bcast routine until I can find UNICOS equivalent
!..................................................................
dimension a(n)
do 100 i=1,n
a(i)=val
100 continue
return
end
!