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