pkg/layers/layers_readparms.F

108a00eab9 Ryan*0001 #include "LAYERS_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005       SUBROUTINE LAYERS_READPARMS( myThid )
                0006
                0007 C     Read LAYERS parameters from data file.
                0008
                0009       IMPLICIT NONE
                0010 #include "SIZE.h"
                0011 #include "EEPARAMS.h"
                0012 #include "PARAMS.h"
                0013 #include "LAYERS_SIZE.h"
9b89fcf692 antn*0014 #include "LAYERS_P2SHARE.h"
108a00eab9 Ryan*0015 #include "LAYERS.h"
                0016
                0017 C     INPUT PARAMETERS:
                0018       INTEGER myThid
                0019
                0020 #ifdef ALLOW_LAYERS
ae4c29e0db Jean*0021 C     === Local variables ===
                0022 C     msgBuf     :: Informational/error message buffer
                0023 C     iUnit      :: Work variable for IO unit number
                0024 C     k          :: index
                0025       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0026       INTEGER iUnit, k, iLa
2c2df907b2 Jean*0027       INTEGER errCount
                0028
                0029 C--   old pkg/layers parameter setting (only single tracer layers diagnostics):
                0030 C      layers_G :: boundaries of tracer layers
                0031       INTEGER LAYER_nb, layers_kref
                0032       LOGICAL useBOLUS
                0033       _RL layers_G(Nlayers+1)
                0034
b7411f1a84 Jean*0035 C-    retired parameters:
                0036       _RL layers_taveFreq
                0037
2c2df907b2 Jean*0038 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
108a00eab9 Ryan*0039
                0040       NAMELIST /LAYERS_PARM01/
a60f4dd950 Davi*0041      &       layers_G, layers_taveFreq, layers_diagFreq,
406891c1a3 Gael*0042      &       LAYER_nb, layers_kref, useBOLUS, layers_bolus,
                0043      &       layers_name, layers_bounds, layers_krho
108a00eab9 Ryan*0044
9b89fcf692 antn*0045        _BEGIN_MASTER(myThid)
                0046        layers_useThermo = .FALSE.
                0047        _END_MASTER(myThid)
                0048
ae4c29e0db Jean*0049       IF ( .NOT.useLayers ) THEN
                0050 C-    pkg LAYERS is not used
                0051         _BEGIN_MASTER(myThid)
                0052 C-    Track pkg activation status:
                0053 C     print a (weak) warning if data.layers is found
                0054          CALL PACKAGES_UNUSED_MSG( 'useLayers', ' ', ' ' )
                0055         _END_MASTER(myThid)
                0056         RETURN
                0057       ENDIF
108a00eab9 Ryan*0058
                0059       _BEGIN_MASTER(myThid)
2c2df907b2 Jean*0060       errCount = 0
b7411f1a84 Jean*0061       layers_taveFreq = UNSET_RL
108a00eab9 Ryan*0062
                0063 C--   Default values for LAYERS
9b89fcf692 antn*0064 #ifdef LAYERS_THERMODYNAMICS
                0065 C-    Currently, there is no run-time switch for doing the "layers thermodynamics"
                0066 C       part and this is turned on at compile time (with CPP option above):
                0067       layers_useThermo = .TRUE.
                0068 #endif
2c2df907b2 Jean*0069       layers_diagFreq = dumpFreq
108a00eab9 Ryan*0070 C     The MNC stuff is not working yet
                0071       layers_MNC = .FALSE.
                0072       layers_MDSIO = .TRUE.
                0073
406891c1a3 Gael*0074       DO iLa=1,layers_maxNum
                0075         layers_name(iLa) = ' '
                0076         layers_krho(iLa)= 1
20c24d88bc Jean*0077         layers_bolus(iLa) = useGMRedi
406891c1a3 Gael*0078         DO k=1,Nlayers+1
                0079           layers_bounds(k,iLa) = UNSET_RL
                0080         ENDDO
                0081       ENDDO
20c24d88bc Jean*0082
2c2df907b2 Jean*0083 C--   old params default:
406891c1a3 Gael*0084       LAYER_nb = 0
17ce8d85dd Davi*0085       layers_kref = 1
20c24d88bc Jean*0086       useBOLUS = useGMRedi
2c2df907b2 Jean*0087       DO k=1,Nlayers+1
                0088         layers_G(k) = UNSET_RL
                0089       ENDDO
108a00eab9 Ryan*0090
                0091       WRITE(msgBuf,'(A)') 'LAYERS_READPARMS: opening data.layers'
                0092       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0093      &                    SQUEEZE_RIGHT , 1)
                0094       CALL OPEN_COPY_DATA_FILE(
                0095      I                     'data.layers', 'LAYERS_READPARMS',
                0096      O                     iUnit,
                0097      I                     myThid )
                0098
                0099 C     Read parameters from open data file
                0100       READ(UNIT=iUnit,NML=LAYERS_PARM01)
                0101       WRITE(msgBuf,'(A)')
                0102      &    'LAYERS_READPARMS: finished reading data.layers'
                0103       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0104      &    SQUEEZE_RIGHT , 1)
                0105 C     Close the open data file
