pkg/down_slope/dwnslp_readparms.F

b6bbe8cccf Jean*0001 #include "DWNSLP_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: DWNSLP_READPARMS
                0005 C     !INTERFACE:
                0006       SUBROUTINE DWNSLP_READPARMS( myThid )
                0007 C     !DESCRIPTION: \bv
                0008 C     *==========================================================*
                0009 C     | SUBROUTINE DWNSLP_READPARMS
                0010 C     | o Routine to initialize Down-Sloping Parameters
                0011 C     *==========================================================*
                0012 C     \ev
                0013
                0014 C     !USES:
                0015       IMPLICIT NONE
                0016
                0017 C     === Global variables ===
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "DWNSLP_PARAMS.h"
                0022
                0023 C     !INPUT/OUTPUT PARAMETERS:
                0024 C     === Routine arguments ===
                0025       INTEGER myThid
                0026
                0027 #ifdef ALLOW_DOWN_SLOPE
                0028 C     !LOCAL VARIABLES:
                0029 C     === Local variables ===
ae4c29e0db Jean*0030 C     msgBuf     :: Informational/error message buffer
                0031 C     iUnit      :: Work variable for IO unit number
b6bbe8cccf Jean*0032       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0033       INTEGER iUnit
                0034 CEOP
                0035
ae4c29e0db Jean*0036       NAMELIST /DWNSLP_PARM01/
                0037      &          DWNSLP_slope, DWNSLP_rec_mu, DWNSLP_drFlow,
                0038      &          temp_useDWNSLP, salt_useDWNSLP
                0039
                0040 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0041
                0042       IF ( .NOT.useDOWN_SLOPE ) THEN
                0043 C-    pkg DOWN_SLOPE is not used
                0044         _BEGIN_MASTER(myThid)
                0045 C-    Track pkg activation status:
                0046 C     print a (weak) warning if data.down_slope is found
                0047          CALL PACKAGES_UNUSED_MSG(
                0048      I                'useDOWN_SLOPE', 'DWNSLP_READPARMS', ' ' )
                0049         _END_MASTER(myThid)
                0050         RETURN
                0051       ENDIF
                0052
b6bbe8cccf Jean*0053       _BEGIN_MASTER(myThid)
                0054
                0055       WRITE(msgBuf,'(A)')' DWNSLP_READPARMS: opening data.down_slope'
                0056       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0057      &                    SQUEEZE_RIGHT , 1)
                0058
                0059       CALL OPEN_COPY_DATA_FILE(
                0060      I                         'data.down_slope', 'DWNSLP_READPARMS',
                0061      O                         iUnit,
                0062      I                         myThid )
                0063
                0064 C--   Default flags and values for DownSlope Parameterisation
                0065       temp_useDWNSLP = tempStepping
                0066       salt_useDWNSLP = saltStepping
                0067       DWNSLP_slope  = 0.
                0068       DWNSLP_rec_mu = 0.
                0069       DWNSLP_drFlow = 0.
                0070
                0071 C--   Read parameters from open data file
                0072       READ(UNIT=iUnit,NML=DWNSLP_PARM01)
                0073
                0074       WRITE(msgBuf,'(A)')
                0075      &   ' DWNSLP_READPARMS: finished reading data.downslp'
                0076       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0077      &                    SQUEEZE_RIGHT , 1)
                0078
                0079 C--   Close the open data file
7a77863887 Mart*0080 #ifdef SINGLE_DISK_IO
b6bbe8cccf Jean*0081       CLOSE(iUnit)
7a77863887 Mart*0082 #else
                0083       CLOSE(iUnit,STATUS='DELETE')
                0084 #endif /* SINGLE_DISK_IO */
b6bbe8cccf Jean*0085       _END_MASTER(myThid)
                0086
                0087 C--   Everyone else must wait for the parameters to be loaded
                0088       _BARRIER
                0089
                0090 C--   Check the parameters :
                0091       IF ( temp_useDWNSLP .AND. .NOT. tempStepping ) THEN
                0092         WRITE(msgBuf,'(A)')
                0093      &  'need tempStepping=T to apply DWNSLP to Temp (temp_useDWNSLP=T)'
                0094         CALL PRINT_ERROR( msgBuf , myThid )
                0095         STOP 'ABNORMAL END: S/R DWNSLP_READPARMS'
                0096       ENDIF
                0097       IF ( salt_useDWNSLP .AND. .NOT. saltStepping ) THEN
                0098         WRITE(msgBuf,'(A)')
                0099      &  'need saltStepping=T to apply DWNSLP to Salt (salt_useDWNSLP=T)'
                0100         CALL PRINT_ERROR( msgBuf , myThid )
                0101         STOP 'ABNORMAL END: S/R DWNSLP_READPARMS'
                0102       ENDIF
                0103
                0104 C- print out some kee parameters :
                0105       _BEGIN_MASTER(myThid)
                0106
4da4b49499 Jean*0107        CALL WRITE_0D_RL( DWNSLP_slope, INDEX_NONE,'DWNSLP_slope =',
b6bbe8cccf Jean*0108      &  '   /* DOWNSLP fixed slope (=0 => use local slope) */')
4da4b49499 Jean*0109        CALL WRITE_0D_RL( DWNSLP_rec_mu,INDEX_NONE,'DWNSLP_rec_mu =',
b6bbe8cccf Jean*0110      &  '   /* DOWNSLP recip. friction parameter (time, s ) */')
4da4b49499 Jean*0111        CALL WRITE_0D_RL( DWNSLP_drFlow,INDEX_NONE,'DWNSLP_drFlow =',
b6bbe8cccf Jean*0112      &  '   /* DOWNSLP effective layer thickness ( m ) */')
                0113
                0114       _END_MASTER(myThid)
                0115
                0116 #endif /* ALLOW_DOWN_SLOPE */
                0117       RETURN
                0118       END