forked from KuangLab-Harvard/SAM_SRCv6.11
-
Notifications
You must be signed in to change notification settings - Fork 0
/
utils.f90
147 lines (123 loc) · 2.51 KB
/
utils.f90
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
integer function lenstr (string)
! returns string's length ignoring the rightmost blank and null characters
implicit none
character *(*) string
integer k
lenstr = 0
do k = 1,len(string)
if (string(k:k).ne.' '.and.string(k:k).ne.char(0)) then
lenstr = lenstr+1
end if
end do
111 return
end
subroutine averageXY(f,dimx1,dimx2,dimy1,dimy2,dimz,fm)
use grid
implicit none
integer dimx1, dimx2, dimy1, dimy2, dimz
real f(dimx1:dimx2, dimy1:dimy2, dimz),fm(nzm)
real(8) ff,factor
integer i,j,k
factor = 1./dble(nx*ny)
do k =1,nzm
ff = 0.
do j =1,ny
do i =1,nx
ff = ff + f(i,j,k)
end do
end do
ff = ff*factor
fm(k) = real(ff)
end do
end
subroutine averageXY_MPI(f,dimx1,dimx2,dimy1,dimy2,dimz,fm)
use grid
implicit none
integer dimx1, dimx2, dimy1, dimy2, dimz
real f(dimx1:dimx2, dimy1:dimy2, dimz),fm(nzm)
real(8) fm1(nzm),fm2(nzm),factor
integer i,j,k
factor = 1./dble(nx*ny)
do k =1,nzm
fm1(k) = 0.
do j =1,ny
do i =1,nx
fm1(k) = fm1(k) + f(i,j,k)
end do
end do
fm1(k) = fm1(k) * factor
end do
if(dompi) then
do k =1,nzm
fm2(k) = fm1(k)
end do
call task_sum_real8(fm2,fm1,nzm)
do k=1,nzm
fm(k)=real(fm1(k)/dble(nsubdomains))
end do
else
do k=1,nzm
fm(k)=real(fm1(k))
end do
endif
end
subroutine fminmax_print(name,f,dimx1,dimx2,dimy1,dimy2,dimz)
use grid
implicit none
integer dimx1, dimx2, dimy1, dimy2, dimz
real f(dimx1:dimx2, dimy1:dimy2, dimz),fmn(nz),fmx(nz)
character *(*) name
real fmin(1),fmax(1),fff(1)
integer i,j,k
do k=1,dimz
if(dimx2.eq.1.and.dimy2.eq.1) then
fmn(k) = f(1,1,k)
fmx(k) = f(1,1,k)
else
fmn(k) = 1.e30
fmx(k) =-1.e30
do j=1,ny
do i=1,nx
fmn(k) = min(fmn(k),f(i,j,k))
fmx(k) = max(fmx(k),f(i,j,k))
end do
enddo
end if
enddo
fmin(1) = 1.e30
fmax(1) =-1.e30
do k=1,dimz
fmin(1) = min(fmin(1),fmn(k))
fmax(1) = max(fmax(1),fmx(k))
end do
if(dompi) then
fff(1)=fmax(1)
call task_max_real(fff(1),fmax(1),1)
fff(1)=fmin(1)
call task_min_real(fff(1),fmin(1),1)
end if
if(masterproc) print *,name,fmin,fmax
end
subroutine setvalue(f,n,f0)
implicit none
integer n
real f(n), f0
integer k
do k=1,n
f(k)=f0
end do
end
! determine number of byte in a record in direct access files (can be anything, from 1 to 8):
! can't assume 1 as it is compiler and computer dependent
integer function bytes_in_rec()
implicit none
character*8 str
integer n, err
open(1,status ='scratch',access ='direct',recl=1)
do n = 1,8
write(1,rec=1,iostat=err) str(1:n)
if (err.ne.0) exit
bytes_in_rec = n
enddo
close(1,status='delete')
end