C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_readparms.F,v 1.14 2017/11/15 23:34:31 jmc Exp $
C $Name: $
#include "RBCS_OPTIONS.h"
CBOP
C !ROUTINE: RBCS_READPARMS
C !INTERFACE: ==========================================================
SUBROUTINE RBCS_READPARMS( myThid )
C !DESCRIPTION:
C Initialize RBCS parameters, read in data.rbcs
C !USES: ===============================================================
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#ifdef ALLOW_PTRACERS
#include "PTRACERS_SIZE.h"
#endif
#include "RBCS_SIZE.h"
#include "RBCS_PARAMS.h"
C !INPUT PARAMETERS: ===================================================
C myThid :: my thread Id. number
INTEGER myThid
C !OUTPUT PARAMETERS: ==================================================
C none
#ifdef ALLOW_RBCS
C === Local variables ===
C msgBuf :: Informational/error message buffer
C iUnit :: Work variable for IO unit number
C iTracer :: passive tracer index
C relaxMaskFile :: local mask-file name to read from namelist
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER iUnit
INTEGER irbc, errCount
INTEGER locSize
#ifdef ALLOW_PTRACERS
INTEGER iTracer
PARAMETER( locSize = 10+PTRACERS_num )
#else
PARAMETER( locSize = 4 )
#endif
CHARACTER*(MAX_LEN_FNAM) relaxMaskFile(locSize)
C-- useRBCptracers is no longer used
LOGICAL useRBCptracers
INTEGER rbcsIniter
CEOP
C-- RBCS parameters:
NAMELIST //RBCS_PARM01
& tauRelaxU,
& tauRelaxV,
& tauRelaxT,
& tauRelaxS,
& relaxMaskUFile,
& relaxMaskVFile,
& relaxMaskFile,
& relaxUFile,
& relaxVFile,
& relaxTFile,
& relaxSFile,
& useRBCuVel,
& useRBCvVel,
& useRBCtemp,
& useRBCsalt,
& useRBCptracers,
& rbcsIniter,
& rbcsForcingPeriod,
& rbcsForcingCycle,
& rbcsForcingOffset,
& rbcsVanishingTime,
& rbcsSingleTimeFiles,
& deltaTrbcs,
& rbcsIter0
#ifdef ALLOW_PTRACERS
NAMELIST //RBCS_PARM02
& useRBCpTrNum, tauRelaxPTR,
& relaxPtracerFile
#endif
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( .NOT.useRBCS ) THEN
C- pkg RBCS is not used
_BEGIN_MASTER(myThid)
C- Track pkg activation status:
C print a (weak) warning if data.rbcs is found
CALL PACKAGES_UNUSED_MSG( 'useRBCS', ' ', ' ' )
_END_MASTER(myThid)
RETURN
ENDIF
_BEGIN_MASTER(myThid)
C-- Default values
useRBCuVel =.FALSE.
useRBCvVel =.FALSE.
useRBCtemp =.FALSE.
useRBCsalt =.FALSE.
tauRelaxU = 0.
tauRelaxV = 0.
tauRelaxT = 0.
tauRelaxS = 0.
relaxMaskUFile = ' '
relaxMaskVFile = ' '
DO irbc=1,locSize
relaxMaskFile(irbc) = ' '
ENDDO
relaxUFile = ' '
relaxVFile = ' '
relaxTFile = ' '
relaxSFile = ' '
rbcsIniter = 0
rbcsForcingPeriod = 0. _d 0
rbcsForcingCycle = 0. _d 0
rbcsForcingOffset = 0. _d 0
rbcsVanishingTime = 0. _d 0
rbcsSingleTimeFiles = .FALSE.
deltaTrbcs = deltaTclock
rbcsIter0 = 0
#ifdef ALLOW_PTRACERS
DO iTracer=1,PTRACERS_num
useRBCpTrNum(iTracer)=.FALSE.
tauRelaxPTR(iTracer) = 0.
relaxPtracerFile(iTracer) = ' '
ENDDO
#endif
useRBCptracers=.FALSE.
C-- Open and read the data.rbcs file
WRITE(msgBuf,'(A)') ' RBCS_READPARMS: opening data.rbcs'
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , 1)
CALL OPEN_COPY_DATA_FILE(
I 'data.rbcs', 'RBCS_READPARMS',
O iUnit,
I myThid )
READ(UNIT=iUnit,NML=RBCS_PARM01)
#ifdef ALLOW_PTRACERS
READ(UNIT=iUnit,NML=RBCS_PARM02)
#endif
WRITE(msgBuf,'(A)')
& ' RBCS_READPARMS: finished reading data.rbcs'
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , 1)
C-- Close the open data file
#ifdef SINGLE_DISK_IO
CLOSE(iUnit)
#else
CLOSE(iUnit,STATUS='DELETE')
#endif /* SINGLE_DISK_IO */
C- save local mask-file name into relaxMaskTrFile (stored in common block)
DO irbc=1,maskLEN
relaxMaskTrFile(irbc) = ' '
ENDDO
errCount = 0
DO irbc=1,locSize
IF ( irbc.LE.maskLEN ) THEN
relaxMaskTrFile(irbc) = relaxMaskFile(irbc)
ELSEIF ( relaxMaskFile(irbc).NE.' ' ) THEN
errCount = errCount + 1
ENDIF
ENDDO
IF ( errCount.GT.0 ) THEN
WRITE(msgBuf,'(2A,I6)')' RBCS_READPARAMS: ',
& 'Too many "relaxMaskFile" are set ! exceeds maskLEN=', maskLEN
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A)')' RBCS_READPARAMS: ',
& '==> Increase maskLEN (in RBCS_SIZE.h) and recompile'
CALL PRINT_ERROR( msgBuf, myThid )
ENDIF
C--- Check RBCS config and params:
#ifdef DISABLE_RBCS_MOM
IF ( useRBCuVel .OR. useRBCvVel ) THEN
WRITE(msgBuf,'(2A,2(L2,A))') 'RBCS_READPARMS: ',
& 'cannot use RBC for U,V (useRBCuVel=',useRBCuVel,
& ', useRBCvVel=',useRBCvVel,')'
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
& 'when DISABLE_RBCS_MOM is defined (in RBCS_OPTIONS.h)'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARMS'
ENDIF
#endif /* DISABLE_RBCS_MOM */
IF (rbcsIniter.NE.0) THEN
WRITE(msgBuf,'(2A)')' RBCS_READPARAMS: ',
& 'rbcsIniter has been replaced by rbcsForcingOffset '
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A)')' RBCS_READPARAMS: ',
& 'which is in seconds. Please change your data.rbcs'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARAMS'
ENDIF
IF (startTime.LT.rbcsForcingOffset+0.5*rbcsForcingPeriod .AND.
& .NOT. rbcsSingleTimeFiles) THEN
IF (rbcsForcingCycle.GT.0) THEN
WRITE(msgBuf,'(2A)')' RBCS_READPARAMS: ',
& 'startTime before rbcsForcingOffset+0.5*rbcsForcingPeriod '
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A)')' RBCS_READPARAMS: ',
& 'will use last record'
CALL PRINT_ERROR( msgBuf, myThid )
ELSE
WRITE(msgBuf,'(2A)')' RBCS_READPARAMS: ',
& 'startTime before rbcsForcingOffset+0.5*rbcsForcingPeriod '
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A)')' RBCS_READPARAMS: ',
& 'not allowed with rbcsForcingCycle=0 unless rbcsSingleTimeFiles'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARAMS'
ENDIF
ENDIF
IF ( useRBCuVel .AND. tauRelaxU.LE.0. ) THEN
WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
& 'tauRelaxU cannot be zero with useRBCuVel'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARMS'
ENDIF
IF ( useRBCvVel .AND. tauRelaxV.LE.0. ) THEN
WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
& 'tauRelaxV cannot be zero with useRBCvVel'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARMS'
ENDIF
IF ( useRBCtemp .AND. tauRelaxT.LE.0. ) THEN
WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
& 'tauRelaxT cannot be zero with useRBCtemp'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARMS'
ENDIF
IF ( useRBCsalt .AND. tauRelaxS.LE.0. ) THEN
WRITE(msgBuf,'(2A)') 'RBCS_READPARMS: ',
& 'tauRelaxS cannot be zero with useRBCsalt'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARMS'
ENDIF
#ifdef ALLOW_PTRACERS
DO iTracer=1,PTRACERS_num
IF ( useRBCpTrNum(iTracer) ) THEN
IF ( .NOT.usePTRACERS ) THEN
WRITE(msgBuf,'(2A,I6,A)') 'RBCS_READPARMS: ',
& 'usePTRACERS=F => cannot use RBCS for tracer:', iTracer
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARMS'
ENDIF
c IF ( iTracer.GT.PTRACERS_numInUse ) THEN
c STOP 'ABNORMAL END: S/R RBCS_READPARMS'
c ENDIF
IF ( tauRelaxPTR(iTracer).LE.0. ) THEN
WRITE(msgBuf,'(2A,I6,A)') 'RBCS_READPARMS: ',
& 'tauRelaxPTR(itr=', iTracer, ' ) = 0. is'
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A,I6,A)') 'RBCS_READPARMS: ',
& 'not allowed with useRBCptr(itr)=T'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R RBCS_READPARMS'
ENDIF
ENDIF
ENDDO
#endif
_END_MASTER(myThid)
C Everyone else must wait for the parameters to be loaded
_BARRIER
#endif /* ALLOW_RBCS */
RETURN
END