7a77863887 Mart*0106 #ifdef SINGLE_DISK_IO
108a00eab9 Ryan*0107       CLOSE(iUnit)
7a77863887 Mart*0108 #else
                0109       CLOSE(iUnit,STATUS='DELETE')
                0110 #endif /* SINGLE_DISK_IO */
108a00eab9 Ryan*0111
2c2df907b2 Jean*0112 C--   Process old params setting (single averaging tracer)
                0113       IF ( LAYER_nb.LT.0 .OR. LAYER_nb.GT.3 ) THEN
                0114         WRITE(msgBuf,'(2A,I2,A,I9)') 'LAYERS_READPARMS: ',
                0115      &    'Invalid LAYER_nb=', LAYER_nb
                0116         CALL PRINT_ERROR( msgBuf, myThid )
                0117         errCount = errCount + 1
                0118       ENDIF
                0119       IF ( LAYER_nb.EQ.0 ) THEN
                0120         IF ( layers_kref.NE.1 )         errCount = errCount + 1
                0121         DO k=1,Nlayers+1
                0122          IF ( layers_G(k).NE.UNSET_RL ) errCount = errCount + 1
                0123         ENDDO
                0124       ELSE
                0125         DO iLa=1,layers_maxNum
                0126          IF ( layers_name(iLa).NE.' ' ) errCount = errCount + 1
                0127          IF ( layers_krho(iLa).NE.1 )   errCount = errCount + 1
                0128          DO k=1,Nlayers+1
                0129           IF ( layers_bounds(k,iLa).NE.UNSET_RL ) errCount = errCount+1
                0130          ENDDO
                0131         ENDDO
                0132 C-    Transfert to new params setting:
                0133         IF ( LAYER_nb.EQ.1 ) layers_name(1) = 'TH '
                0134         IF ( LAYER_nb.EQ.2 ) layers_name(1) = 'SLT'
                0135         IF ( LAYER_nb.EQ.3 ) layers_name(1) = 'RHO'
406891c1a3 Gael*0136         layers_krho(1) = layers_kref
d30f939fae Davi*0137         layers_bolus(1) = useBOLUS
406891c1a3 Gael*0138         DO k=1,Nlayers+1
                0139           layers_bounds(k,1) = layers_G(k)
                0140         ENDDO
2c2df907b2 Jean*0141       ENDIF
                0142       IF ( errCount.GE.1 ) THEN
                0143         WRITE(msgBuf,'(2A)') 'LAYERS_READPARMS: ',
                0144      &    'Cannot mix old params setting (LAYER_nb > 0)'
                0145         CALL PRINT_ERROR( msgBuf, myThid )
                0146         WRITE(msgBuf,'(2A)') 'LAYERS_READPARMS: ',
                0147      &    ' with new params setting (layer_name(#)= ...)'
                0148         CALL PRINT_ERROR( msgBuf, myThid )
                0149         WRITE(msgBuf,'(2A,I4,A)') 'LAYERS_READPARMS: ',
                0150      &    'Detected', errCount,' fatal error/conflict(s)'
                0151         CALL PRINT_ERROR( msgBuf, myThid )
                0152         CALL ALL_PROC_DIE( 0 )
                0153         STOP 'ABNORMAL END: S/R LAYERS_READPARMS'
406891c1a3 Gael*0154       ENDIF
                0155
b7411f1a84 Jean*0156 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0157
                0158 C--   Check for retired parameters:
                0159       IF ( layers_taveFreq .NE. UNSET_RL ) THEN
                0160         WRITE(msgBuf,'(2A)') 'LAYERS_READPARMS: "layers_taveFreq"',
                0161      &    ' is no longer allowed in file "data.layers"'
                0162         CALL PRINT_ERROR( msgBuf, myThid )
                0163         WRITE(msgBuf,'(2A)') 'LAYERS_READPARMS: ',
                0164      &    ' since "pkg/timeave" has been removed.'
                0165         CALL PRINT_ERROR( msgBuf, myThid )
                0166         errCount = errCount + 1
                0167       ENDIF
                0168
2c2df907b2 Jean*0169 C--   Set layers_num according to layers_name:
406891c1a3 Gael*0170       DO iLa=1,layers_maxNum
2c2df907b2 Jean*0171         layers_num(iLa) = 0
                0172         IF ( layers_name(iLa).EQ.'TH ' ) layers_num(iLa) = 1
                0173         IF ( layers_name(iLa).EQ.'SLT' ) layers_num(iLa) = 2
                0174         IF ( layers_name(iLa).EQ.'RHO' ) layers_num(iLa) = 3
