pkg/grdchk/grdchk_readparms.F

e01476fa28 Jean*0001 #include "GRDCHK_OPTIONS.h"
a7eff9e819 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
2091ce7ee7 Patr*0005
9f5240b52a Jean*0006       SUBROUTINE GRDCHK_READPARMS( myThid )
2091ce7ee7 Patr*0007
1052c30783 Jean*0008 C     ==================================================================
                0009 C     SUBROUTINE grdchk_readparms
                0010 C     ==================================================================
                0011 C
                0012 C     o Read Gradient-check package parameters
                0013 C
                0014 C     started: Christian Eckert eckert@mit.edu 03-Mar-2000
                0015 C     continued: heimbach@mit.edu: 13-Jun-2001
                0016 C
                0017 C     ==================================================================
                0018 C     SUBROUTINE grdchk_readparms
                0019 C     ==================================================================
2091ce7ee7 Patr*0020
9f5240b52a Jean*0021       IMPLICIT NONE
2091ce7ee7 Patr*0022
1052c30783 Jean*0023 C     == global variables ==
2091ce7ee7 Patr*0024 #include "SIZE.h"
587d15c8e3 Jean*0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
2091ce7ee7 Patr*0027
5cf4364659 Mart*0028 #include "CTRL_SIZE.h"
4d72283393 Mart*0029 #include "CTRL.h"
444da61630 Mart*0030 #ifdef ALLOW_OBCS_CONTROL
                0031 C     CTRL_OBCS.h must be included before GRDCHK.h
                0032 # include "CTRL_OBCS.h"
                0033 #endif
                0034 #include "GRDCHK.h"
2091ce7ee7 Patr*0035
1052c30783 Jean*0036 C     == routine arguments ==
9f5240b52a Jean*0037       INTEGER myThid
2091ce7ee7 Patr*0038
edd57506ae Patr*0039 #ifdef ALLOW_GRDCHK
1052c30783 Jean*0040 C     == local variables ==
e1f56e17d2 Jean*0041       INTEGER iGloTile, jGloTile
9f5240b52a Jean*0042       INTEGER iUnit
                0043       CHARACTER*(MAX_LEN_MBUF) msgBuf
1052c30783 Jean*0044 C     == end of interface ==
2091ce7ee7 Patr*0045
1052c30783 Jean*0046 C--   Gradient-Check parameters.
                0047       NAMELIST /grdchk_nml/
2091ce7ee7 Patr*0048      &                  grdchk_eps,
                0049      &                  nbeg,
                0050      &                  nstep,
                0051      &                  nend,
5cf4364659 Mart*0052      &                  grdchkvarname,
b7ff4d81ac Patr*0053      &                  grdchkvarindex,
78a0e1cce7 Patr*0054      &                  useCentralDiff,
f81d465bd0 Patr*0055      &                  grdchkwhichproc,
                0056      &                  iGloPos,
                0057      &                  jGloPos,
                0058      &                  kGloPos,
e4b263335d Patr*0059      &                  iGloTile,
                0060      &                  jGloTile,
ec93986742 Patr*0061      &                  idep,
                0062      &                  jdep,
f81d465bd0 Patr*0063      &                  obcsglo,
                0064      &                  recglo
2091ce7ee7 Patr*0065
587d15c8e3 Jean*0066 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0067
                0068       IF ( .NOT.useGrdChk ) THEN
                0069 C-    pkg GRDCHK is not used
                0070         _BEGIN_MASTER(myThid)
                0071 C-    Track pkg activation status:
                0072 C     print a (weak) warning if data.grdchk is found
                0073          CALL PACKAGES_UNUSED_MSG( 'useGrdChk', ' ', ' ' )
                0074         _END_MASTER(myThid)
                0075         RETURN
                0076       ENDIF
                0077
9f5240b52a Jean*0078       _BEGIN_MASTER( myThid )
2091ce7ee7 Patr*0079
1052c30783 Jean*0080 C--     Set default values.
78a0e1cce7 Patr*0081         grdchk_eps      = 1. _d 0
f81d465bd0 Patr*0082         nbeg            = 0
                0083         nend            = 0
                0084         nstep           = 0
