File indexing completed on 2024-03-02 06:10:37 UTC
view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
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
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
2091ce7ee7 Patr*0020
9f5240b52a Jean*0021 IMPLICIT NONE
2091ce7ee7 Patr*0022
1052c30783 Jean*0023
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
0032 # include "CTRL_OBCS.h"
0033 #endif
0034 #include "GRDCHK.h"
2091ce7ee7 Patr*0035
1052c30783 Jean*0036
9f5240b52a Jean*0037 INTEGER myThid
2091ce7ee7 Patr*0038
edd57506ae Patr*0039 #ifdef ALLOW_GRDCHK
1052c30783 Jean*0040
e1f56e17d2 Jean*0041 INTEGER iGloTile, jGloTile
9f5240b52a Jean*0042 INTEGER iUnit
0043 CHARACTER*(MAX_LEN_MBUF) msgBuf
1052c30783 Jean*0044
2091ce7ee7 Patr*0045
1052c30783 Jean*0046
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
0067
0068 IF ( .NOT.useGrdChk ) THEN
0069
0070 _BEGIN_MASTER(myThid)
0071
0072
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
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
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
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