pkg/mnc/mnc_readparms.F

780798f6bd Ed H*0001 #include "MNC_OPTIONS.h"
                0002
fd25642e39 Jean*0003 C--  File mnc_readparms.F
                0004 C--   Contents
                0005 C--   o MNC_READPARMS
                0006 C--   o MNC_SET_OUTDIR
                0007
780798f6bd Ed H*0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0009 CBOP 0
1b5fb69d21 Ed H*0010 C     !ROUTINE: MNC_READPARMS
780798f6bd Ed H*0011
1b5fb69d21 Ed H*0012 C     !INTERFACE:
780798f6bd Ed H*0013       SUBROUTINE MNC_READPARMS( myThid )
                0014
fd25642e39 Jean*0015 C     !DESCRIPTION:
e6bb5b2cc3 Ed H*0016 C     Read the MNC run-time parameters file.  IF the file does not
                0017 C     exist, MNC will assume that it is not needed (that is, some other
                0018 C     IO routines such as MDSIO will be used) and will not issue any
                0019 C     errors.
fd25642e39 Jean*0020
1b5fb69d21 Ed H*0021 C     !USES:
680bb8c7cd Jean*0022       IMPLICIT NONE
780798f6bd Ed H*0023 #include "SIZE.h"
07155994b8 Mart*0024 #include "MNC_COMMON.h"
780798f6bd Ed H*0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
a30418b6b9 Ed H*0027 #include "MNC_PARAMS.h"
780798f6bd Ed H*0028
1b5fb69d21 Ed H*0029 C     !INPUT PARAMETERS:
ae4c29e0db Jean*0030       INTEGER myThid
e6bb5b2cc3 Ed H*0031 CEOP
780798f6bd Ed H*0032
ae4c29e0db Jean*0033 C     !FUNCTIONS:
                0034       INTEGER ILNBLNK
                0035
1b5fb69d21 Ed H*0036 C     !LOCAL VARIABLES:
ae4c29e0db Jean*0037       INTEGER i, nl, ku
                0038       CHARACTER*(MAX_LEN_MBUF) data_file
                0039       CHARACTER*(MAX_LEN_MBUF) msgBuf
b7411f1a84 Jean*0040 C--   retired parameters:
                0041       LOGICAL timeave_mnc
ae4c29e0db Jean*0042
85c5caf7c2 Ed H*0043       NAMELIST /MNC_01/
a30418b6b9 Ed H*0044      &     mnc_use_indir, mnc_use_outdir, mnc_outdir_date,
0bd3fd8d5f Ed H*0045      &     mnc_outdir_num, mnc_use_name_ni0, mnc_echo_gvtypes,
a30418b6b9 Ed H*0046      &     pickup_write_mnc, pickup_read_mnc,
fd25642e39 Jean*0047      &     timeave_mnc, snapshot_mnc, monitor_mnc, autodiff_mnc,
d1e82389db Jean*0048      &     writegrid_mnc, readgrid_mnc,
e6cc87a596 Ed H*0049      &     mnc_outdir_str, mnc_indir_str, mnc_max_fsize,
5f4df5533c Ed H*0050      &     mnc_filefreq,
                0051      &     mnc_read_bathy, mnc_read_salt, mnc_read_theta
e6bb5b2cc3 Ed H*0052
ae4c29e0db Jean*0053 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0054
                0055       IF ( .NOT.useMNC ) THEN
                0056 C-    pkg MNC is not used
                0057         _BEGIN_MASTER(myThid)
                0058 C-    Track pkg activation status:
                0059 C     print a (weak) warning if data.mnc is found
                0060          CALL PACKAGES_UNUSED_MSG( 'useMNC', ' ', ' ' )
                0061         _END_MASTER(myThid)
                0062         RETURN
                0063       ENDIF
780798f6bd Ed H*0064
fd25642e39 Jean*0065 C-----
9d5f109346 Jean*0066 C     Need some work to make MNC multi-threaded safe.
3daafce20b Jean*0067 C     For now, switch it off (otherwise, it is hanging up somewhere)
9d5f109346 Jean*0068       IF ( nThreads.GT.1 ) THEN
eb27f69c85 Jean*0069         _BARRIER
9d5f109346 Jean*0070         _BEGIN_MASTER( myThid )
680bb8c7cd Jean*0071         WRITE(msgBuf,'(2A)') '** WARNING ** MNC_READPARMS: ',
9d5f109346 Jean*0072      &                       'useMNC unsafe with multi-threads'
                0073         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0074      &                      SQUEEZE_RIGHT , myThid )
