1 |
program write_float |
2 |
|
3 |
double precision npart,xpart,ypart,kpart,kfloat,iup,itop |
4 |
& ,tstart,tend |
5 |
|
6 |
parameter(Nx=80,Ny=42) |
7 |
double precision depth(Nx,Ny),xc(Nx),yc(Ny),degX,degY |
8 |
c |
9 |
integer kyear,kpres,kday |
10 |
real rtime,rlon,rlat |
11 |
integer narg |
12 |
logical flag |
13 |
|
14 |
c |
15 |
c if float should not be written use flag |
16 |
c |
17 |
flag = .true. |
18 |
narg=iargc() |
19 |
if ( narg .gt. 0 ) flag = .false. |
20 |
print*, flag |
21 |
|
22 |
if (flag) then |
23 |
c |
24 |
c open float file |
25 |
c |
26 |
ilen2=9*8 |
27 |
open(1,file='float_pos.input',status='new',form='unformatted' |
28 |
& ,access='direct',recl=ilen2) |
29 |
endif |
30 |
c |
31 |
c read bathymetry |
32 |
c |
33 |
ilen=Nx*Ny*8 |
34 |
open(2,file='topog.bump',status='old',form='unformatted' |
35 |
&, access='direct',recl=ilen) |
36 |
read(2,rec=1) depth |
37 |
close(2) |
38 |
c |
39 |
c generate axes |
40 |
c |
41 |
degX=5000. |
42 |
xc(1)=2500. |
43 |
do i=2,Nx |
44 |
xc(i)=xc(i-1)+degX |
45 |
enddo |
46 |
c |
47 |
degY=5000. |
48 |
yc(1)=2500. |
49 |
do j=2,Ny |
50 |
yc(j)=yc(j-1)+degY |
51 |
enddo |
52 |
|
53 |
print*,'xc(1), xc(Nx): ',xc(1), xc(Nx) |
54 |
print*,'yc(1), yc(Ny): ',yc(1), yc(Ny) |
55 |
c |
56 |
c preset first line with dummies |
57 |
npart = 0. |
58 |
tstart = -1. |
59 |
xpart = 0. |
60 |
ypart = 0. |
61 |
kpart = 0. |
62 |
kfloat = 0. |
63 |
iup = 0. |
64 |
itop = 0. |
65 |
tend = -1. |
66 |
if (flag) write(1,rec=1) npart,tstart,xpart,ypart, |
67 |
& kpart,kfloat,iup,itop,tend |
68 |
|
69 |
100 continue |
70 |
c |
71 |
print*, '--------------------------------------------------' |
72 |
print*, '| FLOAT CONFIGURATION |' |
73 |
print*, '--------------------------------------------------' |
74 |
print*, ' ' |
75 |
print*, 'sets over whole basin: ' |
76 |
ip=0 |
77 |
c |
78 |
c target depth: level 5 |
79 |
c profiling: 5 days |
80 |
c surface time: 12, 24 hours |
81 |
c |
82 |
do j=20,30,2 |
83 |
do i=20,50,2 |
84 |
if (depth(i,j) .le. -2530.) then |
85 |
ip=ip+1 |
86 |
npart = REAL(ip) |
87 |
tstart = -1. |
88 |
xpart = xc(i) |
89 |
ypart = yc(j) |
90 |
kpart = 5. |
91 |
kfloat = kpart |
92 |
iup = 432000. |
93 |
itop = 43200. |
94 |
tend = -1. |
95 |
if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart, |
96 |
& kpart,kfloat,iup,itop,tend |
97 |
endif |
98 |
enddo |
99 |
enddo |
100 |
write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ', |
101 |
& kpart,kfloat,iup,itop,tstart,tend |
102 |
200 format(A,I6,A,2F3.0,4F8.0) |
103 |
c |
104 |
do j=20,30,2 |
105 |
do i=20,50,2 |
106 |
if (depth(i,j) .le. -2530.) then |
107 |
ip=ip+1 |
108 |
npart = REAL(ip) |
109 |
tstart = -1. |
110 |
xpart = xc(i) |
111 |
ypart = yc(j) |
112 |
kpart = 5. |
113 |
kfloat = kpart |
114 |
iup = 432000. |
115 |
itop = 86400. |
116 |
tend = -1. |
117 |
if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart, |
118 |
& kpart,kfloat,iup,itop,tend |
119 |
endif |
120 |
enddo |
121 |
enddo |
122 |
write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ', |
123 |
& kpart,kfloat,iup,itop,tstart,tend |
124 |
c |
125 |
c |
126 |
c target depth: level 5 |
127 |
c profiling: 1 day |
128 |
c surface time: 12 hours |
129 |
c integrating only day 2-5 |
130 |
c |
131 |
do j=20,30,2 |
132 |
do i=20,50,2 |
133 |
if (depth(i,j) .le. -2530.) then |
134 |
ip=ip+1 |
135 |
npart = REAL(ip) |
136 |
tstart = 172800. |
137 |
xpart = xc(i) |
138 |
ypart = yc(j) |
139 |
kpart = 0. |
140 |
kfloat = 5. |
141 |
iup = 86400. |
142 |
itop = 43200. |
143 |
tend = 518400. |
144 |
if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart, |
145 |
& kpart,kfloat,iup,itop,tend |
146 |
endif |
147 |
enddo |
148 |
enddo |
149 |
write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ', |
150 |
& kpart,kfloat,iup,itop,tstart,tend |
151 |
c |
152 |
c |
153 |
c target depth: level 5 |
154 |
c no profiling |
155 |
c integrating starting day 5 |
156 |
c |
157 |
do j=20,30,2 |
158 |
do i=20,50,2 |
159 |
if (depth(i,j) .le. -2530.) then |
160 |
ip=ip+1 |
161 |
npart = REAL(ip) |
162 |
tstart = 432000. |
163 |
xpart = xc(i) |
164 |
ypart = yc(j) |
165 |
kpart = 0. |
166 |
kfloat = 5. |
167 |
iup = 0. |
168 |
itop = 0. |
169 |
tend = -1. |
170 |
if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart, |
171 |
& kpart,kfloat,iup,itop,tend |
172 |
endif |
173 |
enddo |
174 |
enddo |
175 |
write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ', |
176 |
& kpart,kfloat,iup,itop,tstart,tend |
177 |
c |
178 |
c mooring |
179 |
c |
180 |
do j=20,30,2 |
181 |
i=20 |
182 |
ip=ip+1 |
183 |
npart = REAL(ip) |
184 |
tstart = -1. |
185 |
xpart = xc(i) |
186 |
ypart = yc(j) |
187 |
kpart = 0. |
188 |
kfloat = kpart |
189 |
iup = -3. |
190 |
itop = 0. |
191 |
tend = -1. |
192 |
if (flag) write(1,rec=ip+1) npart,tstart,xpart,ypart, |
193 |
& kpart,kfloat,iup,itop,tend |
194 |
enddo |
195 |
write(6,200) 'ip = ',ip,' kpart,kfloat,iup,itop,tstart,tend: ', |
196 |
& kpart,kfloat,iup,itop,tstart,tend |
197 |
c |
198 |
|
199 |
print*, ' ' |
200 |
print*, '--------------------------------------------------' |
201 |
print*, 'total number of floats: npart = ',ip |
202 |
print*, '--------------------------------------------------' |
203 |
|
204 |
c write total number of floats in first line |
205 |
npart = DBLE(ip) |
206 |
tstart = -1. |
207 |
xpart = 0. |
208 |
ypart = 0. |
209 |
kpart = 0. |
210 |
kfloat = DBLE(ip) |
211 |
iup = 0. |
212 |
itop = 0. |
213 |
tend = -1. |
214 |
if (flag) |
215 |
& write(1,rec=1) npart,tstart,xpart,ypart,kpart,kfloat,iup,itop,tend |
216 |
|
217 |
|
218 |
|
219 |
close(1) |
220 |
|
221 |
end |