84f265d4b3 dfer*0175         IF ( layers_name(iLa).EQ.'MSE' ) layers_num(iLa) = 4
2c2df907b2 Jean*0176         IF ( layers_name(iLa).NE.' ' .AND.
                0177      &       layers_num(iLa).EQ.0 ) THEN
                0178           WRITE(msgBuf,'(2A,I2,3A)') 'LAYERS_READPARMS: ',
                0179      &    'invalid layers_name(',iLa,')= "',layers_name(iLa),'"'
                0180           CALL PRINT_ERROR( msgBuf, myThid )
                0181           errCount = errCount + 1
20c24d88bc Jean*0182         ENDIF
                0183 C--   bolus contribution only available if using GMRedi
                0184         layers_bolus(iLa) = layers_bolus(iLa) .AND. useGMRedi
406891c1a3 Gael*0185       ENDDO
20c24d88bc Jean*0186
406891c1a3 Gael*0187 C--   Make sure the layers_bounds we just read is big enough
                0188       DO iLa=1,layers_maxNum
20c24d88bc Jean*0189        IF ( layers_num(iLa).NE.0 ) THEN
                0190         DO k=1,Nlayers+1
2c2df907b2 Jean*0191          IF ( layers_bounds(k,iLa).EQ.UNSET_RL ) THEN
                0192           WRITE(msgBuf,'(2A,I4,A,I3,A)') 'LAYERS_READPARMS: ',
                0193      &        'No value for layers_bounds(k=',k,', iLa=', iLa, ')'
108a00eab9 Ryan*0194           CALL PRINT_ERROR( msgBuf, myThid )
2c2df907b2 Jean*0195           errCount = errCount + 1
20c24d88bc Jean*0196          ENDIF
                0197         ENDDO
                0198        ENDIF
84f265d4b3 dfer*0199 #ifndef LAYERS_PRHO_REF
                0200        IF ( layers_num(iLa).EQ.3 ) THEN
                0201         WRITE(msgBuf,'(2A,I4)')
                0202      &      'S/R LAYERS_READPARMS: ',
                0203      &      'Layering in density requires to define LAYERS_PRHO_REF'
                0204           CALL PRINT_ERROR( msgBuf, myThid )
                0205           errCount = errCount + 1
                0206        ENDIF
                0207 #endif
                0208 #ifndef LAYERS_MSE
                0209        IF ( layers_num(iLa).EQ.4 ) THEN
                0210         WRITE(msgBuf,'(2A,I4)')
                0211      &      'S/R LAYERS_READPARMS: ',
                0212      &      'Layering in MSE requires to define LAYERS_MSE'
                0213           CALL PRINT_ERROR( msgBuf, myThid )
                0214           errCount = errCount + 1
                0215        ENDIF
                0216 #endif
                0217 C- Check MSE is not used with grey atmosphere nor with fizhi
                0218        IF ( layers_num(iLa).EQ.4 ) THEN
                0219         IF ( useAtm_Phys .OR. useFizhi ) THEN
                0220          WRITE(msgBuf,'(2A,I4)')
                0221      &       'S/R LAYERS_READPARMS: ',
                0222      &       'Layering in MSE only work with Aim_v23'
                0223           CALL PRINT_ERROR( msgBuf, myThid )
                0224           errCount = errCount + 1
                0225         ENDIF
                0226        ENDIF
406891c1a3 Gael*0227       ENDDO
108a00eab9 Ryan*0228
                0229 C--   Make sure that we locally honor the global MNC on/off flag
                0230       layers_MNC = layers_MNC .AND. useMNC
                0231 #ifndef ALLOW_MNC
                0232 C     Fix to avoid running without getting any output:
                0233       layers_MNC = .FALSE.
                0234 #endif
                0235       layers_MDSIO = (.NOT. layers_MNC) .OR. outputTypesInclusive
                0236
2c2df907b2 Jean*0237       IF ( errCount.GE.1 ) THEN
                0238         WRITE(msgBuf,'(A,I3,A)')
                0239      &    'LAYERS_READPARMS: detected', errCount,' fatal error(s)'
                0240         CALL PRINT_ERROR( msgBuf, myThid )
                0241         CALL ALL_PROC_DIE( 0 )
                0242         STOP 'ABNORMAL END: S/R LAYERS_READPARMS'
                0243       ENDIF
                0244
108a00eab9 Ryan*0245       _END_MASTER(myThid)
                0246
                0247 C--   Everyone else must wait for the parameters to be loaded
                0248       _BARRIER
                0249
9b89fcf692 antn*0250 #endif /* ALLOW_LAYERS */
108a00eab9 Ryan*0251
                0252       RETURN
                0253       END