pkg/rbcs/rbcs_readparms.F

c3afacc940 Jean*0001 #include "RBCS_OPTIONS.h"
5a13c92ce6 Step*0002
                0003 CBOP
                0004 C !ROUTINE: RBCS_READPARMS
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE RBCS_READPARMS( myThid )
                0008
                0009 C !DESCRIPTION:
                0010 C     Initialize RBCS parameters, read in data.rbcs
                0011
                0012 C !USES: ===============================================================
                0013       IMPLICIT NONE
                0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
                0016 #include "PARAMS.h"
                0017 #ifdef ALLOW_PTRACERS
                0018 #include "PTRACERS_SIZE.h"
                0019 #endif
a16c4403c6 Jean*0020 #include "RBCS_SIZE.h"
                0021 #include "RBCS_PARAMS.h"
5a13c92ce6 Step*0022
                0023 C !INPUT PARAMETERS: ===================================================
a16c4403c6 Jean*0024 C  myThid         :: my thread Id. number
5a13c92ce6 Step*0025       INTEGER myThid
                0026
                0027 C !OUTPUT PARAMETERS: ==================================================
                0028 C  none
                0029
                0030 #ifdef ALLOW_RBCS
                0031
                0032 C     === Local variables ===
c3afacc940 Jean*0033 C     msgBuf      :: Informational/error message buffer
                0034 C     iUnit       :: Work variable for IO unit number
5e2b20d683 Jean*0035 C     iTracer     :: passive tracer index
                0036 C     relaxMaskFile :: local mask-file name to read from namelist
5a13c92ce6 Step*0037       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0038       INTEGER iUnit
5e2b20d683 Jean*0039       INTEGER irbc, errCount
                0040       INTEGER locSize
c3afacc940 Jean*0041 #ifdef ALLOW_PTRACERS
                0042       INTEGER iTracer
5e2b20d683 Jean*0043       PARAMETER( locSize = 10+PTRACERS_num )
                0044 #else
                0045       PARAMETER( locSize = 4 )
c3afacc940 Jean*0046 #endif
5e2b20d683 Jean*0047       CHARACTER*(MAX_LEN_FNAM) relaxMaskFile(locSize)
c3afacc940 Jean*0048 C--   useRBCptracers is no longer used
                0049       LOGICAL useRBCptracers
27afb9cdd5 Jean*0050       INTEGER rbcsIniter
5a13c92ce6 Step*0051 CEOP
                0052
a16c4403c6 Jean*0053 C--   RBCS parameters:
5a13c92ce6 Step*0054       NAMELIST /RBCS_PARM01/
a16c4403c6 Jean*0055      &          tauRelaxU,
                0056      &          tauRelaxV,
1830fa7b80 Step*0057      &          tauRelaxT,
                0058      &          tauRelaxS,
a16c4403c6 Jean*0059      &          relaxMaskUFile,
                0060      &          relaxMaskVFile,
1830fa7b80 Step*0061      &          relaxMaskFile,
5d32982e3e Jean*0062      &          relaxUFile,
                0063      &          relaxVFile,
5a13c92ce6 Step*0064      &          relaxTFile,
                0065      &          relaxSFile,
a16c4403c6 Jean*0066      &          useRBCuVel,
                0067      &          useRBCvVel,
5a13c92ce6 Step*0068      &          useRBCtemp,
                0069      &          useRBCsalt,
                0070      &          useRBCptracers,
                0071      &          rbcsIniter,
                0072      &          rbcsForcingPeriod,
fb7cd45a1a Oliv*0073      &          rbcsForcingCycle,
                0074      &          rbcsForcingOffset,
880a0c1fb9 Gael*0075      &          rbcsVanishingTime,
fb7cd45a1a Oliv*0076      &          rbcsSingleTimeFiles,
                0077      &          deltaTrbcs,
                0078      &          rbcsIter0
5a13c92ce6 Step*0079
                0080 #ifdef ALLOW_PTRACERS
                0081       NAMELIST /RBCS_PARM02/
