C $Header: /u/gcmpack/MITgcm/eesupp/src/nml_change_syntax.F,v 1.2 2010/12/26 02:59:37 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

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 
#ifdef NML_EXTENDED_F77
      INTEGER  IFNBLNK
      EXTERNAL 
#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
      CHARACTER*(2) nmlEnd
#ifdef NML_TERMINATOR
      PARAMETER( nmlEnd = ' /' )
#else
      PARAMETER( nmlEnd = ' &' )
#endif

#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) = nmlEnd
       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