pkg/mdsio/mdsio_wr_metafiles.F

caaa08ce20 Jean*0001 #include "MDSIO_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C !ROUTINE: MDS_WR_METAFILES
                0006 C !INTERFACE:
                0007       SUBROUTINE MDS_WR_METAFILES(
                0008      I   fName,
                0009      I   filePrec,
                0010      I   globalFile,
                0011      I   useCurrentDir,
                0012      I   nNx, nNy, nNz,
                0013      I   titleLine,
                0014      I   nFlds, fldList,
                0015      I   nTimRec, timList,
a50692f9cd Jean*0016      I   misVal,
caaa08ce20 Jean*0017      I   irecord,
                0018      I   myIter,
                0019      I   myThid )
                0020
                0021 C !DESCRIPTION:
                0022 C
                0023 C MDS_WR_METAFILES creates either a file of the form "fName.meta" IF the
20b1679b8a Jean*0024 C logical flag "globalFile" or "useSingleCPUIO" are set true. Otherwise
caaa08ce20 Jean*0025 C it creates MDS tiled files of the form "fName.xxx.yyy.meta".
                0026 C Currently, the meta-files are not read because it is difficult
                0027 C to parse files in fortran. We should read meta information before
                0028 C adding records to an existing multi-record file.
                0029 C The precision of the file is decsribed by filePrec, set either
                0030 C to floatPrec32 or floatPrec64.
                0031 C nNz=1 implies a 2-D model field and nNz=Nr implies a 3-D model field.
                0032 C irecord is the record number to be written and must be >= 1.
                0033 C NOTE: It is currently assumed that
                0034 C the highest record number in the file was the last record written.
                0035 C Nor is there a consistency check between the routine arguments and file.
20b1679b8a Jean*0036 C ie. if you write record 2 after record 4 the meta information
caaa08ce20 Jean*0037 C will record the number of records to be 2. This, again, is because
                0038 C we have read the meta information. To be fixed.
                0039
                0040 C     !USES:
                0041       IMPLICIT NONE
                0042 C Global variables / COMMON blocks
                0043 #include "SIZE.h"
                0044 #include "EEPARAMS.h"
                0045 #include "PARAMS.h"
                0046 #ifdef ALLOW_EXCH2
f9f661930b Jean*0047 #include "W2_EXCH2_SIZE.h"
caaa08ce20 Jean*0048 #include "W2_EXCH2_TOPOLOGY.h"
f14a858a6e Jean*0049 #include "W2_EXCH2_PARAMS.h"
caaa08ce20 Jean*0050 #endif /* ALLOW_EXCH2 */
                0051 C Arguments:
                0052 C
                0053 C fName     (string)  :: base name for file to write
                0054 C filePrec  (integer) :: number of bits per word in file (32 or 64)
                0055 C globalFile (logical):: selects between writing a global or tiled file
                0056 C useCurrentDir(logic):: always write to the current directory (even if
                0057 C                        "mdsioLocalDir" is set)
                0058 C nNx,nNy   (integer) :: used for writing YZ or XZ slice
                0059 C nNz       (integer) :: number of vertical levels to be written
                0060 C titleLine (string)  :: title or any descriptive comments
                0061 C nFlds     (integer) :: number of fields from "fldList" to write
                0062 C fldList   (string)  :: array of fields name to write
                0063 C nTimRec   (integer) :: number of time-info from "fldList" to write
                0064 C timList   (real)    :: array of time-info to write
a50692f9cd Jean*0065 C misVal    (real)    :: missing value (ignored if = 1.)
caaa08ce20 Jean*0066 C irecord   (integer) :: record number to write
                0067 C myIter    (integer) :: time step number
                0068 C myThid    (integer) :: thread identifier
                0069 C
                0070 C Routine arguments
                0071       CHARACTER*(*) fName
                0072       INTEGER filePrec
                0073       LOGICAL globalFile
                0074       LOGICAL useCurrentDir
                0075       INTEGER nNx, nNy, nNz
                0076       CHARACTER*(*) titleLine
                0077       INTEGER nFlds
                0078       CHARACTER*(8) fldList(*)
                0079       INTEGER nTimRec
                0080       _RL     timList(*)
a50692f9cd Jean*0081       _RL     misVal
caaa08ce20 Jean*0082       INTEGER irecord
                0083       INTEGER myIter
                0084       INTEGER myThid
                0085 CEOP
                0086
                0087 C Functions
                0088       INTEGER  ILNBLNK
                0089       EXTERNAL ILNBLNK
                0090       LOGICAL  MASTER_CPU_IO
                0091       EXTERNAL MASTER_CPU_IO
                0092 C Local variables
                0093       CHARACTER*(MAX_LEN_FNAM) dataFName, metaFName, pfName
                0094       INTEGER iG,jG, bi,bj, IL,pIL
20b1679b8a Jean*0095       INTEGER dimList(3,3), nDims, map2gl(2)
caaa08ce20 Jean*0096       INTEGER xSize, ySize
f14a858a6e Jean*0097       INTEGER tBx, tBy
                0098 #ifdef ALLOW_EXCH2
20b1679b8a Jean*0099       INTEGER tN
f14a858a6e Jean*0100 #endif /* ALLOW_EXCH2 */
caaa08ce20 Jean*0101
                0102 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0103 C-    Set dimensions:
                0104       xSize = Nx
                0105       ySize = Ny
f14a858a6e Jean*0106 #ifdef ALLOW_EXCH2
                0107       IF ( W2_useE2ioLayOut ) THEN
                0108         xSize = exch2_global_Nx
                0109         ySize = exch2_global_Ny
                0110       ENDIF
                0111 #endif /* ALLOW_EXCH2 */