78a0e1cce7 Patr*0085         useCentralDiff  = .TRUE.
e1f56e17d2 Jean*0086         grdchkwhichproc = -1
f81d465bd0 Patr*0087         iGloPos         = 0
                0088         jGloPos         = 0
                0089         kGloPos         = 1
e4b263335d Patr*0090         iGloTile        = 1
                0091         jGloTile        = 1
ec93986742 Patr*0092         idep            = 1
                0093         jdep            = 1
f81d465bd0 Patr*0094         obcsglo         = 1
                0095         recglo          = 1
5cf4364659 Mart*0096         grdchkvarname   = ' '
                0097         grdchkvarindex  = UNSET_I
2091ce7ee7 Patr*0098
1052c30783 Jean*0099 C       Next, read the GRDCHK parameter file.
9aaf43452b Patr*0100         WRITE(msgBuf,'(A)') 'GRDCHK_READPARMS: opening data.grdchk'
                0101         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1052c30783 Jean*0102      &                      SQUEEZE_RIGHT, myThid )
2091ce7ee7 Patr*0103
9aaf43452b Patr*0104         CALL OPEN_COPY_DATA_FILE(
                0105      I                          'data.grdchk', 'GRDCHK_READPARMS',
                0106      O                          iUnit,
                0107      I                          myThid )
2091ce7ee7 Patr*0108
9aaf43452b Patr*0109         READ(unit = iUnit, nml = grdchk_nml)
2091ce7ee7 Patr*0110
ef53b829d7 Jean*0111         WRITE(msgBuf,'(A)')
9aaf43452b Patr*0112      &     'GRDCHK_READPARMS: finished reading data.grdchk'
                0113         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0114      &                SQUEEZE_RIGHT , 1)
2091ce7ee7 Patr*0115
7a77863887 Mart*0116 #ifdef SINGLE_DISK_IO
                0117         CLOSE(iUnit)
                0118 #else
                0119         CLOSE(iUnit,STATUS='DELETE')
                0120 #endif /* SINGLE_DISK_IO */
2091ce7ee7 Patr*0121
e4b263335d Patr*0122         IF ( iGloPos .GT. sNx .OR. jGloPos .GT. sNy ) THEN
                0123            WRITE(msgBuf,'(A)') 'i/j GloPos must be <= sNx/y'
e1f56e17d2 Jean*0124            CALL PRINT_ERROR( msgBuf, myThid )
                0125            STOP 'ABNORMAL END: S/R GRDCHK_READPARMS'
                0126         ENDIF
                0127         IF ( iGloTile .GT. nSx*nPx .OR. jGloTile .GT. nSy*nPy ) THEN
                0128            WRITE(msgBuf,'(A)') 'i/j GloTile must be <= nSx*nPx/y'
                0129            CALL PRINT_ERROR( msgBuf, myThid )
                0130            STOP 'ABNORMAL END: S/R GRDCHK_READPARMS'
                0131         ENDIF
                0132         IF ( grdchkwhichproc .NE. -1 ) THEN
                0133            WRITE(msgBuf,'(2A)') 'S/R GRDCHK_READPARMS: ',
                0134      &         'grdchkwhichproc no longer allowed in namelist'
                0135            CALL PRINT_ERROR( msgBuf, myThid )
                0136            STOP 'ABNORMAL END: S/R GRDCHK_READPARMS'
e4b263335d Patr*0137         ENDIF
e1f56e17d2 Jean*0138
                0139 C--    From Tile Global-Indices, set Tile Local-Indices and proc. number
                0140         iLocTile = iGloTile - (myXGlobalLo-1)/sNx
                0141         jLocTile = jGloTile - (myYGlobalLo-1)/sNy
                0142         IF ( iLocTile.GE.1 .AND. iLocTile.LE.nSx .AND.
                0143      &       jLocTile.GE.1 .AND. jLocTile.LE.nSy ) THEN
                0144           grdchkwhichproc = myProcId
e4b263335d Patr*0145         ENDIF
                0146
9f5240b52a Jean*0147       _END_MASTER( myThid )
2091ce7ee7 Patr*0148       _BARRIER
                0149
edd57506ae Patr*0150 #endif /* ALLOW_GRDCHK */
2091ce7ee7 Patr*0151
587d15c8e3 Jean*0152       RETURN
                0153       END