forked from altMITgcm/MITgcm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
flt_up.F
210 lines (171 loc) · 5.81 KB
/
flt_up.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
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
C $Header: /u/gcmpack/MITgcm/pkg/flt/flt_up.F,v 1.1 2001/09/13 17:43:56 adcroft Exp $
C $Name: $
#include "FLT_CPPOPTIONS.h"
subroutine flt_up (
I myCurrentIter,
I myCurrentTime,
I myThid
& )
c ==================================================================
c SUBROUTINE flt_up
c ==================================================================
c
c o This routine moves particles vertical from the target depth to
c the surface and samples the model state over the full water
c column at horizontal float position every flt_int_prof time steps
c and writes output.
c
c ==================================================================
c SUBROUTINE flt_up
c ==================================================================
c == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "DYNVARS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "FLT.h"
#include "SOLVE_FOR_PRESSURE.h"
c#include "UNITS.h"
c == routine arguments ==
INTEGER myCurrentIter, myThid
_RL myCurrentTime
INTEGER bi, bj
c == local variables ==
integer imax
parameter (imax=(6+4*Nr))
integer ip, k
_RL xx, yy, xlo, xhi, ylo, yhi
_RL uu,vv,tt,ss, pp
_RL global2local_i
_RL global2local_j
integer irecord
_RL tmp(imax)
_RL npart_read,npart_times
CHARACTER*(MAX_LEN_FNAM) fn
character*(max_len_mbuf) msgbuf
C Functions
integer ILNBLNK
C Local variables
character*(80) dataFName
integer iG,jG,IL
logical exst
logical globalFile
c == end of interface ==
fn = 'float_profiles'
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
c
c (1) read actual number floats from file (if exists)
IL=ILNBLNK( fn )
iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
& fn(1:IL),'.',iG,'.',jG,'.data'
inquire( file=dataFname, exist=exst )
if (exst) then
call mdsreadvector_flt(fn,globalFile,64,'RL',
& imax,tmp,bi,bj,1,mythid)
npart_read = tmp(1)
npart_times = tmp(5)
else
npart_read = 0.
npart_times = 0.
tmp(2) = myCurrentTime
endif
c
c the standard routine mdswritevector can be used here
c (2) write new actual number floats and time into file
c
c total number of records in this file
tmp(1) = DBLE(npart_tile(bi,bj))+npart_read
c first time of writing floats (do not change when written)
c tmp(2) = tmp(2)
c current time
tmp(3) = myCurrentTime
c timestep
tmp(4) = flt_int_prof
c total number of timesteps
tmp(5) = npart_times + 1.
c total number of floats
tmp(6) = max_npart
do ip=7,imax
tmp(ip) = 0.
enddo
call mdswritevector(fn,64,.false.,'RL',imax,tmp,bi,bj,1,
& myCurrentIter,mythid)
do ip=1,npart_tile(bi,bj)
c Move float to the surface
c
if(
& ( myCurrentTime.ge.tstart(ip,bi,bj))
& .and.
& (tend(ip,bi,bj).eq.-1..or.myCurrentTime.le.tend(ip,bi,bj))
& .and.
& (kpart(ip,bi,bj) .eq. kfloat(ip,bi,bj))
& .and.
& (iup(ip,bi,bj) .gt. 0.)
& ) then
c if(myCurrentTime .ge. tstart(ip,bi,bj) .and.
c & myCurrentTime .le. tend(ip,bi,bj) .and.
c & kpart(ip,bi,bj) .eq. kfloat(ip,bi,bj) .and.
c & iup(ip,bi,bj) .gt. 0.) then
if(mod(myCurrentTime,iup(ip,bi,bj)).eq.0.)
& kpart(ip,bi,bj) = flt_surf
endif
c If float has died move to level 0
c
if(
& (tend(ip,bi,bj).ne.-1..and.myCurrentTime.gt.tend(ip,bi,bj))
& ) then
kpart(ip,bi,bj) = 0.
endif
c Convert to local indices
c
xx=global2local_i(xpart(ip,bi,bj),bi,bj,mythid)
yy=global2local_j(ypart(ip,bi,bj),bi,bj,mythid)
tmp(1) = npart(ip,bi,bj)
tmp(2) = myCurrentTime
tmp(3) = xpart(ip,bi,bj)
tmp(4) = ypart(ip,bi,bj)
tmp(5) = kpart(ip,bi,bj)
if(
& ( myCurrentTime.ge.tstart(ip,bi,bj))
& .and.
& (tend(ip,bi,bj).eq.-1..or.myCurrentTime.le.tend(ip,bi,bj))
& ) then
c if(tstart(ip,bi,bj) .ne. -1. .and.
c & myCurrentTime .ge. tstart(ip,bi,bj) .and.
c & myCurrentTime .le. tend(ip,bi,bj)) then
call flt_bilinear2d(xx,yy,pp,cg2d_x,1,bi,bj)
tmp(6) = pp
do k=1,Nr
call flt_bilinear (xx,yy,uu,k,uVel, 2,bi,bj)
call flt_bilinear (xx,yy,vv,k,vVel, 3,bi,bj)
call flt_bilinear (xx,yy,tt,k,theta, 1,bi,bj)
call flt_bilinear (xx,yy,ss,k,salt, 1,bi,bj)
tmp(6+k) = uu
tmp(6+1*Nr+k) = vv
tmp(6+2*Nr+k) = tt
tmp(6+3*Nr+k) = ss
enddo
else
tmp(6) = flt_nan
do k=1,Nr
tmp(6+k) = flt_nan
tmp(6+1*Nr+k) = flt_nan
tmp(6+2*Nr+k) = flt_nan
tmp(6+3*Nr+k) = flt_nan
enddo
endif
c
c the standard routine mdswritevector can be used here
c (3) write float positions into file
irecord=npart_read+ip+1
call mdswritevector(fn,64,.false.,'RL',imax,tmp,bi,bj,
& irecord,myCurrentIter,mythid)
enddo
ENDDO
ENDDO
return
end