C $Header: /u/gcmpack/MITgcm/pkg/layers/layers_readparms.F,v 1.11 2017/08/09 15:23:37 mlosch Exp $
C $Name: $
#include "LAYERS_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
SUBROUTINE LAYERS_READPARMS( myThid )
C Read LAYERS parameters from data file.
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "LAYERS_SIZE.h"
#include "LAYERS.h"
C INPUT PARAMETERS:
INTEGER myThid
#ifdef ALLOW_LAYERS
C === Local variables ===
C msgBuf :: Informational/error message buffer
C iUnit :: Work variable for IO unit number
C k :: index
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER iUnit, k, iLa
INTEGER errCount
C-- old pkg/layers parameter setting (only single tracer layers diagnostics):
C layers_G :: boundaries of tracer layers
INTEGER LAYER_nb, layers_kref
LOGICAL useBOLUS
_RL layers_G(Nlayers+1)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
NAMELIST //LAYERS_PARM01
& layers_G, layers_taveFreq, layers_diagFreq,
& LAYER_nb, layers_kref, useBOLUS, layers_bolus,
& layers_name, layers_bounds, layers_krho
IF ( .NOT.useLayers ) THEN
C- pkg LAYERS is not used
_BEGIN_MASTER(myThid)
C- Track pkg activation status:
C print a (weak) warning if data.layers is found
CALL PACKAGES_UNUSED_MSG( 'useLayers', ' ', ' ' )
_END_MASTER(myThid)
RETURN
ENDIF
_BEGIN_MASTER(myThid)
errCount = 0
C-- Default values for LAYERS
layers_taveFreq = taveFreq
layers_diagFreq = dumpFreq
C The MNC stuff is not working yet
layers_MNC = .FALSE.
layers_MDSIO = .TRUE.
DO iLa=1,layers_maxNum
layers_name(iLa) = ' '
layers_krho(iLa)= 1
layers_bolus(iLa) = useGMRedi
DO k=1,Nlayers+1
layers_bounds(k,iLa) = UNSET_RL
ENDDO
ENDDO
C-- old params default:
LAYER_nb = 0
layers_kref = 1
useBOLUS = useGMRedi
DO k=1,Nlayers+1
layers_G(k) = UNSET_RL
ENDDO
WRITE(msgBuf,'(A)') 'LAYERS_READPARMS: opening data.layers'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , 1)
CALL OPEN_COPY_DATA_FILE(
I 'data.layers', 'LAYERS_READPARMS',
O iUnit,
I myThid )
C Read parameters from open data file
READ(UNIT=iUnit,NML=LAYERS_PARM01)
WRITE(msgBuf,'(A)')
& 'LAYERS_READPARMS: finished reading data.layers'
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-- Process old params setting (single averaging tracer)
IF ( LAYER_nb.LT.0 .OR. LAYER_nb.GT.3 ) THEN
WRITE(msgBuf,'(2A,I2,A,I9)') 'LAYERS_READPARMS: ',
& 'Invalid LAYER_nb=', LAYER_nb
CALL PRINT_ERROR( msgBuf, myThid )
errCount = errCount + 1
ENDIF
IF ( LAYER_nb.EQ.0 ) THEN
IF ( layers_kref.NE.1 ) errCount = errCount + 1
DO k=1,Nlayers+1
IF ( layers_G(k).NE.UNSET_RL ) errCount = errCount + 1
ENDDO
ELSE
DO iLa=1,layers_maxNum
IF ( layers_name(iLa).NE.' ' ) errCount = errCount + 1
IF ( layers_krho(iLa).NE.1 ) errCount = errCount + 1
DO k=1,Nlayers+1
IF ( layers_bounds(k,iLa).NE.UNSET_RL ) errCount = errCount+1
ENDDO
ENDDO
C- Transfert to new params setting:
IF ( LAYER_nb.EQ.1 ) layers_name(1) = 'TH '
IF ( LAYER_nb.EQ.2 ) layers_name(1) = 'SLT'
IF ( LAYER_nb.EQ.3 ) layers_name(1) = 'RHO'
layers_krho(1) = layers_kref
layers_bolus(1) = useBOLUS
DO k=1,Nlayers+1
layers_bounds(k,1) = layers_G(k)
ENDDO
ENDIF
IF ( errCount.GE.1 ) THEN
WRITE(msgBuf,'(2A)') 'LAYERS_READPARMS: ',
& 'Cannot mix old params setting (LAYER_nb > 0)'
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A)') 'LAYERS_READPARMS: ',
& ' with new params setting (layer_name(#)= ...)'
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(2A,I4,A)') 'LAYERS_READPARMS: ',
& 'Detected', errCount,' fatal error/conflict(s)'
CALL PRINT_ERROR( msgBuf, myThid )
CALL ALL_PROC_DIE( 0 )
STOP 'ABNORMAL END: S/R LAYERS_READPARMS'
ENDIF
C-- Set layers_num according to layers_name:
DO iLa=1,layers_maxNum
layers_num(iLa) = 0
IF ( layers_name(iLa).EQ.'TH ' ) layers_num(iLa) = 1
IF ( layers_name(iLa).EQ.'SLT' ) layers_num(iLa) = 2
IF ( layers_name(iLa).EQ.'RHO' ) layers_num(iLa) = 3
IF ( layers_name(iLa).NE.' ' .AND.
& layers_num(iLa).EQ.0 ) THEN
WRITE(msgBuf,'(2A,I2,3A)') 'LAYERS_READPARMS: ',
& 'invalid layers_name(',iLa,')= "',layers_name(iLa),'"'
CALL PRINT_ERROR( msgBuf, myThid )
errCount = errCount + 1
ENDIF
C-- bolus contribution only available if using GMRedi
layers_bolus(iLa) = layers_bolus(iLa) .AND. useGMRedi
ENDDO
C-- Make sure the layers_bounds we just read is big enough
DO iLa=1,layers_maxNum
IF ( layers_num(iLa).NE.0 ) THEN
DO k=1,Nlayers+1
IF ( layers_bounds(k,iLa).EQ.UNSET_RL ) THEN
WRITE(msgBuf,'(2A,I4,A,I3,A)') 'LAYERS_READPARMS: ',
& 'No value for layers_bounds(k=',k,', iLa=', iLa, ')'
CALL PRINT_ERROR( msgBuf, myThid )
errCount = errCount + 1
ENDIF
ENDDO
ENDIF
ENDDO
C-- Make sure that we locally honor the global MNC on/off flag
layers_MNC = layers_MNC .AND. useMNC
#ifndef ALLOW_MNC
C Fix to avoid running without getting any output:
layers_MNC = .FALSE.
#endif
layers_MDSIO = (.NOT. layers_MNC) .OR. outputTypesInclusive
IF ( errCount.GE.1 ) THEN
WRITE(msgBuf,'(A,I3,A)')
& 'LAYERS_READPARMS: detected', errCount,' fatal error(s)'
CALL PRINT_ERROR( msgBuf, myThid )
CALL ALL_PROC_DIE( 0 )
STOP 'ABNORMAL END: S/R LAYERS_READPARMS'
ENDIF
_END_MASTER(myThid)
C-- Everyone else must wait for the parameters to be loaded
_BARRIER
#endif /* ALLOW_MYPACKAGE */
RETURN
END