| 1 |
C $Header: /u/gcmpack/MITgcm/eesupp/src/nml_change_syntax.F,v 1.1 2010/12/13 04:21:52 jmc Exp $ |
| 2 |
C $Name: $ |
| 3 |
|
| 4 |
#include "CPP_EEOPTIONS.h" |
| 5 |
|
| 6 |
CBOP |
| 7 |
C !ROUTINE: NML_CHANGE_SYNTAX |
| 8 |
|
| 9 |
C !INTERFACE: |
| 10 |
SUBROUTINE NML_CHANGE_SYNTAX( |
| 11 |
U record, |
| 12 |
I data_file, myThid ) |
| 13 |
C !DESCRIPTION: |
| 14 |
C *=================================================================* |
| 15 |
C | SUBROUTINE NML\_CHANGE\_SYNTAX |
| 16 |
C | o Apply changes to namelist to fit compiler requirement |
| 17 |
C *=================================================================* |
| 18 |
C | Change trailing \& to trailing / when needed |
| 19 |
C | Change array specification from F95 standard |
| 20 |
C | to commonly accepted F77 form (extented F77) |
| 21 |
C *=================================================================* |
| 22 |
|
| 23 |
C !USES: |
| 24 |
IMPLICIT NONE |
| 25 |
|
| 26 |
C == Global variables == |
| 27 |
#include "EEPARAMS.h" |
| 28 |
|
| 29 |
C !FUNCTIONS: |
| 30 |
INTEGER ILNBLNK |
| 31 |
EXTERNAL ILNBLNK |
| 32 |
#ifdef NML_EXTENDED_F77 |
| 33 |
INTEGER IFNBLNK |
| 34 |
EXTERNAL IFNBLNK |
| 35 |
#endif /* NML_EXTENDED_F77 */ |
| 36 |
|
| 37 |
C !INPUT/OUTPUT PARAMETERS: |
| 38 |
C == Routine arguments == |
| 39 |
C record :: current line record (from parameter file) to process |
| 40 |
C data_file :: current parameter file which contains the current record |
| 41 |
C myThid :: my Thread Id number |
| 42 |
CHARACTER*(MAX_LEN_PREC) record |
| 43 |
CHARACTER*(*) data_file |
| 44 |
INTEGER myThid |
| 45 |
|
| 46 |
C !LOCAL VARIABLES: |
| 47 |
C == Local variables == |
| 48 |
INTEGER il |
| 49 |
CHARACTER*(2) nmlEnd |
| 50 |
#ifdef NML_TERMINATOR |
| 51 |
PARAMETER( nmlEnd = ' /' ) |
| 52 |
#else |
| 53 |
PARAMETER( nmlEnd = ' &' ) |
| 54 |
#endif |
| 55 |
|
| 56 |
#ifdef NML_EXTENDED_F77 |
| 57 |
C i0 :: position of active "=" (end of variable name definition) |
| 58 |
C i1 :: position of 1rst left parenthesis |
| 59 |
C i2 :: position of 1rst colon |
| 60 |
C i3 :: position of 1rst comma after the 1rst colon |
| 61 |
C i4 :: position of right parenthesis after the 1rst left one |
| 62 |
C nWd :: number of words following "=" found in this reccord |
| 63 |
C msgBuf :: Informational/error message buffer |
| 64 |
INTEGER i0, i1, i2, i3, i4 |
| 65 |
INTEGER nWd, is, ie, iUnit |
| 66 |
INTEGER i, n, ii |
| 67 |
c INTEGER iLf |
| 68 |
LOGICAL sngQ, dblQ, comma |
| 69 |
LOGICAL hasNum1, hasNum2 |
| 70 |
LOGICAL debugPrt |
| 71 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
| 72 |
#endif /* NML_EXTENDED_F77 */ |
| 73 |
CEOP |
| 74 |
|
| 75 |
il = MAX(ILNBLNK(record),1) |
| 76 |
IF ( il .EQ. 2 ) THEN |
| 77 |
IF ( record(1:2) .EQ. ' &' ) THEN |
| 78 |
record(1:2) = nmlEnd |
| 79 |
ENDIF |
| 80 |
ENDIF |
| 81 |
|
| 82 |
#ifdef NML_EXTENDED_F77 |
| 83 |
debugPrt = .FALSE. |
| 84 |
c iLf = MAX(ILNBLNK(data_file),1) |
| 85 |
iUnit = errorMessageUnit |
| 86 |
i0 = 0 |
| 87 |
i1 = 0 |
| 88 |
i2 = 0 |
| 89 |
i3 = 0 |
| 90 |
i4 = 0 |
| 91 |
C-- search for end of variable spec ('=' char) and count words that follow |
| 92 |
nWd = 0 |
| 93 |
sngQ = .TRUE. |
| 94 |
dblQ = .TRUE. |
| 95 |
comma = .FALSE. |
| 96 |
DO i=1,il |
| 97 |
IF ( record(i:i).EQ."'" .AND. dblQ ) THEN |
| 98 |
sngQ = .NOT.sngQ |
| 99 |
IF ( i0.GE.1 .AND. sngQ ) nWd = nWd + 1 |
| 100 |
ENDIF |
| 101 |
IF ( record(i:i).EQ.'"' .AND. sngQ ) THEN |
| 102 |
dblQ = .NOT.dblQ |
| 103 |
IF ( i0.GE.1 .AND. dblQ ) nWd = nWd + 1 |
| 104 |
ENDIF |
| 105 |
IF ( record(i:i).EQ.'=' .AND. i0.EQ.0 |
| 106 |
& .AND. sngQ .AND. dblQ ) i0 = i |
| 107 |
ENDDO |
| 108 |
C-- find position of 1rst set of parenthesis, comma and colon |
| 109 |
DO i=1,i0 |
| 110 |
IF ( record(i:i).EQ.'(' .AND. i1.EQ.0 ) i1 = -i |
| 111 |
IF ( record(i:i).EQ.':' .AND. i1.LT.0 ) THEN |
| 112 |
IF ( i2.EQ.0 ) i2 = i |
| 113 |
IF ( comma ) THEN |
| 114 |
WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: warning: ', |
| 115 |
& 'no possible safe conversion of rec:' |
| 116 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 117 |
WRITE(iUnit,'(A)') record(1:il) |
| 118 |
WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ', |
| 119 |
& 'from file="', data_file, '".' |
| 120 |
c & 'from file="', data_file(1:iLf), '".' |
| 121 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 122 |
i1 = 1 |
| 123 |
ENDIF |
| 124 |
ENDIF |
| 125 |
IF ( record(i:i).EQ.',' .AND. i1.LT.0 ) THEN |
| 126 |
comma = .TRUE. |
| 127 |
IF ( i3.EQ.0 .AND. i2.GE.1 ) i3 = i |
| 128 |
ENDIF |
| 129 |
IF ( record(i:i).EQ.')' .AND. i1.LT.0 ) THEN |
| 130 |
i1 = -i1 |
| 131 |
i4 = i |
| 132 |
ENDIF |
| 133 |
ENDDO |
| 134 |
IF ( debugPrt .AND. i0.GE.1 ) THEN |
| 135 |
c WRITE(iUnit,'(5A)') ' ', data_file(1:iLf), |
| 136 |
c & ' , rec >', record(1:i0), '<' |
| 137 |
WRITE(iUnit,'(5A)') ' ',data_file,' , rec >',record(1:i0),'<' |
| 138 |
WRITE(iUnit,'(A,2I4,L5,A,4I4)') |
| 139 |
& ' i0,nWd,comma =',i0,nWd,comma,' ; i1,i2,i3,i4 =',i1,i2,i3,i4 |
| 140 |
ENDIF |
| 141 |
IF ( i4.EQ.0 .AND. i1.NE.0 ) THEN |
| 142 |
i2 = 0 |
| 143 |
IF ( i1.NE.1 ) THEN |
| 144 |
WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ', |
| 145 |
& 'error in parsing record:' |
| 146 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 147 |
WRITE(iUnit,'(A)') record(1:il) |
| 148 |
WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ', |
| 149 |
& 'from file="', data_file, '".' |
| 150 |
c & 'from file="', data_file(1:iLf), '".' |
| 151 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 152 |
ENDIF |
| 153 |
ENDIF |
| 154 |
C-- Only try conversion if colon found within 1rst pair of parenthesis |
| 155 |
IF ( i2.NE.0 ) THEN |
| 156 |
C check for index value between i1 and i2 |
| 157 |
IF ( i2.GT.i1+1 ) THEN |
| 158 |
is = IFNBLNK(record(i1+1:i2-1)) |
| 159 |
ie = ILNBLNK(record(i1+1:i2-1)) |
| 160 |
i = i1+is |
| 161 |
IF ( record(i:i).EQ.'-' .OR. record(i:i).EQ.'+' ) is = is+1 |
| 162 |
hasNum1 = ( is.GE.1 .AND. is.LE.ie ) |
| 163 |
IF ( hasNum1 ) THEN |
| 164 |
DO i=i1+is,i1+ie |
| 165 |
n = ICHAR(record(i:i)) |
| 166 |
IF ( n.LT.ICHAR('0') .OR. n.GT.ICHAR('9') ) hasNum1 = .FALSE. |
| 167 |
ENDDO |
| 168 |
ENDIF |
| 169 |
ELSE |
| 170 |
hasNum1 = .FALSE. |
| 171 |
ENDIF |
| 172 |
C check for index value after i2 (and before i3 or i4) |
| 173 |
ii = i4 |
| 174 |
IF ( i3.NE.0 ) ii = i3 |
| 175 |
IF ( ii.GT.i2+1 ) THEN |
| 176 |
is = IFNBLNK(record(i2+1:ii-1)) |
| 177 |
ie = ILNBLNK(record(i2+1:ii-1)) |
| 178 |
i = i2+is |
| 179 |
IF ( record(i:i).EQ.'-' .OR. record(i:i).EQ.'+' ) is = is+1 |
| 180 |
hasNum2 = ( is.GE.1 .AND. is.LE.ie ) |
| 181 |
IF ( hasNum2 ) THEN |
| 182 |
DO i=i2+is,i2+ie |
| 183 |
n = ICHAR(record(i:i)) |
| 184 |
IF ( n.LT.ICHAR('0') .OR. n.GT.ICHAR('9') ) hasNum2 = .FALSE. |
| 185 |
ENDDO |
| 186 |
ENDIF |
| 187 |
ELSE |
| 188 |
hasNum2 = .FALSE. |
| 189 |
ENDIF |
| 190 |
IF ( i3.NE.0 ) THEN |
| 191 |
C-- Colon applies to 1rst index of multidim array (found comma after colon) |
| 192 |
C Note: safe case which cannot be confused with sub-string colon |
| 193 |
IF ( hasNum1 .AND. hasNum2 ) THEN |
| 194 |
IF ( debugPrt ) WRITE(iUnit,'(3A)') |
| 195 |
& 'remove: "',record(i2:i3-1),'"' |
| 196 |
DO i=i2,i3-1 |
| 197 |
record(i:i) = ' ' |
| 198 |
ENDDO |
| 199 |
ELSE |
| 200 |
WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ', |
| 201 |
& 'invalid indices for array conversion in:' |
| 202 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 203 |
WRITE(iUnit,'(A)') record(1:il) |
| 204 |
WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ', |
| 205 |
& 'from file="', data_file, '".' |
| 206 |
c & 'from file="', data_file(1:iLf), '".' |
| 207 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 208 |
ENDIF |
| 209 |
ENDIF |
| 210 |
IF ( i3.EQ.0 .AND. nWd.NE.1 ) THEN |
| 211 |
C-- Colon applies to index of vector (single-dim array): |
| 212 |
C discard the case where colon defines sub-string of character-string variable |
| 213 |
C by assuming that in this case 1 and only 1 word follows the equal sign |
| 214 |
IF ( hasNum1 .AND. hasNum2 ) THEN |
| 215 |
IF ( debugPrt ) WRITE(iUnit,'(3A)') |
| 216 |
& 'remove: "',record(i2:i4-1),'"' |
| 217 |
DO i=i2,i4-1 |
| 218 |
record(i:i) = ' ' |
| 219 |
ENDDO |
| 220 |
ELSE |
| 221 |
WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ', |
| 222 |
& 'invalid indices for vector conversion in:' |
| 223 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 224 |
WRITE(iUnit,'(A)') record(1:il) |
| 225 |
WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ', |
| 226 |
& 'from file="', data_file, '".' |
| 227 |
c & 'from file="', data_file(1:iLf), '".' |
| 228 |
CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid ) |
| 229 |
ENDIF |
| 230 |
ENDIF |
| 231 |
C----- |
| 232 |
ENDIF |
| 233 |
#endif /* NML_EXTENDED_F77 */ |
| 234 |
|
| 235 |
RETURN |
| 236 |
END |
Parent Directory
| 
Revision Log
| 
Revision Graph