680bb8c7cd Jean*0075         WRITE(msgBuf,'(2A)') '** WARNING ** MNC_READPARMS: ',
9d5f109346 Jean*0076      &                       'for now, switch useMNC to FALSE'
                0077         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0078      &                      SQUEEZE_RIGHT , myThid )
                0079         useMNC = .FALSE.
                0080         _END_MASTER( myThid )
fd25642e39 Jean*0081         _BARRIER
9d5f109346 Jean*0082         RETURN
                0083       ENDIF
                0084 C-----
                0085
1a7eca6776 Ed H*0086 C     Set default values for MNC run-time parameters
                0087       DO i = 1,MAX_LEN_FNAM
                0088         mnc_outdir_str(i:i) = ' '
                0089         mnc_indir_str(i:i)  = ' '
                0090       ENDDO
                0091       mnc_echo_gvtypes      =  .FALSE.
                0092       mnc_use_outdir        =  .FALSE.
                0093         mnc_outdir_str(1:4) =  'mnc_'
                0094         mnc_outdir_date     =  .FALSE.
41ce3f2380 Ed H*0095         mnc_outdir_num      =  .TRUE.
0bd3fd8d5f Ed H*0096       mnc_use_name_ni0      =  .FALSE.
48d40b8916 Jean*0097       pickup_write_mnc      =  .FALSE.
                0098       pickup_read_mnc       =  .FALSE.
1a7eca6776 Ed H*0099       mnc_use_indir         =  .FALSE.
                0100         mnc_indir_str(1:4)  =  '    '
4d852c90c8 Jean*0101       monitor_mnc           =  .TRUE.
                0102       timeave_mnc           =  .TRUE.
                0103       snapshot_mnc          =  .TRUE.
                0104       autodiff_mnc          =  .TRUE.
d1e82389db Jean*0105       writegrid_mnc         =  .TRUE.
ab11ba1276 Ed H*0106 C     2GB is 2147483648 bytes or approx: 2.1475e+09
                0107       mnc_max_fsize         =  2.1 _d 9
e808c5b132 Ed H*0108       readgrid_mnc          =  .FALSE.
5f4df5533c Ed H*0109
                0110 C     New parms for initial files
                0111       mnc_read_bathy        =  .FALSE.
                0112       mnc_read_salt         =  .FALSE.
                0113       mnc_read_theta        =  .FALSE.
1a7eca6776 Ed H*0114
e6cc87a596 Ed H*0115 C     Temporary hack for Baylor
                0116       mnc_filefreq          =  -1
                0117
85c5caf7c2 Ed H*0118 C     Set the file name
                0119       DO i=1,MAX_LEN_MBUF
                0120         data_file(i:i) = ' '
                0121       ENDDO
                0122       WRITE(data_file,'(a)') 'data.mnc'
                0123       nl = ILNBLNK(data_file)
                0124