27afb9cdd5 Jean*0082      &          useRBCpTrNum, tauRelaxPTR,
5a13c92ce6 Step*0083      &          relaxPtracerFile
                0084 #endif
                0085
c3afacc940 Jean*0086 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0087
ae4c29e0db Jean*0088       IF ( .NOT.useRBCS ) THEN
                0089 C-    pkg RBCS is not used
                0090         _BEGIN_MASTER(myThid)
                0091 C-    Track pkg activation status:
                0092 C     print a (weak) warning if data.rbcs is found
                0093          CALL PACKAGES_UNUSED_MSG( 'useRBCS', ' ', ' ' )
                0094         _END_MASTER(myThid)
                0095         RETURN
                0096       ENDIF
                0097
c3afacc940 Jean*0098       _BEGIN_MASTER(myThid)
                0099
5a13c92ce6 Step*0100 C--   Default values
a16c4403c6 Jean*0101       useRBCuVel =.FALSE.
                0102       useRBCvVel =.FALSE.
c3afacc940 Jean*0103       useRBCtemp =.FALSE.
                0104       useRBCsalt =.FALSE.
a16c4403c6 Jean*0105       tauRelaxU = 0.
                0106       tauRelaxV = 0.
c3afacc940 Jean*0107       tauRelaxT = 0.
                0108       tauRelaxS = 0.
a16c4403c6 Jean*0109       relaxMaskUFile = ' '
                0110       relaxMaskVFile = ' '
5e2b20d683 Jean*0111       DO irbc=1,locSize
1830fa7b80 Step*0112         relaxMaskFile(irbc) = ' '
c3afacc940 Jean*0113       ENDDO
a16c4403c6 Jean*0114       relaxUFile = ' '
                0115       relaxVFile = ' '
5a13c92ce6 Step*0116       relaxTFile = ' '
                0117       relaxSFile = ' '
fb7cd45a1a Oliv*0118       rbcsIniter = 0
c3afacc940 Jean*0119       rbcsForcingPeriod = 0. _d 0
                0120       rbcsForcingCycle  = 0. _d 0
fb7cd45a1a Oliv*0121       rbcsForcingOffset = 0. _d 0
880a0c1fb9 Gael*0122       rbcsVanishingTime = 0. _d 0
fb7cd45a1a Oliv*0123       rbcsSingleTimeFiles = .FALSE.
09518061fc Jean*0124       deltaTrbcs = deltaTClock
fb7cd45a1a Oliv*0125       rbcsIter0 = 0
5a13c92ce6 Step*0126 #ifdef ALLOW_PTRACERS
                0127       DO iTracer=1,PTRACERS_num
27afb9cdd5 Jean*0128         useRBCpTrNum(iTracer)=.FALSE.
c3afacc940 Jean*0129         tauRelaxPTR(iTracer) = 0.
                0130         relaxPtracerFile(iTracer) = ' '
5a13c92ce6 Step*0131       ENDDO
                0132 #endif
c3afacc940 Jean*0133       useRBCptracers=.FALSE.
5a13c92ce6 Step*0134
a16c4403c6 Jean*0135 C--   Open and read the data.rbcs file
c3afacc940 Jean*0136
5a13c92ce6 Step*0137       WRITE(msgBuf,'(A)') ' RBCS_READPARMS: opening data.rbcs'
                0138       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0139      &                   SQUEEZE_RIGHT , 1)
                0140       CALL OPEN_COPY_DATA_FILE(
a70bcb5316 Dimi*0141      I                   'data.rbcs', 'RBCS_READPARMS',
5a13c92ce6 Step*0142      O                   iUnit,
                0143      I                   myThid )
                0144       READ(UNIT=iUnit,NML=RBCS_PARM01)
                0145 #ifdef ALLOW_PTRACERS
                0146       READ(UNIT=iUnit,NML=RBCS_PARM02)
                0147 #endif
                0148       WRITE(msgBuf,'(A)')
                0149      &  ' RBCS_READPARMS: finished reading data.rbcs'
                0150       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0151      &                   SQUEEZE_RIGHT , 1)
                0152
