Back to home page

darwin3
 
 

    

File indexing completed on 2024-12-17 18:31:05 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
51083a172e Jean*0001 #include "CPP_EEOPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: NML_CHANGE_SYNTAX
                0005 
                0006 C     !INTERFACE:
                0007       SUBROUTINE NML_CHANGE_SYNTAX(
                0008      U                              record,
                0009      I                              data_file, myThid )
                0010 C     !DESCRIPTION:
                0011 C     *=================================================================*
                0012 C     | SUBROUTINE NML\_CHANGE\_SYNTAX
                0013 C     | o Apply changes to namelist to fit compiler requirement
                0014 C     *=================================================================*
                0015 C     | Change trailing \& to trailing / when needed
                0016 C     | Change array specification from F95 standard
                0017 C     |        to commonly accepted F77 form (extented F77)
                0018 C     *=================================================================*
                0019 
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022 
                0023 C     == Global variables ==
                0024 #include "EEPARAMS.h"
                0025 
                0026 C     !FUNCTIONS:
                0027       INTEGER  ILNBLNK
                0028       EXTERNAL ILNBLNK
                0029 #ifdef NML_EXTENDED_F77
                0030       INTEGER  IFNBLNK
                0031       EXTERNAL IFNBLNK
                0032 #endif /* NML_EXTENDED_F77 */
                0033 
                0034 C     !INPUT/OUTPUT PARAMETERS:
                0035 C     == Routine arguments ==
                0036 C     record    :: current line record (from parameter file) to process
                0037 C     data_file :: current parameter file which contains the current record
                0038 C     myThid    :: my Thread Id number
                0039       CHARACTER*(MAX_LEN_PREC) record
                0040       CHARACTER*(*) data_file
                0041       INTEGER myThid
                0042 
                0043 C     !LOCAL VARIABLES:
                0044 C     == Local variables ==
                0045       INTEGER il
fc4fa6fbcd Jean*0046       CHARACTER*(2) nmlEnd
                0047 #ifdef NML_TERMINATOR
                0048       PARAMETER( nmlEnd = ' /' )
                0049 #else
                0050       PARAMETER( nmlEnd = ' &' )
                0051 #endif
                0052 
51083a172e Jean*0053 #ifdef NML_EXTENDED_F77
                0054 C     i0      :: position of active "=" (end of variable name definition)
                0055 C     i1      :: position of 1rst left parenthesis
                0056 C     i2      :: position of 1rst colon
                0057 C     i3      :: position of 1rst comma after the 1rst colon
                0058 C     i4      :: position of right parenthesis after the 1rst left one
                0059 C     nWd     :: number of words following "=" found in this reccord
                0060 C     msgBuf  :: Informational/error message buffer
                0061       INTEGER i0, i1, i2, i3, i4
                0062       INTEGER nWd, is, ie, iUnit
                0063       INTEGER i, n, ii
                0064 c     INTEGER iLf
                0065       LOGICAL sngQ, dblQ, comma
                0066       LOGICAL hasNum1, hasNum2
                0067       LOGICAL debugPrt
                0068       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0069 #endif /* NML_EXTENDED_F77 */
                0070 CEOP
                0071 
                0072       il = MAX(ILNBLNK(record),1)
                0073       IF ( il .EQ. 2 ) THEN
                0074        IF ( record(1:2) .EQ. ' &' ) THEN
