pkg/mdsio/mdsio_rw_field.F

5c50f93eee Jean*0001 #undef USE_OBSOLETE_MDS_RW_FIELD
a3dbe60c1b Jean*0002 #include "MDSIO_OPTIONS.h"
                0003
c0c8c1b5a1 Jean*0004 C--  File mdsio_rw_field.F: old version of MDSIO READ/WRITE FIELD S/R with
                0005 C    fewer arguments (kept for backward compatibility): call new MDSIO S/R
                0006 C    with fixed additional arguments
                0007 C--   Contents
                0008 C--   o MDSREADFIELD
                0009 C--   o MDSREADFIELD_LOC
                0010 C--   o MDSWRITEFIELD
                0011 C--   o MDSWRITEFIELD_LOC
                0012
a3dbe60c1b Jean*0013 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0014
                0015       SUBROUTINE MDSREADFIELD(
                0016      I   fName,
                0017      I   filePrec,
                0018      I   arrType,
                0019      I   nNz,
                0020      O   arr,
                0021      I   irecord,
                0022      I   myThid )
                0023 C
                0024 C Arguments:
                0025 C
                0026 C fName     (string)  :: base name for file to written
                0027 C filePrec  (integer) :: number of bits per word in file (32 or 64)
                0028 C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"
                0029 C nNz       (integer) :: size of third dimension: normally either 1 or Nr
                0030 C arr       ( RS/RL ) :: array to write, arr(:,:,nNz,:,:)
                0031 C irecord   (integer) :: record number to read
                0032 C myThid    (integer) :: thread identifier
                0033 C
                0034 C Routine now calls MDS_READ_FIELD, just a way to add 2 extra arguments
                0035 C to the argument list. The 1rst new argument is to make the difference between
c0c8c1b5a1 Jean*0036 C the vertical dimension (3rd dimension) of the output array and the number
a3dbe60c1b Jean*0037 C of levels to read in. This routine assumes they are the same.
                0038 C The 2nd new argument (useCurrentDir=.FALSE.) allows to read files from
                0039 C the "mdsioLocalDir" directory (if it is set).
                0040
                0041       IMPLICIT NONE
                0042 C Global variables / COMMON blocks
                0043 #include "SIZE.h"
                0044 c #include "EEPARAMS.h"
                0045
                0046 C Routine arguments
                0047       CHARACTER*(*) fName
                0048       INTEGER filePrec
                0049       CHARACTER*(2) arrType
                0050       INTEGER nNz
1568a57fc0 Jean*0051       _RL     arr(*)
a3dbe60c1b Jean*0052       INTEGER irecord
                0053       INTEGER myThid
a6a4ee9dd2 Jean*0054
5c50f93eee Jean*0055 #ifdef USE_OBSOLETE_MDS_RW_FIELD
a6a4ee9dd2 Jean*0056 C Local variables
                0057       _RL dummyRL(1)
                0058       _RS dummyRS(1)
                0059
                0060       IF ( arrType.EQ.'RL' ) THEN
                0061         CALL MDS_READ_FIELD(
                0062      I                fName, filePrec, .FALSE., arrType, nNz, 1, nNz,
                0063      O                arr, dummyRS,
                0064      I                irecord, myThid )
                0065       ELSE
                0066         CALL MDS_READ_FIELD(
                0067      I                fName, filePrec, .FALSE., arrType, nNz, 1, nNz,
                0068      O                dummyRL, arr,
                0069      I                irecord, myThid )
                0070       ENDIF
                0071
5c50f93eee Jean*0072 #else /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0073       STOP 'ABNORMAL END: S/R MDSREADFIELD is retired'
5c50f93eee Jean*0074 #endif /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0075
a3dbe60c1b Jean*0076       RETURN
                0077       END
                0078
                0079 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0080
                0081       SUBROUTINE MDSREADFIELD_LOC(
                0082      I   fName,
                0083      I   filePrec,
                0084      I   arrType,
                0085      I   nNz,
                0086      O   arr,
                0087      I   irecord,
                0088      I   myThid )
                0089 C
                0090 C Arguments:
                0091 C
                0092 C fName     (string)  :: base name for file to write
                0093 C filePrec  (integer) :: number of bits per word in file (32 or 64)
                0094 C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"
                0095 C nNz       (integer) :: size of third dimension: normally either 1 or Nr
                0096 C arr       ( RS/RL ) :: array to write, arr(:,:,nNz,:,:)
                0097 C irecord   (integer) :: record number to read
                0098 C myThid    (integer) :: thread identifier
                0099 C
                0100 C Routine now calls MDS_READ_FIELD, just a way to add 2 extra arguments
                0101 C to the argument list. The 1rst new argument is to make the difference between
