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