a16c4403c6 Jean*0153 C--   Close the open data file
7a77863887 Mart*0154 #ifdef SINGLE_DISK_IO
5a13c92ce6 Step*0155       CLOSE(iUnit)
7a77863887 Mart*0156 #else
                0157       CLOSE(iUnit,STATUS='DELETE')
                0158 #endif /* SINGLE_DISK_IO */
5a13c92ce6 Step*0159
5e2b20d683 Jean*0160 C-    save local mask-file name into relaxMaskTrFile (stored in common block)
                0161       DO irbc=1,maskLEN
                0162         relaxMaskTrFile(irbc) = ' '
                0163       ENDDO
                0164       errCount = 0
                0165       DO irbc=1,locSize
                0166         IF ( irbc.LE.maskLEN ) THEN
                0167           relaxMaskTrFile(irbc) = relaxMaskFile(irbc)
                0168         ELSEIF ( relaxMaskFile(irbc).NE.' ' ) THEN
                0169           errCount = errCount + 1
                0170         ENDIF
                0171       ENDDO
                0172       IF ( errCount.GT.0 ) THEN
09518061fc Jean*0173         WRITE(msgBuf,'(2A,I6)') 'RBCS_READPARMS: ',
5e2b20d683 Jean*0174      &   'Too many "relaxMaskFile" are set ! exceeds maskLEN=', maskLEN
                0175         CALL PRINT_ERROR( msgBuf, myThid )
09518061fc Jean*0176         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
5e2b20d683 Jean*0177      &   '==> Increase maskLEN (in RBCS_SIZE.h) and recompile'
                0178         CALL PRINT_ERROR( msgBuf, myThid )
                0179       ENDIF
                0180
a16c4403c6 Jean*0181 C---  Check RBCS config and params:
                0182 #ifdef DISABLE_RBCS_MOM
                0183       IF ( useRBCuVel .OR. useRBCvVel ) THEN
                0184         WRITE(msgBuf,'(2A,2(L2,A))') 'RBCS_READPARMS: ',
                0185      &    'cannot use RBC for U,V (useRBCuVel=',useRBCuVel,
                0186      &    ', useRBCvVel=',useRBCvVel,')'
                0187         CALL PRINT_ERROR( msgBuf, myThid )
                0188         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
                0189      &    'when DISABLE_RBCS_MOM is defined (in RBCS_OPTIONS.h)'
                0190         CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0191         errCount = errCount + 1
a16c4403c6 Jean*0192       ENDIF
                0193 #endif /* DISABLE_RBCS_MOM */
fb7cd45a1a Oliv*0194       IF (rbcsIniter.NE.0) THEN
09518061fc Jean*0195         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
fb7cd45a1a Oliv*0196      &  'rbcsIniter has been replaced by rbcsForcingOffset '
                0197         CALL PRINT_ERROR( msgBuf, myThid )
09518061fc Jean*0198         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
fb7cd45a1a Oliv*0199      &  'which is in seconds. Please change your data.rbcs'
                0200         CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0201         errCount = errCount + 1
                0202       ELSEIF (startTime.LT.rbcsForcingOffset+0.5*rbcsForcingPeriod .AND.
fb7cd45a1a Oliv*0203      &    .NOT. rbcsSingleTimeFiles) THEN
c9ed4ade90 Oliv*0204        IF (rbcsForcingCycle.GT.0.) THEN
09518061fc Jean*0205         WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_READPARMS: ',
fb7cd45a1a Oliv*0206      &  'startTime before rbcsForcingOffset+0.5*rbcsForcingPeriod '
0831626309 Oliv*0207         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0208      &                      SQUEEZE_RIGHT, myThid )
09518061fc Jean*0209         WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_READPARMS: ',
fb7cd45a1a Oliv*0210      &  'will use last record'
0831626309 Oliv*0211         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0212      &                      SQUEEZE_RIGHT, myThid )
fb7cd45a1a Oliv*0213        ELSE
09518061fc Jean*0214         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
fb7cd45a1a Oliv*0215      &  'startTime before rbcsForcingOffset+0.5*rbcsForcingPeriod '
                0216         CALL PRINT_ERROR( msgBuf, myThid )