c0c8c1b5a1 Jean*0102 C the vertical dimension (3rd dimension) of the output array and the number
a3dbe60c1b Jean*0103 C of levels to read in. This routine assumes they are the same.
                0104 C The 2nd new argument (useCurrentDir=.FALSE.) forces to ignore the
                0105 C "mdsioLocalDir" parameter and to always read from the current directory.
                0106
                0107       IMPLICIT NONE
                0108 C Global variables / COMMON blocks
                0109 #include "SIZE.h"
                0110 c #include "EEPARAMS.h"
                0111
                0112 C Routine arguments
                0113       CHARACTER*(*) fName
                0114       INTEGER filePrec
                0115       CHARACTER*(2) arrType
                0116       INTEGER nNz
1568a57fc0 Jean*0117       _RL     arr(*)
a3dbe60c1b Jean*0118       INTEGER irecord
                0119       INTEGER myThid
a6a4ee9dd2 Jean*0120
5c50f93eee Jean*0121 #ifdef USE_OBSOLETE_MDS_RW_FIELD
a6a4ee9dd2 Jean*0122 C Local variables
                0123       _RL dummyRL(1)
                0124       _RS dummyRS(1)
                0125
                0126       IF ( arrType.EQ.'RL' ) THEN
                0127         CALL MDS_READ_FIELD(
                0128      I                fName, filePrec, .TRUE., arrType, nNz, 1, nNz,
                0129      O                arr, dummyRS,
                0130      I                irecord, myThid )
                0131       ELSE
                0132         CALL MDS_READ_FIELD(
                0133      I                fName, filePrec, .TRUE., arrType, nNz, 1, nNz,
                0134      O                dummyRL, arr,
                0135      I                irecord, myThid )
                0136       ENDIF
                0137
5c50f93eee Jean*0138 #else /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0139       STOP 'ABNORMAL END: S/R MDSREADFIELD_LOC is empty'
5c50f93eee Jean*0140 #endif /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0141
a3dbe60c1b Jean*0142       RETURN
                0143       END
a6a4ee9dd2 Jean*0144
a3dbe60c1b Jean*0145 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0146
                0147       SUBROUTINE MDSWRITEFIELD(
                0148      I   fName,
                0149      I   filePrec,
                0150      I   globalFile,
                0151      I   arrType,
                0152      I   nNz,
                0153      I   arr,
                0154      I   irecord,
                0155      I   myIter,
                0156      I   myThid )
                0157 C
                0158 C Arguments:
                0159 C
                0160 C fName     (string)  :: base name for file to write
                0161 C filePrec  (integer) :: number of bits per word in file (32 or 64)
                0162 C globalFile (logical):: selects between writing a global or tiled file
                0163 C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"
                0164 C nNz       (integer) :: size of third dimension: normally either 1 or Nr
                0165 C arr       ( RS/RL ) :: array to write, arr(:,:,nNzdim,:,:)
                0166 C irecord   (integer) :: record number to write
                0167 C myIter    (integer) :: time step number
                0168 C myThid    (integer) :: thread identifier
                0169 C
                0170 C Routine now calls MDS_WRITE_FIELD, just a way to add 2 extra arguments
                0171 C to the argument list. The 1rst new argument is to make the difference between
                0172 C the vertical dimension (3rd dimension) of an array and the number of levels
                0173 C the output routine should process. This routine assumes they are the same.
                0174 C The 2nd new argument (useCurrentDir=.FALSE.) allows to write files to
                0175 C the "mdsioLocalDir" directory (if it is set).
                0176
                0177       IMPLICIT NONE
                0178 C Global variables / common blocks
                0179 #include "SIZE.h"
                0180 c #include "EEPARAMS.h"
                0181
                0182 C Routine arguments
                0183       CHARACTER*(*) fName
                0184       INTEGER filePrec
                0185       LOGICAL globalFile
                0186       CHARACTER*(2) arrType
                0187       INTEGER nNz
                0188       _RL     arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nNz,nSx,nSy)
                0189       INTEGER irecord
                0190       INTEGER myIter
                0191       INTEGER myThid
