pkg/layers/layers_check.F

108a00eab9 Ryan*0001 #include "LAYERS_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005       SUBROUTINE LAYERS_CHECK( myThid )
                0006
                0007 C     Check dependances with other packages
                0008
                0009       IMPLICIT NONE
                0010 #include "SIZE.h"
                0011 #include "EEPARAMS.h"
                0012 #include "PARAMS.h"
                0013 #include "EOS.h"
                0014 #include "LAYERS_SIZE.h"
9b89fcf692 antn*0015 #include "LAYERS_P2SHARE.h"
108a00eab9 Ryan*0016 #include "LAYERS.h"
                0017
                0018 C     myThid   :: my Thread Id number
                0019       INTEGER myThid
                0020
                0021 C     LOCAL VARIABLES:
c4343d1bc6 Jean*0022 C     msgBuf   :: Informational/error message buffer
108a00eab9 Ryan*0023       CHARACTER*(MAX_LEN_MBUF) msgBuf
2c2df907b2 Jean*0024       CHARACTER*(40) tmpName
                0025       CHARACTER*(1) sfx
                0026       INTEGER iLa, k, errCount
44cfc9294d Jean*0027       _RL tmpVar
108a00eab9 Ryan*0028
                0029 #ifdef ALLOW_LAYERS
                0030       _BEGIN_MASTER(myThid)
                0031
                0032        WRITE(msgBuf,'(A)') 'LAYERS_CHECK: #define LAYERS'
                0033        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2c2df907b2 Jean*0034      &                     SQUEEZE_RIGHT, myThid )
108a00eab9 Ryan*0035
44cfc9294d Jean*0036 C--   Print out some key parameters :
108a00eab9 Ryan*0037        CALL WRITE_0D_I( NZZ, INDEX_NONE, 'NZZ =',
                0038      &  ' /* number of levels in the fine vertical grid */')
f61c9be03a Ryan*0039        CALL WRITE_1D_RL( dZZf, NZZ, INDEX_K, 'dZZf =',
                0040      &  ' /* fine vertical grid spacing for isopycnal interp */')
                0041
406891c1a3 Gael*0042       DO iLa=1,layers_maxNum
44cfc9294d Jean*0043        IF ( layers_num(iLa).NE.0 ) THEN
2c2df907b2 Jean*0044         sfx = '#'
                0045         IF ( iLa.LE.9 ) WRITE(sfx,'(I1)') iLa
                0046
                0047         WRITE(tmpName,'(3A)') 'layers_num(', sfx, ') ='
                0048         CALL WRITE_0D_I( layers_num(iLa), INDEX_NONE, tmpName(1:15),
                0049      &   ' /* averaging field: 1= theta, 2= salt, 3= prho */' )
                0050         WRITE(tmpName,'(3A)') 'layers_name(', sfx, ') ='
                0051         CALL WRITE_0D_C( layers_name(iLa),-1,INDEX_NONE, tmpName(1:16),
                0052      &   ' /* averaging field: TH = theta, SLT= salt, RHO= prho */' )
                0053         WRITE(tmpName,'(3A)') 'layers_bolus(', sfx, ') ='
                0054         IF ( useGMRedi )
                0055      &  CALL WRITE_0D_L ( layers_bolus(iLa), INDEX_NONE, tmpName(1:17),
                0056      &   ' /* include potential GM bolus velocity */')
                0057         WRITE(tmpName,'(3A)') 'layers_krho(', sfx, ') ='
44cfc9294d Jean*0058         IF ( layers_num(iLa).EQ.3 )
2c2df907b2 Jean*0059      &  CALL WRITE_0D_I( layers_krho(iLa), INDEX_NONE, tmpName(1:16),
                0060      &   ' /* model level to reference potential density to */' )
                0061         WRITE(tmpName,'(3A)') 'layers_bounds(*,', sfx, ') ='