fc4fa6fbcd Jean*0075         record(1:2) = nmlEnd
51083a172e Jean*0076        ENDIF
                0077       ENDIF
                0078 
                0079 #ifdef NML_EXTENDED_F77
                0080       debugPrt = .FALSE.
                0081 c     iLf = MAX(ILNBLNK(data_file),1)
                0082       iUnit = errorMessageUnit
                0083       i0 = 0
                0084       i1 = 0
                0085       i2 = 0
                0086       i3 = 0
                0087       i4 = 0
                0088 C--   search for end of variable spec ('=' char) and count words that follow
                0089       nWd = 0
                0090       sngQ  = .TRUE.
                0091       dblQ  = .TRUE.
                0092       comma = .FALSE.
                0093       DO i=1,il
                0094         IF ( record(i:i).EQ."'" .AND. dblQ ) THEN
                0095           sngQ = .NOT.sngQ
                0096           IF ( i0.GE.1 .AND. sngQ ) nWd = nWd + 1
                0097         ENDIF
                0098         IF ( record(i:i).EQ.'"' .AND. sngQ ) THEN
                0099           dblQ = .NOT.dblQ
                0100           IF ( i0.GE.1 .AND. dblQ ) nWd = nWd + 1
                0101         ENDIF
                0102         IF ( record(i:i).EQ.'='  .AND. i0.EQ.0
                0103      &                .AND. sngQ .AND. dblQ ) i0 = i
                0104       ENDDO
                0105 C--   find position of 1rst set of parenthesis, comma and colon
                0106       DO i=1,i0
                0107         IF ( record(i:i).EQ.'(' .AND. i1.EQ.0 ) i1 = -i
                0108         IF ( record(i:i).EQ.':' .AND. i1.LT.0 ) THEN
                0109           IF ( i2.EQ.0 ) i2 = i
                0110           IF ( comma ) THEN
                0111             WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: warning: ',
                0112      &                           'no possible safe conversion of rec:'
                0113             CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0114             WRITE(iUnit,'(A)') record(1:il)
                0115             WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
                0116      &                           'from file="', data_file, '".'
                0117 c    &                           'from file="', data_file(1:iLf), '".'
                0118             CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0119             i1 = 1
                0120           ENDIF
                0121         ENDIF
                0122         IF ( record(i:i).EQ.',' .AND. i1.LT.0 ) THEN
                0123           comma = .TRUE.
                0124           IF ( i3.EQ.0 .AND. i2.GE.1 ) i3 = i
                0125         ENDIF
                0126         IF ( record(i:i).EQ.')' .AND. i1.LT.0 ) THEN
                0127           i1 = -i1
                0128           i4 = i
                0129         ENDIF
                0130       ENDDO
                0131       IF ( debugPrt .AND. i0.GE.1 ) THEN
                0132 c       WRITE(iUnit,'(5A)') ' ', data_file(1:iLf),
                0133 c    &               ' , rec >', record(1:i0), '<'
                0134         WRITE(iUnit,'(5A)') ' ',data_file,' , rec >',record(1:i0),'<'
                0135         WRITE(iUnit,'(A,2I4,L5,A,4I4)')
                0136      &  '  i0,nWd,comma =',i0,nWd,comma,' ; i1,i2,i3,i4 =',i1,i2,i3,i4
                0137       ENDIF
                0138       IF ( i4.EQ.0 .AND. i1.NE.0 ) THEN
                0139         i2 = 0
                0140         IF ( i1.NE.1 ) THEN
                0141           WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ',
                0142      &                         'error in parsing record:'
                0143           CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0144           WRITE(iUnit,'(A)') record(1:il)
                0145           WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
                0146      &                          'from file="', data_file, '".'
                0147 c    &                          'from file="', data_file(1:iLf), '".'
                0148           CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0149         ENDIF
                0150       ENDIF
                0151 C--   Only try conversion if colon found within 1rst pair of parenthesis
                0152       IF ( i2.NE.0 ) THEN
                0153 C     check for index value between i1 and i2
                0154        IF ( i2.GT.i1+1 ) THEN
                0155          is = IFNBLNK(record(i1+1:i2-1))
                0156          ie = ILNBLNK(record(i1+1:i2-1))
                0157          i = i1+is
                0158          IF ( record(i:i).EQ.'-' .OR.  record(i:i).EQ.'+' ) is = is+1
                0159          hasNum1 = ( is.GE.1 .AND. is.LE.ie )
                0160          IF ( hasNum1 ) THEN
                0161           DO i=i1+is,i1+ie
                0162            n = ICHAR(record(i:i))
                0163            IF ( n.LT.ICHAR('0') .OR. n.GT.ICHAR('9') ) hasNum1 = .FALSE.
                0164           ENDDO
                0165          ENDIF
                0166        ELSE
                0167          hasNum1 = .FALSE.
                0168        ENDIF
                0169 C     check for index value after i2 (and before i3 or i4)
                0170        ii = i4
                0171        IF ( i3.NE.0 ) ii = i3
                0172        IF ( ii.GT.i2+1 ) THEN
                0173          is = IFNBLNK(record(i2+1:ii-1))
                0174          ie = ILNBLNK(record(i2+1:ii-1))
                0175          i = i2+is
                0176          IF ( record(i:i).EQ.'-' .OR.  record(i:i).EQ.'+' ) is = is+1
                0177          hasNum2 = ( is.GE.1 .AND. is.LE.ie )
                0178          IF ( hasNum2 ) THEN
                0179           DO i=i2+is,i2+ie
                0180            n = ICHAR(record(i:i))
                0181            IF ( n.LT.ICHAR('0') .OR. n.GT.ICHAR('9') ) hasNum2 = .FALSE.
                0182           ENDDO
                0183          ENDIF
                0184        ELSE
                0185          hasNum2 = .FALSE.
                0186        ENDIF
                0187        IF ( i3.NE.0 ) THEN
                0188 C--   Colon applies to 1rst index of multidim array (found comma after colon)
                0189 C     Note: safe case which cannot be confused with sub-string colon
                0190          IF ( hasNum1 .AND. hasNum2 ) THEN
                0191            IF ( debugPrt ) WRITE(iUnit,'(3A)')
                0192      &                           'remove: "',record(i2:i3-1),'"'
                0193            DO i=i2,i3-1
                0194              record(i:i) = ' '
                0195            ENDDO
                0196          ELSE
                0197            WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ',
                0198      &                  'invalid indices for array conversion in:'
                0199            CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0200            WRITE(iUnit,'(A)') record(1:il)
                0201            WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
                0202      &                          'from file="', data_file, '".'
                0203 c    &                          'from file="', data_file(1:iLf), '".'
                0204            CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0205          ENDIF
                0206        ENDIF
                0207        IF ( i3.EQ.0 .AND. nWd.NE.1 ) THEN
                0208 C--   Colon applies to index of vector (single-dim array):
                0209 C     discard the case where colon defines sub-string of character-string variable
                0210 C     by assuming that in this case 1 and only 1 word follows the equal sign
                0211          IF ( hasNum1 .AND. hasNum2 ) THEN
                0212            IF ( debugPrt ) WRITE(iUnit,'(3A)')
                0213      &                           'remove: "',record(i2:i4-1),'"'
                0214            DO i=i2,i4-1
                0215              record(i:i) = ' '
                0216            ENDDO
                0217          ELSE
                0218            WRITE(msgBuf,'(2A)') 'NML_CHANGE_SYNTAX: ',
                0219      &                  'invalid indices for vector conversion in:'
                0220            CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0221            WRITE(iUnit,'(A)') record(1:il)
                0222            WRITE(msgBuf,'(4A)') 'NML_CHANGE_SYNTAX: ',
                0223      &                          'from file="', data_file, '".'
                0224 c    &                          'from file="', data_file(1:iLf), '".'
                0225            CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
                0226          ENDIF
                0227        ENDIF
                0228 C-----
                0229       ENDIF
                0230 #endif /* NML_EXTENDED_F77 */
                0231 
                0232       RETURN
                0233       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/darwinproject/darwin3 by the 2.3.7-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!