pkg/cost/cost_readparms.F

5ed655852f Jean*0001 #include "COST_OPTIONS.h"
2dcaa8b9a5 Patr*0002
af61e5eb16 Mart*0003       SUBROUTINE COST_READPARMS( myThid )
2dcaa8b9a5 Patr*0004
                0005 c     ==================================================================
                0006 c     SUBROUTINE cost_readparms
                0007 c     ==================================================================
                0008 c
                0009 c     o This routine initialises the package cost.
                0010 c
                0011 c     started: Ralf Giering 18-Jan-2001
                0012 c
                0013 c     ==================================================================
                0014 c     SUBROUTINE cost_readparms
                0015 c     ==================================================================
                0016
af61e5eb16 Mart*0017       IMPLICIT NONE
2dcaa8b9a5 Patr*0018
                0019 c     == global variables ==
                0020 #include "EEPARAMS.h"
                0021 #include "SIZE.h"
                0022 #include "GRID.h"
e20b49665f Mart*0023 #include "PARAMS.h"
2dcaa8b9a5 Patr*0024 #include "cost.h"
                0025
                0026 c     == routine arguments ==
af61e5eb16 Mart*0027       INTEGER myThid
2dcaa8b9a5 Patr*0028
                0029 c     == local variables ==
af61e5eb16 Mart*0030       CHARACTER*(max_len_mbuf) msgbuf
                0031       INTEGER iUnit
69361556c2 Mart*0032 c     retired parameter
                0033       _RL     mult_depth
2dcaa8b9a5 Patr*0034
                0035 c     == end of interface ==
                0036
                0037 c--   Read the namelist input.
af61e5eb16 Mart*0038       NAMELIST /cost_nml/
cda1c18f72 Jean*0039      &         mult_atl, mult_test, mult_tracer,
                0040      &         multTheta, multSalt, multUvel, multVvel, multEtan,
                0041      &         mult_depth,
11c3150c71 Mart*0042 #ifdef ALLOW_COST_HFLUXM
cda1c18f72 Jean*0043      &         mult_temp_tut, mult_hflux_tut,
11c3150c71 Mart*0044 #endif
af61e5eb16 Mart*0045      &         lastinterval, cost_mask_file
2dcaa8b9a5 Patr*0046
                0047       _BEGIN_MASTER( myThid )
                0048
                0049 c--     Set default values.
                0050         mult_atl              =      0. _d 0
                0051         mult_test             =      0. _d 0
bbf42b7711 Patr*0052         mult_tracer           =      0. _d 0
586ad2dc56 Patr*0053         multTheta             =      0. _d 0
                0054         multSalt              =      0. _d 0
                0055         multUvel              =      0. _d 0
                0056         multVvel              =      0. _d 0
                0057         multEtan              =      0. _d 0
69361556c2 Mart*0058         mult_depth            =      UNSET_RL
11c3150c71 Mart*0059 #ifdef ALLOW_COST_HFLUXM
14021e1fda Davi*0060         mult_temp_tut         =      0. _d 0
                0061         mult_hflux_tut        =      0. _d 0
11c3150c71 Mart*0062 #endif
af61e5eb16 Mart*0063         cost_mask_file        =      ' '
2dcaa8b9a5 Patr*0064
449f3c105b Patr*0065 c--     30*24*3600 = 2592000 = 1 model month
                0066         lastinterval = 2592000.
                0067
2dcaa8b9a5 Patr*0068 c--     Next, read the cost data file.
9aaf43452b Patr*0069         WRITE(msgBuf,'(A)') 'COST_READPARMS: opening data.cost'
                0070         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0071      &                    SQUEEZE_RIGHT , 1)
                0072
                0073         CALL OPEN_COPY_DATA_FILE(
                0074      I                          'data.cost', 'COST_READPARMS',
                0075      O                          iUnit,
                0076      I                          myThid )
                0077
                0078         READ(  iUnit, nml = cost_nml )
                0079
                0080         WRITE(msgBuf,'(A)') 'COST_READPARMS: finished reading data.cost'
                0081         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0082      &                  SQUEEZE_RIGHT , 1)
                0083
7a77863887 Mart*0084 #ifdef SINGLE_DISK_IO
                0085         CLOSE(iUnit)
                0086 #else
                0087         CLOSE(iUnit,STATUS='DELETE')
                0088 #endif /* SINGLE_DISK_IO */
2dcaa8b9a5 Patr*0089
cda1c18f72 Jean*0090         IF ( MOD(lastinterval,deltaTClock) .GT. 0. )
e20b49665f Mart*0091      &       lastinterval = MAX(
cda1c18f72 Jean*0092      &       INT(lastinterval/deltaTClock-1)*deltaTClock,deltaTClock)
e20b49665f Mart*0093
69361556c2 Mart*0094
7507ba8fa5 Davi*0095 #if (defined ALLOW_COST_HFLUXM) || (defined ALLOW_COST_TEMP)
913151f332 Davi*0096 c-- get the weights for the cost functions
                0097       CALL COST_WEIGHTS( myThid )
98264b2c3d Gael*0098 cgf : to compile previous line user is expected to provide cost_weights.F
7507ba8fa5 Davi*0099 #endif
af61e5eb16 Mart*0100
69361556c2 Mart*0101       IF ( mult_depth .NE. UNSET_RL ) THEN
                0102        WRITE(msgBuf,'(a)')
                0103      & 'S/R COST_READPARMS: mult_depth is now longer allow in data.cost'
                0104        CALL PRINT_ERROR( msgBuf, myThid )
                0105        WRITE(msgBuf,'(a)')
                0106      & 'S/R COST_READPARMS: use generic control cost instead'
                0107        CALL PRINT_ERROR( msgBuf, myThid )
                0108        CALL ALL_PROC_DIE( 0 )
                0109        STOP 'ABNORMAL END: S/R COST_READPARMS'
                0110       ENDIF
                0111
af61e5eb16 Mart*0112 C--   print cost parameters to stdout for better debugging
                0113       WRITE(msgBuf,'(A)')
                0114      &'// ======================================================='
                0115       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0116      &                    SQUEEZE_RIGHT, myThid )
                0117       WRITE(msgBuf,'(a)') '// cost configuration  >>> START <<<'
                0118       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0119      &                    SQUEEZE_RIGHT, myThid )
                0120       WRITE(msgBuf,'(A)')
                0121      &'// ======================================================='
                0122       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0123      &                    SQUEEZE_RIGHT, myThid )
                0124
                0125       CALL WRITE_0D_RL( lastinterval, INDEX_NONE,'lastinterval =',
                0126      &'   /* cost interval over which to average ( s ). */')
                0127 C
                0128        CALL WRITE_0D_C( cost_mask_file, -1, INDEX_NONE,
                0129      &  'cost_mask_file =', ' /* file name of cost mask file */')
                0130
                0131       WRITE(msgBuf,'(A)')
                0132      &'// ======================================================='
                0133       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0134      &                    SQUEEZE_RIGHT, myThid )
                0135       WRITE(msgBuf,'(A)') '// cost configuration  >>> END <<<'
                0136       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0137      &                    SQUEEZE_RIGHT, myThid )
                0138       WRITE(msgBuf,'(A)')
                0139      &'// ======================================================='
                0140       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0141      &                    SQUEEZE_RIGHT, myThid )
                0142       WRITE(msgBuf,'(A)') ' '
                0143       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0144      &                    SQUEEZE_RIGHT, myThid )
                0145
                0146       _END_MASTER( myThid )
2dcaa8b9a5 Patr*0147
                0148       _BARRIER
                0149
af61e5eb16 Mart*0150       RETURN
                0151       END