44cfc9294d Jean*0062         CALL WRITE_1D_RL( layers_bounds(1,iLa), Nlayers+1, INDEX_K,
2c2df907b2 Jean*0063      &   tmpName(1:20), ' /* boundaries of tracer-averaging bins */')
17ce8d85dd Davi*0064
44cfc9294d Jean*0065        ENDIF !IF ( layers_num(iLa).NE.0 ) THEN
406891c1a3 Gael*0066       ENDDO !DO iLa=1,layers_maxNum
17ce8d85dd Davi*0067
44cfc9294d Jean*0068 C--   Check parameters:
2c2df907b2 Jean*0069       errCount = 0
44cfc9294d Jean*0070       DO iLa=1,layers_maxNum
108a00eab9 Ryan*0071
44cfc9294d Jean*0072        IF ( layers_num(iLa).NE.0 ) THEN
2c2df907b2 Jean*0073 C-    Check for inconsistent density layers_bounds specification
                0074 C     a) make sure layers_bounds is increasing:
44cfc9294d Jean*0075         DO k=1,Nlayers
                0076          IF ( layers_bounds(k,iLa).GE.layers_bounds(k+1,iLa) ) THEN
                0077           WRITE(msgBuf,'(A,I2,A,I4)') 'LAYERS_CHECK(iLa=', iLa,
                0078      &      '): layers_bounds k -> k+1 not increasing at k=', k
                0079           CALL PRINT_ERROR( msgBuf, myThid )
2c2df907b2 Jean*0080           errCount = errCount + 1
44cfc9294d Jean*0081          ENDIF
                0082         ENDDO
                0083        ENDIF
                0084
                0085        IF ( layers_num(iLa).EQ.3 ) THEN
                0086 C     Pot.Density is now expressed as rho-1000 (previously just rho):
2c2df907b2 Jean*0087 C     b) check for realistic layers_bounds values:
44cfc9294d Jean*0088         tmpVar = layers_bounds(Nlayers+1,iLa) - layers_bounds(1,iLa)
                0089         IF ( tmpVar.LE.50. .AND. layers_bounds(1,iLa).GE.950. ) THEN
                0090           WRITE(msgBuf,'(A,I2,A)') 'LAYERS_CHECK(iLa=', iLa,
                0091      &      '): layers_bounds seems to be expressed as "rho"'
                0092           CALL PRINT_ERROR( msgBuf, myThid )
                0093           WRITE(msgBuf,'(A,I2,A)') 'LAYERS_CHECK(iLa=', iLa,
                0094      &      '): while it should be expressed as "rho - 1000"'
                0095           CALL PRINT_ERROR( msgBuf, myThid )
2c2df907b2 Jean*0096           errCount = errCount + 1
                0097         ENDIF
                0098 C-     Check for valid density reference level:
                0099         IF ( layers_krho(iLa).LT.1 .OR. layers_krho(iLa).GT.Nr ) THEN
                0100           WRITE(msgBuf,'(2A,I3,A,I9)') 'LAYERS_CHECK: ',
                0101      &        'Invalid layer_krho(iLa=', iLa,') =', layers_krho(iLa)
                0102           CALL PRINT_ERROR( msgBuf, myThid )
                0103           errCount = errCount + 1
44cfc9294d Jean*0104         ENDIF
                0105        ENDIF
                0106
                0107       ENDDO
108a00eab9 Ryan*0108
9b89fcf692 antn*0109       IF ( layers_useThermo .AND. .NOT. useDiagnostics ) THEN
                0110         WRITE(msgBuf,'(2A)') 'LAYERS_CHECK: ',
                0111      &    'layers-thermodynamics part requires useDiagnostics=T'
                0112         CALL PRINT_ERROR( msgBuf, myThid )
                0113         errCount = errCount + 1
                0114       ENDIF
                0115
2c2df907b2 Jean*0116       IF ( errCount.GE.1 ) THEN
                0117         WRITE(msgBuf,'(A,I3,A)')
                0118      &       'LAYERS_CHECK: detected', errCount,' fatal error(s)'
                0119         CALL PRINT_ERROR( msgBuf, myThid )
                0120         CALL ALL_PROC_DIE( 0 )
                0121         STOP 'ABNORMAL END: S/R LAYERS_CHECK'
                0122       ELSE
                0123        WRITE(msgBuf,'(A)') 'LAYERS_CHECK: done'
                0124        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0125      &                     SQUEEZE_RIGHT, myThid )
                0126       ENDIF
                0127
108a00eab9 Ryan*0128       _END_MASTER(myThid)
c4343d1bc6 Jean*0129 #endif /* ALLOW_LAYERS */
108a00eab9 Ryan*0130
                0131       RETURN
                0132       END