09518061fc Jean*0217         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
fb7cd45a1a Oliv*0218      &  'not allowed with rbcsForcingCycle=0 unless rbcsSingleTimeFiles'
                0219         CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0220         errCount = errCount + 1
fb7cd45a1a Oliv*0221        ENDIF
                0222       ENDIF
a16c4403c6 Jean*0223       IF ( useRBCuVel .AND. tauRelaxU.LE.0. ) THEN
                0224         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
                0225      &    'tauRelaxU cannot be zero with useRBCuVel'
                0226         CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0227         errCount = errCount + 1
a16c4403c6 Jean*0228       ENDIF
                0229       IF ( useRBCvVel .AND. tauRelaxV.LE.0. ) THEN
                0230         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
                0231      &    'tauRelaxV cannot be zero with useRBCvVel'
                0232         CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0233         errCount = errCount + 1
a16c4403c6 Jean*0234       ENDIF
c3afacc940 Jean*0235       IF ( useRBCtemp .AND. tauRelaxT.LE.0. ) THEN
                0236         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
                0237      &    'tauRelaxT cannot be zero with useRBCtemp'
                0238         CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0239         errCount = errCount + 1
c3afacc940 Jean*0240       ENDIF
                0241       IF ( useRBCsalt .AND. tauRelaxS.LE.0. ) THEN
                0242         WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
                0243      &    'tauRelaxS cannot be zero with useRBCsalt'
                0244         CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0245         errCount = errCount + 1
c3afacc940 Jean*0246       ENDIF
                0247 #ifdef ALLOW_PTRACERS
                0248       DO iTracer=1,PTRACERS_num
27afb9cdd5 Jean*0249        IF ( useRBCpTrNum(iTracer) ) THEN
c3afacc940 Jean*0250         IF ( .NOT.usePTRACERS ) THEN
                0251          WRITE(msgBuf,'(2A,I6,A)') 'RBCS_READPARMS: ',
                0252      &   'usePTRACERS=F => cannot use RBCS for tracer:', iTracer
                0253          CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0254          errCount = errCount + 1
c3afacc940 Jean*0255         ENDIF
                0256 c       IF ( iTracer.GT.PTRACERS_numInUse ) THEN
                0257 c        STOP 'ABNORMAL END: S/R RBCS_READPARMS'
                0258 c       ENDIF
                0259         IF ( tauRelaxPTR(iTracer).LE.0. ) THEN
                0260          WRITE(msgBuf,'(2A,I6,A)') 'RBCS_READPARMS: ',
                0261      &     'tauRelaxPTR(itr=', iTracer, ' ) = 0. is'
                0262          CALL PRINT_ERROR( msgBuf, myThid )
                0263          WRITE(msgBuf,'(2A,I6,A)') 'RBCS_READPARMS: ',
                0264      &     'not allowed with useRBCptr(itr)=T'
                0265          CALL PRINT_ERROR( msgBuf, myThid )
c9ed4ade90 Oliv*0266          errCount = errCount + 1
c3afacc940 Jean*0267         ENDIF
                0268        ENDIF
                0269       ENDDO
                0270 #endif
c9ed4ade90 Oliv*0271       IF ( errCount.GT.0 ) THEN
09518061fc Jean*0272        WRITE(msgBuf,'(A,I3,A)')
                0273      &       'RBCS_READPARMS: detected', errCount,' fatal error(s)'
                0274        CALL PRINT_ERROR( msgBuf, myThid )
                0275        CALL ALL_PROC_DIE( 0 )
c9ed4ade90 Oliv*0276        STOP 'ABNORMAL END: S/R RBCS_READPARMS'
                0277       ENDIF
5a13c92ce6 Step*0278       _END_MASTER(myThid)
                0279
                0280 C Everyone else must wait for the parameters to be loaded
                0281       _BARRIER
                0282
                0283 #endif /* ALLOW_RBCS */
                0284
                0285       RETURN
                0286       END