eesupp/src/nml_change_syntax.F

C $Header: /u/gcmpack/MITgcm/eesupp/src/nml_set_terminator.F,v 1.3 2004/03/27 03:51:51 edhill Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

#ifndef NML_TERMINATOR
#define NML_TERMINATOR  ' &'
#else
#define NML_TERMINATOR  ' /'
#endif

CBOP

C     !ROUTINE: NML_CHANGE_SYNTAX

C     !INTERFACE:
      SUBROUTINE NML_CHANGE_SYNTAX(
     U                              record,
     I                              data_file, myThid )
C     !DESCRIPTION:
C     *=================================================================*
C     | SUBROUTINE NML\_CHANGE\_SYNTAX
C     | o Apply changes to namelist to fit compiler requirement
C     *=================================================================*
C     | Change trailing \& to trailing / when needed
C     | Change array specification from F95 standard
C     |        to commonly accepted F77 form (extented F77)
C     *=================================================================*

C     !USES:
      IMPLICIT NONE

C     == Global variables ==
#include "EEPARAMS.h"

C     !FUNCTIONS:
      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK
#ifdef NML_EXTENDED_F77
      INTEGER  IFNBLNK
      EXTERNAL IFNBLNK
#endif /* NML_EXTENDED_F77 */

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     record    :: current line record (from parameter file) to process
C     data_file :: current parameter file which contains the current record
C     myThid    :: my Thread Id number
      CHARACTER*(MAX_LEN_PREC) record
      CHARACTER*(*) data_file
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
      INTEGER il
#ifdef NML_EXTENDED_F77
C     i0      :: position of active "=" (end of variable name definition)
C     i1      :: position of 1rst left parenthesis
C     i2      :: position of 1rst colon
C     i3      :: position of 1rst comma after the 1rst colon
C     i4      :: position of right parenthesis after the 1rst left one
C     nWd     :: number of words following "=" found in this reccord
C     msgBuf  :: Informational/error message buffer
      INTEGER i0, i1, i2, i3, i4
      INTEGER nWd, is, ie, iUnit
      INTEGER i, n, ii
c     INTEGER iLf
      LOGICAL sngQ, dblQ, comma
      LOGICAL hasNum1, hasNum2
      LOGICAL debugPrt
      CHARACTER*(MAX_LEN_MBUF) msgBuf
#endif /* NML_EXTENDED_F77 */
CEOP

      il = MAX(ILNBLNK(record),1)
      IF ( il .EQ. 2 ) THEN
       IF ( record(1:2) .EQ. ' &' ) THEN
        record(1:2) = NML_TERMINATOR
       ENDIF
      ENDIF

#ifdef NML_EXTENDED_F77
      debugPrt = .FALSE.
c     iLf = MAX(ILNBLNK(data_file),1)
      iUnit = errorMessageUnit
      i0 = 0
      i1 = 0
      i2 = 0
      i3 = 0
      i4 = 0
C--   search for end of variable spec ('=' char) and count words that follow
      nWd = 0
      sngQ  = .TRUE.
      dblQ  = .TRUE.
      comma = .FALSE.
      DO i=1,il
        IF ( record(i:i).EQ."'" .AND. dblQ ) THEN
          sngQ = .NOT.sngQ
          IF ( i0.GE.1 .AND. sngQ ) nWd = nWd + 1
        ENDIF
        IF ( record(i:i).EQ.'"' .AND. sngQ ) THEN
          dblQ = .NOT.dblQ
          IF ( i0.GE.1 .AND. dblQ ) nWd = nWd + 1
        ENDIF
        IF ( record(i:i).EQ.'='  .AND. i0.EQ.0
     &                .AND. sngQ .AND. dblQ ) i0 = i
      ENDDO
C--   find position of 1rst set of parenthesis, comma and colon
      DO i=1,i0
        IF ( record(i:i).EQ.'(' .AND. i1.EQ.0 ) i1 = -i
        IF ( record(i:i).EQ.':' .AND. i1.LT.0 ) THEN
          IF ( i2.EQ.0 ) i2 = i
          IF ( comma ) THEN
            WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: warning: ',
     &                           'no possible safe conversion of rec:'
            CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
            WRITE(iUnit,'(A)') record(1:il)
            WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
     &                           'from file="', data_file, '".'
c    &                           'from file="', data_file(1:iLf), '".'
            CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
            i1 = 1
          ENDIF
        ENDIF
        IF ( record(i:i).EQ.',' .AND. i1.LT.0 ) THEN
          comma = .TRUE.
          IF ( i3.EQ.0 .AND. i2.GE.1 ) i3 = i
        ENDIF
        IF ( record(i:i).EQ.')' .AND. i1.LT.0 ) THEN
          i1 = -i1
          i4 = i
        ENDIF
      ENDDO
      IF ( debugPrt .AND. i0.GE.1 ) THEN
c       WRITE(iUnit,'(5A)') ' ', data_file(1:iLf),
c    &               ' , rec >', record(1:i0), '<'
        WRITE(iUnit,'(5A)') ' ',data_file,' , rec >',record(1:i0),'<'
        WRITE(iUnit,'(A,2I4,L5,A,4I4)')
     &  '  i0,nWd,comma =',i0,nWd,comma,' ; i1,i2,i3,i4 =',i1,i2,i3,i4
      ENDIF
      IF ( i4.EQ.0 .AND. i1.NE.0 ) THEN
        i2 = 0
        IF ( i1.NE.1 ) THEN
          WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ',
     &                         'error in parsing record:'
          CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
          WRITE(iUnit,'(A)') record(1:il)
          WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
     &                          'from file="', data_file, '".'
