-
Notifications
You must be signed in to change notification settings - Fork 237
/
flt_init_varia.F
266 lines (236 loc) · 9.16 KB
/
flt_init_varia.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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
#include "FLT_OPTIONS.h"
SUBROUTINE FLT_INIT_VARIA ( myThid )
C ==================================================================
C SUBROUTINE FLT_INIT_VARIA
C ==================================================================
C o This routine initializes the start/restart positions.
C o Either read initial position from file "flt_file" or
C read pickup file. The 2 type of files are similar, except
C initial positions are given on grid-coordinate (distance/degree
C depending on the grid) whereas in pickup file, positions are
C fractional indices along the grid and local to the tile.
C For this reason global pickup file is not supported.
C Initialisation:
C o First it check for global file, and when found, reads the global file
C (that has the same format as local files) and sorts those floats
C that exist on the specific tile into the local array.
C o If no global file is available or in a case of a restart (pickup
C file from a previous integration) then read tiled file without
C any further check (because they exist on the specific tile).
C ==================================================================
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "FLT_SIZE.h"
#include "FLT.h"
C == routine arguments ==
C myThid - thread number for this instance of the routine.
INTEGER myThid
C == Functions ==
INTEGER ILNBLNK
EXTERNAL ILNBLNK
_RL FLT_MAP_R2K
EXTERNAL FLT_MAP_R2K
C == local variables ==
INTEGER bi, bj
INTEGER ip, iL
INTEGER imax
PARAMETER(imax=9)
_RL tmp(imax)
_RS dummyRS(1)
_RL ix, jy, kz
_RL iLo, iHi, jLo, jHi
INTEGER fp, ioUnit
CHARACTER*(MAX_LEN_FNAM) fn
CHARACTER*(MAX_LEN_MBUF) msgBuf
CHARACTER*(10) suff
C number of active record in the file (might be lower than the
C total number of records because the tile could have contained
C more floats at an earlier restart
INTEGER npart_read
_RL npart_dist
C == end of interface ==
C- Tile boundary on index map:
iLo = 0.5 _d 0
iHi = 0.5 _d 0 + DFLOAT(sNx)
jLo = 0.5 _d 0
jHi = 0.5 _d 0 + DFLOAT(sNy)
C- all threads initialise local var:
npart_read = 0
npart_dist = 0.
_BEGIN_MASTER(myThid)
DO bj = 1,nSy
DO bi = 1,nSx
npart_tile(bi,bj) = 0
ENDDO
ENDDO
C read floats initial condition from file
IF ( nIter0.EQ.FLT_Iter0 ) THEN
fn = flt_file
fp = readBinaryPrec
ELSEIF ( nIter0.GT.FLT_Iter0 ) THEN
IF ( pickupSuff .EQ. ' ' ) THEN
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') nIter0
ELSE
CALL RW_GET_SUFFIX( suff, startTime, nIter0, myThid )
ENDIF
ELSE
WRITE(suff,'(A10)') pickupSuff
ENDIF
WRITE(fn,'(A,A10)') 'pickup_flt.',suff
fp = precFloat64
ELSE
WRITE(msgBuf,'(2A,I3,A)') 'FLT_INIT_VARIA:',
& ' wrong setting of FLT_Iter0 :'
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A,I3,A)') 'FLT_INIT_VARIA:',
& ' nIter0 < FLT_Iter0 not supported'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R FLT_INIT_VARIA'
ENDIF
iL = ILNBLNK(fn)
WRITE(msgBuf,'(2A)')
& 'FLT_INIT_VARIA: reading Floats from: ', fn(1:iL)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C-- Initial position: first try to read from a global file.
ioUnit = -2
bi = 0
bj = 0
IF ( nIter0.EQ.FLT_Iter0 ) THEN
C- read actual number of floats from file
CALL MDS_READVEC_LOC( fn, fp, ioUnit,
& 'RL', imax, tmp, dummyRS,
& bi, bj, 1, myThid )
ENDIF
IF ( ioUnit.GT.0 .AND. mapIniPos2Index ) THEN
C-- Found a global file
WRITE(msgBuf,'(A,2I4,A,1P2E15.8)')
& ' bi,bj=', bi, bj, ' , npart,max_npart=', tmp(1), tmp(6)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
npart_read = NINT(tmp(1))
max_npart = tmp(6)
DO ip=1,npart_read
C- read individual float position from file
CALL MDS_READVEC_LOC( fn, fp, ioUnit,
& 'RL', imax, tmp, dummyRS,
& bi, bj, ip+1, myThid )
DO bj = 1,nSy
DO bi = 1,nSx
C- For initial condition only, convert coordinates to index map:
CALL FLT_MAP_XY2IJLOCAL( ix, jy,
I tmp(3), tmp(4),bi,bj,myThid )
kz = FLT_MAP_R2K( tmp(5), bi, bj, myThid )
C- Check if float exists on this tile. If not, try next tile
IF ( ix.GE.iLo .AND. ix.LT.iHi .AND.
& jy.GE.jLo .AND. jy.LT.jHi ) THEN
npart_tile(bi,bj) = npart_tile(bi,bj) + 1
IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
npart( npart_tile(bi,bj),bi,bj) = tmp(1)
tstart(npart_tile(bi,bj),bi,bj) = tmp(2)
ipart( npart_tile(bi,bj),bi,bj) = ix
jpart( npart_tile(bi,bj),bi,bj) = jy
kpart( npart_tile(bi,bj),bi,bj) = kz
kfloat(npart_tile(bi,bj),bi,bj) = tmp(6)
iup( npart_tile(bi,bj),bi,bj) = tmp(7)
itop( npart_tile(bi,bj),bi,bj) = tmp(8)
tend( npart_tile(bi,bj),bi,bj) = tmp(9)
ENDIF
ENDIF
C- end bi,bj loops
ENDDO
ENDDO
ENDDO
CLOSE( ioUnit )
ELSEIF ( ioUnit.GT.0 ) THEN
WRITE(msgBuf,'(2A)') 'FLT_INIT_VARIA:',
& ' need mapIniPos2Index=T for global file'
CALL PRINT_ERROR( msgBuf , myThid)
STOP 'ABNORMAL END: S/R FLT_INIT_VARIA'
ELSE
C-- then try to read from a tiled file:
DO bj = 1,nSy
DO bi = 1,nSx
ioUnit = -1
C- read actual number floats from file
CALL MDS_READVEC_LOC( fn, fp, ioUnit,
& 'RL', imax, tmp, dummyRS,
& bi, bj, 1, myThid )
WRITE(msgBuf,'(A,2I4,A,1P2E15.8)')
& ' bi,bj=', bi, bj, ' , npart,max_npart=', tmp(1), tmp(6)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
npart_tile(bi,bj) = NINT(tmp(1))
max_npart = tmp(6)
npart_read = MIN( npart_tile(bi,bj), max_npart_tile )
DO ip=1,npart_read
C- read individual float position from file
CALL MDS_READVEC_LOC( fn, fp, ioUnit,
& 'RL', imax, tmp, dummyRS,
& bi, bj, ip+1, myThid )
IF ( nIter0.EQ.FLT_Iter0 .AND. mapIniPos2Index ) THEN
C-- For initial condition only, convert coordinates to index map:
CALL FLT_MAP_XY2IJLOCAL( ix, jy,
I tmp(3), tmp(4),bi,bj,myThid )
kz = FLT_MAP_R2K( tmp(5), bi, bj, myThid )
ELSE
ix = tmp(3)
jy = tmp(4)
kz = tmp(5)
ENDIF
C not a global file: assume that all particles from this tiled-file
C belong to this current tile (=> do not no check)
npart(ip,bi,bj) = tmp(1)
tstart(ip,bi,bj) = tmp(2)
ipart(ip,bi,bj) = ix
jpart(ip,bi,bj) = jy
kpart(ip,bi,bj) = kz
kfloat(ip,bi,bj) = tmp(6)
iup( ip,bi,bj) = tmp(7)
itop( ip,bi,bj) = tmp(8)
tend( ip,bi,bj) = tmp(9)
ENDDO
CLOSE( ioUnit )
C- end bi,bj loops
ENDDO
ENDDO
C-- end global-file / tiled-file separated treatment
ENDIF
DO bj = 1,nSy
DO bi = 1,nSx
npart_dist = npart_dist + DBLE(npart_tile(bi,bj))
IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_INIT_VARIA:',
& ' bi,bj=', bi, bj,
& ' npart_tile=', npart_tile(bi,bj),
& ' > max_npart_tile=', max_npart_tile
CALL PRINT_ERROR( msgBuf , myThid)
STOP 'ABNORMAL END: S/R FLT_INIT_VARIA'
ENDIF
ENDDO
ENDDO
_END_MASTER( myThid )
_BARRIER
_GLOBAL_SUM_RL( npart_dist, myThid )
_BEGIN_MASTER( myThid )
WRITE(msgBuf,'(A,2(A,I9))') 'FLT_INIT_VARIA:',
& ' max npart=', NINT(max_npart),
& ' , sum npart_tile=', NINT(npart_dist)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(A)') ' '
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
_END_MASTER( myThid )
C-- Initial call just to check which variables to write
IF ( flt_int_prof.NE.0. )
& CALL FLT_UP( startTime, nIter0, myThid )
IF ( flt_int_traj.NE.0. )
& CALL FLT_TRAJ( startTime, nIter0, myThid )
RETURN
END