7dbabac8cf Ed H*0125       WRITE(msgbuf,'(3a)') ' MNC_READPARMS: opening file ''',
85c5caf7c2 Ed H*0126      &       data_file(1:nl), ''''
7dbabac8cf Ed H*0127       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
ae4c29e0db Jean*0128      &     SQUEEZE_RIGHT,myThid)
85c5caf7c2 Ed H*0129
7dbabac8cf Ed H*0130       CALL OPEN_COPY_DATA_FILE(data_file(1:nl),'MNC_READPARMS',
                0131      &     ku, myThid )
                0132       READ(ku,NML=MNC_01)
7a77863887 Mart*0133 #ifdef SINGLE_DISK_IO
7dbabac8cf Ed H*0134       CLOSE(ku)
7a77863887 Mart*0135 #else
                0136       CLOSE(ku,STATUS='DELETE')
                0137 #endif /* SINGLE_DISK_IO */
fd25642e39 Jean*0138
85c5caf7c2 Ed H*0139       WRITE(msgBuf,'(a)') ' MNC_READPARMS: finished reading data.mnc'
7dbabac8cf Ed H*0140       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
ae4c29e0db Jean*0141      &     SQUEEZE_RIGHT,myThid)
780798f6bd Ed H*0142
b7411f1a84 Jean*0143 C--   Check for retired parameters:
                0144       IF ( .NOT.timeave_mnc ) THEN
                0145         WRITE(msgBuf,'(2A)') 'MNC_READPARMS: "timeave_mnc"',
                0146      &    ' is no longer allowed in file "data.mnc"'
                0147         CALL PRINT_ERROR( msgBuf, myThid )
                0148         WRITE(msgBuf,'(2A)') 'MNC_READPARMS: ',
                0149      &    ' since "pkg/timeave" has been removed.'
                0150         CALL PRINT_ERROR( msgBuf, myThid )
                0151 c       errCount = errCount + 1
                0152         STOP 'ABNORMAL END: S/R MNC_READPARMS'
                0153       ENDIF
                0154
ea44145497 Ed H*0155 C     Pickups must always be read in an EXCLUSIVE fashion
                0156       IF (pickup_read_mnc)  pickup_read_mdsio = .FALSE.
                0157
cdf6d093b9 Ed H*0158 C     IO handling is done in one of two senses:
ff63a227b0 Ed H*0159 C     (1) outputTypesInclusive=.TRUE. is an "inclusive-or" meaning that
7dbabac8cf Ed H*0160 C         one or more write methods can occur simultaneously or
ff63a227b0 Ed H*0161 C     (2) outputTypesInclusive=.FALSE. is an "exclusive-or" meaning that
7dbabac8cf Ed H*0162 C         only one write method can occur in a given run
fd25642e39 Jean*0163 C
ff63a227b0 Ed H*0164 C     Since all the *_mdsio flags default to .TRUE. and
                0165 C     outputTypesInclusive defaults to .FALSE., the logic here is
                0166 C     simple:
fd25642e39 Jean*0167       IF ( (.NOT. outputTypesInclusive)
cdf6d093b9 Ed H*0168      &     .AND. pickup_write_mnc ) pickup_write_mdsio = .FALSE.
fd25642e39 Jean*0169       IF ( (.NOT. outputTypesInclusive)
cdf6d093b9 Ed H*0170      &     .AND. snapshot_mnc ) snapshot_mdsio = .FALSE.
fd25642e39 Jean*0171       IF ( (.NOT. outputTypesInclusive)
cdf6d093b9 Ed H*0172      &     .AND. monitor_mnc ) monitor_stdio = .FALSE.
                0173
8731fc9ef5 Ed H*0174 C     Reads are always an exclusive relationship
                0175       IF (pickup_read_mnc) pickup_read_mdsio = .FALSE.
                0176
41ce3f2380 Ed H*0177 C     Create and/or set the MNC output directory
1a7eca6776 Ed H*0178       IF (mnc_use_outdir) THEN
41ce3f2380 Ed H*0179         IF ( mnc_outdir_num .OR. mnc_outdir_date ) THEN
                0180           CALL MNC_SET_OUTDIR(myThid)
                0181         ELSE
                0182           DO i = 1,MNC_MAX_CHAR
                0183             mnc_out_path(i:i) = ' '
                0184           ENDDO
fd25642e39 Jean*0185           write(mnc_out_path,'(2A)')
41ce3f2380 Ed H*0186      &         mnc_outdir_str(1:ILNBLNK(mnc_outdir_str)), '/'
                0187         ENDIF
1a7eca6776 Ed H*0188       ENDIF
cba009f524 Ed H*0189
680bb8c7cd Jean*0190 C--   print out some kee parameters :
                0191
                0192 C--   Check the parameters :
                0193       IF ( pickup_write_mnc .OR. pickup_read_mnc ) THEN
                0194         WRITE(msgBuf,'(2A)') '** WARNING ** MNC_READPARMS: ',
                0195      &   'incomplete MNC pickup files implementation'
                0196         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0197      &                      SQUEEZE_RIGHT, myThid )
                0198       ENDIF
                0199       IF ( pickup_write_mnc ) THEN
                0200         WRITE(msgBuf,'(2A)') '** WARNING ** MNC_READPARMS: ',
                0201      &   '=> pickup_write_mnc=T not recommanded'
                0202         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0203      &                      SQUEEZE_RIGHT, myThid )
                0204       ENDIF
                0205       IF ( pickup_read_mnc ) THEN
                0206         WRITE(msgBuf,'(2A)') '** WARNING ** MNC_READPARMS: ',
                0207      &   '=> pickup_read_mnc=T not working for some set-up'
                0208         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0209      &                      SQUEEZE_RIGHT, myThid )
                0210       ENDIF
                0211
cba009f524 Ed H*0212       RETURN
                0213       END
                0214
                0215 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0216 CBOP 1
1b5fb69d21 Ed H*0217 C     !ROUTINE: MNC_SET_OUTDIR
cba009f524 Ed H*0218
1b5fb69d21 Ed H*0219 C     !INTERFACE:
cba009f524 Ed H*0220       SUBROUTINE MNC_SET_OUTDIR( myThid )
                0221
1b5fb69d21 Ed H*0222 C     !DESCRIPTION:
e6bb5b2cc3 Ed H*0223 C     Create the output (sub--)directory for the MNC output files.
fd25642e39 Jean*0224
1b5fb69d21 Ed H*0225 C     !USES:
b7411f1a84 Jean*0226       IMPLICIT NONE
07155994b8 Mart*0227 #include "MNC_COMMON.h"
1a7eca6776 Ed H*0228 #include "SIZE.h"
cba009f524 Ed H*0229 #include "EEPARAMS.h"
                0230 #include "PARAMS.h"
a30418b6b9 Ed H*0231 #include "MNC_PARAMS.h"
cba009f524 Ed H*0232
1b5fb69d21 Ed H*0233 C     !INPUT PARAMETERS:
cba009f524 Ed H*0234       integer myThid
e6bb5b2cc3 Ed H*0235 CEOP
cba009f524 Ed H*0236
1b5fb69d21 Ed H*0237 C     !LOCAL VARIABLES:
1a7eca6776 Ed H*0238       integer i,j,k, ntot, npathd, idate
b7411f1a84 Jean*0239       CHARACTER*(MNC_MAX_PATH) pathd
                0240       CHARACTER*(100) cenc
9705a0d5c6 Ed H*0241       integer ienc(MNC_MAX_PATH)
1a7eca6776 Ed H*0242       integer ncenc
e6bb5b2cc3 Ed H*0243
1b5fb69d21 Ed H*0244 C     Functions
                0245       integer ILNBLNK
1a7eca6776 Ed H*0246
                0247       cenc(1:26)  = 'abcdefghijklmnopqrstuvwxyz'
                0248       cenc(27:52) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
                0249       cenc(53:70) = '0123456789_.,+-=/~'
                0250       ncenc = 70
                0251       npathd = 100
                0252       IF (mnc_outdir_date) THEN
                0253         idate = 1
                0254       ELSE
                0255         idate = 0
                0256       ENDIF
9705a0d5c6 Ed H*0257       DO i = 1,MNC_MAX_PATH
1a7eca6776 Ed H*0258         pathd(i:i) = ' '
                0259       ENDDO
                0260       k = ILNBLNK(mnc_outdir_str)
9705a0d5c6 Ed H*0261       IF (k .GT. MNC_MAX_PATH)  k = MNC_MAX_PATH
1a7eca6776 Ed H*0262       pathd(1:k) = mnc_outdir_str(1:k)
                0263       ntot = 0
                0264       DO i = 1,k
                0265         DO j = 1,ncenc
                0266           IF (pathd(i:i) .EQ. cenc(j:j)) THEN
                0267             ntot = ntot + 1
                0268             ienc(ntot) = j
                0269             GOTO 20
                0270           ENDIF
                0271         ENDDO
                0272  20     CONTINUE
                0273       ENDDO
cba009f524 Ed H*0274
1a7eca6776 Ed H*0275       CALL mnccdir(ntot, ienc, idate)
cba009f524 Ed H*0276
9705a0d5c6 Ed H*0277       DO i = 1,MNC_MAX_PATH
cba009f524 Ed H*0278         mnc_out_path(i:i) = ' '
                0279       ENDDO
1a7eca6776 Ed H*0280       IF (ntot .GT. 0) THEN
9705a0d5c6 Ed H*0281         IF (ntot .GT. (MNC_MAX_PATH-40)) THEN
                0282           ntot = MNC_MAX_PATH - 40
1a7eca6776 Ed H*0283         ENDIF
                0284         DO i = 1,ntot
                0285           j = ienc(i)
                0286           mnc_out_path(i:i) = cenc(j:j)
                0287         ENDDO
                0288         mnc_out_path((ntot+1):(ntot+1)) = '/'
                0289       ENDIF
                0290
780798f6bd Ed H*0291       RETURN
                0292       END