a6a4ee9dd2 Jean*0192
5c50f93eee Jean*0193 #ifdef USE_OBSOLETE_MDS_RW_FIELD
a6a4ee9dd2 Jean*0194 C Local variables
                0195       _RL dummyRL(1)
                0196       _RS dummyRS(1)
                0197
                0198       IF ( arrType.EQ.'RL' ) THEN
                0199         CALL MDS_WRITE_FIELD(
                0200      I                 fName, filePrec, globalFile, .FALSE.,
                0201      I                 arrType, nNz, 1, nNz, arr, dummyRS,
                0202      I                 irecord, myIter, myThid )
                0203       ELSE
                0204         CALL MDS_WRITE_FIELD(
                0205      I                 fName, filePrec, globalFile, .FALSE.,
                0206      I                 arrType, nNz, 1, nNz, dummyRL, arr,
                0207      I                 irecord, myIter, myThid )
                0208       ENDIF
                0209
5c50f93eee Jean*0210 #else /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0211       STOP 'ABNORMAL END: S/R MDSWRITEFIELD is retired'
5c50f93eee Jean*0212 #endif /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0213
a3dbe60c1b Jean*0214       RETURN
                0215       END
                0216
                0217 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0218
                0219       SUBROUTINE MDSWRITEFIELD_LOC(
                0220      I   fName,
                0221      I   filePrec,
                0222      I   globalFile,
                0223      I   arrType,
                0224      I   nNz,
                0225      I   arr,
                0226      I   irecord,
                0227      I   myIter,
                0228      I   myThid )
                0229 C
                0230 C Arguments:
                0231 C
                0232 C fName     (string)  :: base name for file to write
                0233 C filePrec  (integer) :: number of bits per word in file (32 or 64)
                0234 C globalFile (logical):: selects between writing a global or tiled file
                0235 C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"
                0236 C nNz       (integer) :: size of third dimension: normally either 1 or Nr
                0237 C arr       ( RS/RL ) :: array to write, arr(:,:,nNzdim,:,:)
                0238 C irecord   (integer) :: record number to write
                0239 C myIter    (integer) :: time step number
                0240 C myThid    (integer) :: thread identifier
                0241 C
                0242 C Routine now calls mdswritefield_new, just a way to add 2 extra arguments
                0243 C to the argument list. The 1rst new argument is to make the difference between
                0244 C the vertical dimension (3rd dimension) of an array and the number of levels
                0245 C the output routine should process. This routine assumes they are the same.
                0246 C The 2nd new argument (useCurrentDir=.TRUE.) forces to ignore the
                0247 C "mdsioLocalDir" parameter and to always write to the current directory.
                0248
c0c8c1b5a1 Jean*0249       IMPLICIT NONE
a3dbe60c1b Jean*0250 C Global variables / common blocks
                0251 #include "SIZE.h"
                0252 c #include "EEPARAMS.h"
                0253
                0254 C Routine arguments
                0255       CHARACTER*(*) fName
                0256       INTEGER filePrec
                0257       LOGICAL globalFile
                0258       CHARACTER*(2) arrType
                0259       INTEGER nNz
                0260       _RL     arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nNz,nSx,nSy)
                0261       INTEGER irecord
                0262       INTEGER myIter
                0263       INTEGER myThid
a6a4ee9dd2 Jean*0264
5c50f93eee Jean*0265 #ifdef USE_OBSOLETE_MDS_RW_FIELD
a6a4ee9dd2 Jean*0266 C Local variables
                0267       _RL dummyRL(1)
                0268       _RS dummyRS(1)
                0269
                0270       IF ( arrType.EQ.'RL' ) THEN
                0271         CALL MDS_WRITE_FIELD(
                0272      I                 fName, filePrec, globalFile, .TRUE.,
                0273      I                 arrType, nNz, 1, nNz, arr, dummyRS,
                0274      I                 irecord, myIter, myThid )
                0275       ELSE
                0276         CALL MDS_WRITE_FIELD(
                0277      I                 fName, filePrec, globalFile, .TRUE.,
                0278      I                 arrType, nNz, 1, nNz, dummyRL, arr,
                0279      I                 irecord, myIter, myThid )
                0280       ENDIF
                0281
5c50f93eee Jean*0282 #else /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0283       STOP 'ABNORMAL END: S/R MDSWRITEFIELD_LOC is empty'
5c50f93eee Jean*0284 #endif /* USE_OBSOLETE_MDS_RW_FIELD */
a6a4ee9dd2 Jean*0285
a3dbe60c1b Jean*0286       RETURN
                0287       END