caaa08ce20 Jean*0112       IF (nNx.EQ.1) xSize = 1
                0113       IF (nNy.EQ.1) ySize = 1
                0114
                0115 C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO):
                0116       IF ( MASTER_CPU_IO(myThid) ) THEN
                0117
                0118        IF ( useSingleCpuIO .OR. globalFile ) THEN
                0119
                0120          IL  = ILNBLNK( fName )
                0121          WRITE(dataFName,'(2A)') fName(1:IL),'.data'
                0122          WRITE(metaFName,'(2A)') fName(1:IL),'.meta'
                0123          dimList(1,1) = xSize
                0124          dimList(2,1) = 1
                0125          dimList(3,1) = xSize
                0126          dimList(1,2) = ySize
                0127          dimList(2,2) = 1
                0128          dimList(3,2) = ySize
                0129          dimList(1,3) = nNz
                0130          dimList(2,3) = 1
                0131          dimList(3,3) = nNz
                0132          nDims=3
                0133          IF (nNz.EQ.1) nDims=2
20b1679b8a Jean*0134          map2gl(1) = 0
                0135          map2gl(2) = 1
caaa08ce20 Jean*0136          CALL MDS_WRITE_META(
                0137      I              metaFName, dataFName, the_run_name, titleLine,
fbc6fb65d0 Jean*0138      I              filePrec, nDims,dimList,map2gl, nFlds, fldList,
a50692f9cd Jean*0139      I              nTimRec, timList, misVal, irecord, myIter, myThid )
caaa08ce20 Jean*0140
                0141        ELSE
                0142
                0143 C Assign special directory
                0144         pIL = ILNBLNK( mdsioLocalDir )
                0145         IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
                0146           pfName = fName
                0147         ELSE
                0148           IL  = ILNBLNK( fName )
                0149           WRITE(pfName,'(2A)') mdsioLocalDir(1:pIL), fName(1:IL)
                0150         ENDIF
                0151         pIL=ILNBLNK( pfName )
                0152
                0153 C Loop over all tiles
                0154         DO bj=1,nSy
                0155          DO bi=1,nSx
                0156 C If we are writing to a tiled MDS file then we open each one here
                0157            iG=bi+(myXGlobalLo-1)/sNx
                0158            jG=bj+(myYGlobalLo-1)/sNy
                0159            WRITE(dataFName,'(2a,i3.3,a,i3.3,a)')
                0160      &              pfName(1:pIL),'.',iG,'.',jG,'.data'
                0161 C Create meta-file for each tile IF we are tiling
                0162            WRITE(metaFname,'(2a,i3.3,a,i3.3,a)')
                0163      &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
f14a858a6e Jean*0164            tBx = myXGlobalLo-1 + (bi-1)*sNx
                0165            tBy = myYGlobalLo-1 + (bj-1)*sNy
20b1679b8a Jean*0166            map2gl(1) = 0
                0167            map2gl(2) = 1
f14a858a6e Jean*0168 #ifdef ALLOW_EXCH2
                0169            IF ( W2_useE2ioLayOut ) THEN
c424ee7cc7 Jean*0170              tN = W2_myTileList(bi,bj)
f14a858a6e Jean*0171              tBx = exch2_txGlobalo(tN) - 1
                0172              tBy = exch2_tyGlobalo(tN) - 1
                0173              IF (nNx.EQ.0 .AND. nNy.EQ.0) THEN
                0174               IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
                0175 C-            face x-size larger than glob-size : fold it
                0176                 map2gl(1) = 0
                0177                 map2gl(2) = exch2_mydNx(tN) / xSize
                0178               ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
                0179 C-            tile y-size larger than glob-size : make a long line
                0180                 map2gl(1) = exch2_mydNx(tN)
                0181                 map2gl(2) = 0
                0182               ELSE
                0183 C-            default (face fit into global-IO-array)
                0184                 map2gl(1) = 0
                0185                 map2gl(2) = 1
                0186               ENDIF
                0187              ENDIF
20b1679b8a Jean*0188            ENDIF
f14a858a6e Jean*0189 #endif /* ALLOW_EXCH2 */
caaa08ce20 Jean*0190            dimList(1,1) = xSize
f14a858a6e Jean*0191            dimList(2,1) = tBx + 1
                0192            dimList(3,1) = tBx + sNx
caaa08ce20 Jean*0193            dimList(1,2) = ySize
f14a858a6e Jean*0194            dimList(2,2) = tBy + 1
                0195            dimList(3,2) = tBy + sNy
caaa08ce20 Jean*0196            dimList(1,3) = nNz
                0197            dimList(2,3) = 1
                0198            dimList(3,3) = nNz
                0199            nDims=3
                0200            IF (nNz.EQ.1) nDims=2
                0201            IF (nNx.EQ.1) dimList(2,1) = 1
                0202            IF (nNx.EQ.1) dimList(3,1) = 1
                0203            IF (nNy.EQ.1) dimList(2,2) = 1
                0204            IF (nNy.EQ.1) dimList(3,2) = 1
                0205            CALL MDS_WRITE_META(
                0206      I              metaFName, dataFName, the_run_name, titleLine,
fbc6fb65d0 Jean*0207      I              filePrec, nDims,dimList,map2gl, nFlds, fldList,
a50692f9cd Jean*0208      I              nTimRec, timList, misVal, irecord, myIter, myThid )
caaa08ce20 Jean*0209 C End of bi,bj loops
                0210          ENDDO
                0211         ENDDO
                0212
                0213 C endif useSingleCpuIO or globalFile
                0214        ENDIF
                0215
                0216 C endif MASTER_CPU_IO
                0217       ENDIF
                0218
                0219 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0220
                0221       RETURN
                0222       END