File indexing completed on 2020-01-15 06:10:57 UTC
view on githubraw file Latest commit f5500931 on 2019-11-25 21:21:46 UTC
e66e388d3b Jean*0001 #include "FLT_OPTIONS.h"
0002
6451e229ef Jean*0003 SUBROUTINE FLT_INIT_VARIA ( myThid )
e66e388d3b Jean*0004
0005
6451e229ef Jean*0006
e66e388d3b Jean*0007
0008
0ad17d4ed9 Jean*0009
0010
0011
0012
0013
0014
0015
0016
e66e388d3b Jean*0017
0018
0ad17d4ed9 Jean*0019
0020
0021
e66e388d3b Jean*0022
c806179eb4 Alis*0023
a11169c200 Jean*0024
0025 IMPLICIT NONE
0026
c806179eb4 Alis*0027 #include "SIZE.h"
1d80ed5dd5 Jean*0028 #include "EEPARAMS.h"
c806179eb4 Alis*0029 #include "PARAMS.h"
730d8469b1 Oliv*0030 #include "FLT_SIZE.h"
1d80ed5dd5 Jean*0031 #include "FLT.h"
c806179eb4 Alis*0032
e66e388d3b Jean*0033
0034
eacecc7041 Jean*0035 INTEGER myThid
c806179eb4 Alis*0036
a11169c200 Jean*0037
e66e388d3b Jean*0038 INTEGER ILNBLNK
0039 EXTERNAL ILNBLNK
fc9708dd89 Jean*0040 _RL FLT_MAP_R2K
0041 EXTERNAL FLT_MAP_R2K
c806179eb4 Alis*0042
e66e388d3b Jean*0043
eacecc7041 Jean*0044 INTEGER bi, bj
e2d5347710 Jean*0045 INTEGER ip, iL
c806179eb4 Alis*0046 INTEGER imax
e66e388d3b Jean*0047 PARAMETER(imax=9)
c806179eb4 Alis*0048 _RL tmp(imax)
0ad17d4ed9 Jean*0049 _RS dummyRS(1)
d5477ff298 Jean*0050 _RL ix, jy, kz
1d80ed5dd5 Jean*0051 _RL iLo, iHi, jLo, jHi
0ad17d4ed9 Jean*0052 INTEGER fp, ioUnit
eacecc7041 Jean*0053 CHARACTER*(MAX_LEN_FNAM) fn
e66e388d3b Jean*0054 CHARACTER*(MAX_LEN_MBUF) msgBuf
f5995a4aae Gael*0055 CHARACTER*(10) suff
c806179eb4 Alis*0056
e66e388d3b Jean*0057
0058
0059
eacecc7041 Jean*0060 INTEGER npart_read
0061 _RL npart_dist
e66e388d3b Jean*0062
0063
0064
0ad17d4ed9 Jean*0065
0066 iLo = 0.5 _d 0
0067 iHi = 0.5 _d 0 + DFLOAT(sNx)
0068 jLo = 0.5 _d 0
0069 jHi = 0.5 _d 0 + DFLOAT(sNy)
0070
e66e388d3b Jean*0071
eacecc7041 Jean*0072 npart_read = 0
e66e388d3b Jean*0073 npart_dist = 0.
c806179eb4 Alis*0074
521db80798 Jean*0075 _BEGIN_MASTER(myThid)
0ad17d4ed9 Jean*0076
0077 DO bj = 1,nSy
0078 DO bi = 1,nSx
0079 npart_tile(bi,bj) = 0
0080 ENDDO
0081 ENDDO
0082
0083
77b2b58e49 Davi*0084 IF ( nIter0.EQ.FLT_Iter0 ) THEN
eacecc7041 Jean*0085 fn = flt_file
0ad17d4ed9 Jean*0086 fp = readBinaryPrec
df5a9764ba Jean*0087 ELSEIF ( nIter0.GT.FLT_Iter0 ) THEN
0088 IF ( pickupSuff .EQ. ' ' ) THEN
0089 IF ( rwSuffixType.EQ.0 ) THEN
0090 WRITE(suff,'(I10.10)') nIter0
0091 ELSE
0092 CALL RW_GET_SUFFIX( suff, startTime, nIter0, myThid )
0093 ENDIF
f5995a4aae Gael*0094 ELSE
0095 WRITE(suff,'(A10)') pickupSuff
0096 ENDIF
0097 WRITE(fn,'(A,A10)') 'pickup_flt.',suff
0ad17d4ed9 Jean*0098 fp = precFloat64
77b2b58e49 Davi*0099 ELSE
0100 WRITE(msgBuf,'(2A,I3,A)') 'FLT_INIT_VARIA:',
0101 & ' wrong setting of FLT_Iter0 :'
0102 CALL PRINT_ERROR( msgBuf, myThid )
0103 WRITE(msgBuf,'(2A,I3,A)') 'FLT_INIT_VARIA:',
0104 & ' nIter0 < FLT_Iter0 not supported'
0105 CALL PRINT_ERROR( msgBuf, myThid )
0106 STOP 'ABNORMAL END: S/R FLT_INIT_VARIA'
eacecc7041 Jean*0107 ENDIF
0108 iL = ILNBLNK(fn)
6451e229ef Jean*0109 WRITE(msgBuf,'(2A)')
0110 & 'FLT_INIT_VARIA: reading Floats from: ', fn(1:iL)
eacecc7041 Jean*0111 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0112 & SQUEEZE_RIGHT, myThid )
0113
0ad17d4ed9 Jean*0114
c806179eb4 Alis*0115
0ad17d4ed9 Jean*0116
0117 ioUnit = -2
0118 bi = 0
0119 bj = 0
77b2b58e49 Davi*0120 IF ( nIter0.EQ.FLT_Iter0 ) THEN
0ad17d4ed9 Jean*0121
0122 CALL MDS_READVEC_LOC( fn, fp, ioUnit,
0123 & 'RL', imax, tmp, dummyRS,
0124 & bi, bj, 1, myThid )
0125 ENDIF
1d80ed5dd5 Jean*0126
40b8247bc0 Jean*0127 IF ( ioUnit.GT.0 .AND. mapIniPos2Index ) THEN
0ad17d4ed9 Jean*0128
0129 WRITE(msgBuf,'(A,2I4,A,1P2E15.8)')
eacecc7041 Jean*0130 & ' bi,bj=', bi, bj, ' , npart,max_npart=', tmp(1), tmp(6)
0ad17d4ed9 Jean*0131 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
eacecc7041 Jean*0132 & SQUEEZE_RIGHT, myThid )
0ad17d4ed9 Jean*0133 npart_read = NINT(tmp(1))
0134 max_npart = tmp(6)
0135 DO ip=1,npart_read
0136
0137 CALL MDS_READVEC_LOC( fn, fp, ioUnit,
0138 & 'RL', imax, tmp, dummyRS,
0139 & bi, bj, ip+1, myThid )
0140 DO bj = 1,nSy
0141 DO bi = 1,nSx
0142
0143 CALL FLT_MAP_XY2IJLOCAL( ix, jy,
0144 I tmp(3), tmp(4),bi,bj,myThid )
0145 kz = FLT_MAP_R2K( tmp(5), bi, bj, myThid )
0146
1d80ed5dd5 Jean*0147 IF ( ix.GE.iLo .AND. ix.LT.iHi .AND.
0148 & jy.GE.jLo .AND. jy.LT.jHi ) THEN
eacecc7041 Jean*0149 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
0150 IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
c806179eb4 Alis*0151
1d80ed5dd5 Jean*0152 npart( npart_tile(bi,bj),bi,bj) = tmp(1)
eacecc7041 Jean*0153 tstart(npart_tile(bi,bj),bi,bj) = tmp(2)
1d80ed5dd5 Jean*0154 ipart( npart_tile(bi,bj),bi,bj) = ix
0155 jpart( npart_tile(bi,bj),bi,bj) = jy
0156 kpart( npart_tile(bi,bj),bi,bj) = kz
eacecc7041 Jean*0157 kfloat(npart_tile(bi,bj),bi,bj) = tmp(6)
1d80ed5dd5 Jean*0158 iup( npart_tile(bi,bj),bi,bj) = tmp(7)
0159 itop( npart_tile(bi,bj),bi,bj) = tmp(8)
0160 tend( npart_tile(bi,bj),bi,bj) = tmp(9)
0161
eacecc7041 Jean*0162 ENDIF
e66e388d3b Jean*0163 ENDIF
0ad17d4ed9 Jean*0164
0165 ENDDO
0166 ENDDO
c806179eb4 Alis*0167
0ad17d4ed9 Jean*0168 ENDDO
0169 CLOSE( ioUnit )
d5477ff298 Jean*0170
0ad17d4ed9 Jean*0171 ELSEIF ( ioUnit.GT.0 ) THEN
0172 WRITE(msgBuf,'(2A)') 'FLT_INIT_VARIA:',
40b8247bc0 Jean*0173 & ' need mapIniPos2Index=T for global file'
0ad17d4ed9 Jean*0174 CALL PRINT_ERROR( msgBuf , myThid)
0175 STOP 'ABNORMAL END: S/R FLT_INIT_VARIA'
0176
0177 ELSE
0178
0179
0180 DO bj = 1,nSy
0181 DO bi = 1,nSx
0182 ioUnit = -1
0183
0184 CALL MDS_READVEC_LOC( fn, fp, ioUnit,
0185 & 'RL', imax, tmp, dummyRS,
0186 & bi, bj, 1, myThid )
0187 WRITE(msgBuf,'(A,2I4,A,1P2E15.8)')
0188 & ' bi,bj=', bi, bj, ' , npart,max_npart=', tmp(1), tmp(6)
0189 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0190 & SQUEEZE_RIGHT, myThid )
0191
0192 npart_tile(bi,bj) = NINT(tmp(1))
0193 max_npart = tmp(6)
0194 npart_read = MIN( npart_tile(bi,bj), max_npart_tile )
0195 DO ip=1,npart_read
0196
0197 CALL MDS_READVEC_LOC( fn, fp, ioUnit,
0198 & 'RL', imax, tmp, dummyRS,
0199 & bi, bj, ip+1, myThid )
77b2b58e49 Davi*0200 IF ( nIter0.EQ.FLT_Iter0 .AND. mapIniPos2Index ) THEN
0ad17d4ed9 Jean*0201
0202 CALL FLT_MAP_XY2IJLOCAL( ix, jy,
0203 I tmp(3), tmp(4),bi,bj,myThid )
0204 kz = FLT_MAP_R2K( tmp(5), bi, bj, myThid )
0205 ELSE
0206 ix = tmp(3)
0207 jy = tmp(4)
0208 kz = tmp(5)
0209 ENDIF
eacecc7041 Jean*0210
0211
0ad17d4ed9 Jean*0212 npart(ip,bi,bj) = tmp(1)
0213 tstart(ip,bi,bj) = tmp(2)
0214 ipart(ip,bi,bj) = ix
0215 jpart(ip,bi,bj) = jy
0216 kpart(ip,bi,bj) = kz
0217 kfloat(ip,bi,bj) = tmp(6)
0218 iup( ip,bi,bj) = tmp(7)
0219 itop( ip,bi,bj) = tmp(8)
0220 tend( ip,bi,bj) = tmp(9)
0221 ENDDO
0222 CLOSE( ioUnit )
0223
eacecc7041 Jean*0224 ENDDO
0ad17d4ed9 Jean*0225 ENDDO
f5995a4aae Gael*0226
0ad17d4ed9 Jean*0227
0228 ENDIF
fc9708dd89 Jean*0229
0ad17d4ed9 Jean*0230 DO bj = 1,nSy
0231 DO bi = 1,nSx
eacecc7041 Jean*0232 npart_dist = npart_dist + DBLE(npart_tile(bi,bj))
0233 IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
6451e229ef Jean*0234 WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_INIT_VARIA:',
eacecc7041 Jean*0235 & ' bi,bj=', bi, bj,
0236 & ' npart_tile=', npart_tile(bi,bj),
0237 & ' > max_npart_tile=', max_npart_tile
0238 CALL PRINT_ERROR( msgBuf , myThid)
6451e229ef Jean*0239 STOP 'ABNORMAL END: S/R FLT_INIT_VARIA'
eacecc7041 Jean*0240 ENDIF
0241 ENDDO
e66e388d3b Jean*0242 ENDDO
0243 _END_MASTER( myThid )
0244 _BARRIER
c806179eb4 Alis*0245
6637358eea Jean*0246 _GLOBAL_SUM_RL( npart_dist, myThid )
c806179eb4 Alis*0247
e66e388d3b Jean*0248 _BEGIN_MASTER( myThid )
6451e229ef Jean*0249 WRITE(msgBuf,'(A,2(A,I9))') 'FLT_INIT_VARIA:',
eacecc7041 Jean*0250 & ' max npart=', NINT(max_npart),
0251 & ' , sum npart_tile=', NINT(npart_dist)
0252 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0253 & SQUEEZE_RIGHT, myThid )
0254 WRITE(msgBuf,'(A)') ' '
0255 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0256 & SQUEEZE_RIGHT, myThid )
e66e388d3b Jean*0257 _END_MASTER( myThid )
c806179eb4 Alis*0258
30f0243475 Jean*0259
0260 IF ( flt_int_prof.NE.0. )
0261 & CALL FLT_UP( startTime, nIter0, myThid )
0262 IF ( flt_int_traj.NE.0. )
0263 & CALL FLT_TRAJ( startTime, nIter0, myThid )
0264
e66e388d3b Jean*0265 RETURN
0266 END