c    &                          'from file="', data_file(1:iLf), '".'
          CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
        ENDIF
      ENDIF
C--   Only try conversion if colon found within 1rst pair of parenthesis
      IF ( i2.NE.0 ) THEN
C     check for index value between i1 and i2
       IF ( i2.GT.i1+1 ) THEN
         is = IFNBLNK(record(i1+1:i2-1))
         ie = ILNBLNK(record(i1+1:i2-1))
         i = i1+is
         IF ( record(i:i).EQ.'-' .OR.  record(i:i).EQ.'+' ) is = is+1
         hasNum1 = ( is.GE.1 .AND. is.LE.ie )
         IF ( hasNum1 ) THEN
          DO i=i1+is,i1+ie
           n = ICHAR(record(i:i))
           IF ( n.LT.ICHAR('0') .OR. n.GT.ICHAR('9') ) hasNum1 = .FALSE.
          ENDDO
         ENDIF
       ELSE
         hasNum1 = .FALSE.
       ENDIF
C     check for index value after i2 (and before i3 or i4)
       ii = i4
       IF ( i3.NE.0 ) ii = i3
       IF ( ii.GT.i2+1 ) THEN
         is = IFNBLNK(record(i2+1:ii-1))
         ie = ILNBLNK(record(i2+1:ii-1))
         i = i2+is
         IF ( record(i:i).EQ.'-' .OR.  record(i:i).EQ.'+' ) is = is+1
         hasNum2 = ( is.GE.1 .AND. is.LE.ie )
         IF ( hasNum2 ) THEN
          DO i=i2+is,i2+ie
           n = ICHAR(record(i:i))
           IF ( n.LT.ICHAR('0') .OR. n.GT.ICHAR('9') ) hasNum2 = .FALSE.
          ENDDO
         ENDIF
       ELSE
         hasNum2 = .FALSE.
       ENDIF
       IF ( i3.NE.0 ) THEN
C--   Colon applies to 1rst index of multidim array (found comma after colon)
C     Note: safe case which cannot be confused with sub-string colon
         IF ( hasNum1 .AND. hasNum2 ) THEN
           IF ( debugPrt ) WRITE(iUnit,'(3A)')
     &                           'remove: "',record(i2:i3-1),'"'
           DO i=i2,i3-1
             record(i:i) = ' '
           ENDDO
         ELSE
           WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ',
     &                  'invalid indices for array conversion in:'
           CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
           WRITE(iUnit,'(A)') record(1:il)
           WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
     &                          'from file="', data_file, '".'
c    &                          'from file="', data_file(1:iLf), '".'
           CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
         ENDIF
       ENDIF
       IF ( i3.EQ.0 .AND. nWd.NE.1 ) THEN
C--   Colon applies to index of vector (single-dim array):
C     discard the case where colon defines sub-string of character-string variable
C     by assuming that in this case 1 and only 1 word follows the equal sign
         IF ( hasNum1 .AND. hasNum2 ) THEN
           IF ( debugPrt ) WRITE(iUnit,'(3A)')
     &                           'remove: "',record(i2:i4-1),'"'
           DO i=i2,i4-1
             record(i:i) = ' '
           ENDDO
         ELSE
           WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ',
     &                  'invalid indices for vector conversion in:'
           CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
           WRITE(iUnit,'(A)') record(1:il)
           WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
     &                          'from file="', data_file, '".'
c    &                          'from file="', data_file(1:iLf), '".'
           CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
         ENDIF
       ENDIF
C-----
      ENDIF
#endif /* NML_EXTENDED_F77 */

      RETURN
      END
1	jmc	1.1	C $Header: /u/gcmpack/MITgcm/eesupp/src/nml_set_terminator.F,v 1.3 2004/03/27 03:51:51 edhill Exp $
2			C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6			#ifndef NML_TERMINATOR
7			#define NML_TERMINATOR ' &'
8			#else
9			#define NML_TERMINATOR ' /'
10			#endif
11
12			CBOP
13
14			C !ROUTINE: NML_CHANGE_SYNTAX
15
16			C !INTERFACE:
17			SUBROUTINE NML_CHANGE_SYNTAX(
18			U record,
19			I data_file, myThid )
20			C !DESCRIPTION:
21			C =================================================================
22			C \| SUBROUTINE NML\_CHANGE\_SYNTAX
23			C \| o Apply changes to namelist to fit compiler requirement
24			C =================================================================
25			C \| Change trailing \& to trailing / when needed
26			C \| Change array specification from F95 standard
27			C \| to commonly accepted F77 form (extented F77)
28			C =================================================================
29
30			C !USES:
31			IMPLICIT NONE
32
33			C == Global variables ==
34			#include "EEPARAMS.h"
35
36			C !FUNCTIONS:
37			INTEGER ILNBLNK
38			EXTERNAL ILNBLNK
39			#ifdef NML_EXTENDED_F77
40			INTEGER IFNBLNK
41			EXTERNAL IFNBLNK
42			#endif /* NML_EXTENDED_F77 */
43
44			C !INPUT/OUTPUT PARAMETERS:
45			C == Routine arguments ==
46			C record :: current line record (from parameter file) to process
47			C data_file :: current parameter file which contains the current record
48			C myThid :: my Thread Id number
49			CHARACTER*(MAX_LEN_PREC) record
50			CHARACTER() data_file
51			INTEGER myThid
52
53			C !LOCAL VARIABLES:
54			C == Local variables ==
55			INTEGER il
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) = NML_TERMINATOR
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