pkg/flt/flt_init_varia.F

e66e388d3b Jean*0001 #include "FLT_OPTIONS.h"
                0002
6451e229ef Jean*0003       SUBROUTINE FLT_INIT_VARIA ( myThid  )
e66e388d3b Jean*0004
                0005 C     ==================================================================
6451e229ef Jean*0006 C     SUBROUTINE FLT_INIT_VARIA
e66e388d3b Jean*0007 C     ==================================================================
                0008 C     o This routine initializes the start/restart positions.
0ad17d4ed9 Jean*0009 C     o Either read initial position from file "flt_file" or
                0010 C       read pickup file. The 2 type of files are similar, except
                0011 C       initial positions are given on grid-coordinate (distance/degree
                0012 C       depending on the grid) whereas in pickup file, positions are
                0013 C       fractional indices along the grid and local to the tile.
                0014 C       For this reason global pickup file is not supported.
                0015 C       Initialisation:
                0016 C     o First it check for global file, and when found, reads the global file
e66e388d3b Jean*0017 C       (that has the same format as local files) and sorts those floats
                0018 C       that exist on the specific tile into the local array.
0ad17d4ed9 Jean*0019 C     o If no global file is available or in a case of a restart (pickup
                0020 C       file from a previous integration) then read tiled file without
                0021 C       any further check (because they exist on the specific tile).
e66e388d3b Jean*0022 C     ==================================================================
c806179eb4 Alis*0023
a11169c200 Jean*0024 C     !USES:
                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 C     == routine arguments ==
                0034 C     myThid - thread number for this instance of the routine.
eacecc7041 Jean*0035       INTEGER myThid
c806179eb4 Alis*0036
a11169c200 Jean*0037 C     == Functions ==
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 C     == local variables ==
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 C     number of active record in the file (might be lower than the
                0058 C     total number of records because the tile could have contained
                0059 C     more floats at an earlier restart
eacecc7041 Jean*0060       INTEGER npart_read
                0061       _RL     npart_dist
e66e388d3b Jean*0062
                0063 C     == end of interface ==
                0064
0ad17d4ed9 Jean*0065 C-    Tile boundary on index map:
                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 C-    all threads initialise local var:
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 C read floats initial condition from file
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 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
c806179eb4 Alis*0115
0ad17d4ed9 Jean*0116 C--   Initial position: first try to read from a global file.
                0117       ioUnit = -2
                0118       bi = 0
                0119       bj = 0
77b2b58e49 Davi*0120       IF ( nIter0.EQ.FLT_Iter0 ) THEN
0ad17d4ed9 Jean*0121 C-    read actual number of floats from file
                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 C--   Found a global file
                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 C-    read individual float position from file
                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 C-    For initial condition only, convert coordinates to index map:
                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 C-    Check if float exists on this tile. If not, try next tile
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 C-      end bi,bj loops
                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 C--   then try to read from a tiled file:
                0179
                0180         DO bj = 1,nSy
                0181          DO bi = 1,nSx
                0182            ioUnit = -1
                0183 C-    read actual number floats from file
                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 C-    read individual float position from file
                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 C--   For initial condition only, convert coordinates to index map:
                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 C     not a global file: assume that all particles from this tiled-file
                0211 C     belong to this current tile (=> do not no check)
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 C-      end bi,bj loops
eacecc7041 Jean*0224          ENDDO
0ad17d4ed9 Jean*0225         ENDDO
f5995a4aae Gael*0226
0ad17d4ed9 Jean*0227 C--   end global-file / tiled-file separated treatment
                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 C--   Initial call just to check which variables to write
                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