carlu.f

Go to the documentation of this file.

!                   *********************************
                    CHARACTER(LEN=PATH_LEN) FUNCTION carlu
!                   *********************************
!
     &( lcar   , icol  , ligne  , extrem , motcle , SIZE , motign ,
     &  lonign , nmaxr , nficda , lgvar  )
!
!***********************************************************************
! DAMOCLES   V7P0                                   21/08/2010
!***********************************************************************
!
!brief    DECODES A CHARACTER STRING, FROM COLUMN ICOL+1 OF THE
!+             CURRENT LINE (MAXIMUM OF LGA CHARACTERS).
!+             IF THE STRING IS NOT COMPLETE, GOES TO THE NEXT LINE
!+             IF NEED BE.
!+             MOVES THE POINTER ICOL TO THE LAST DECODED CHARACTER
!+             OR TO ICOL=0 IF THE NEXT LINE WAS READ WITH NO REASON.
!
!note     PORTABILITY : IBM,CRAY,HP,SUN
!
!warning  FOLLOWS THE FORTRAN CONVENTION : '' IS READ AS
!+            ' WHEN WITHIN A CHARACTER STRING
!+
!warning  STRINGS WITHOUT ' OR " CANNOT CONTAIN SEPARATOR
!+            CHARACTERS
!
!history  O. QUIQUEMPOIX (LNH)
!+        14/12/1993
!+
!+
!
!history  J.M. HERVOUET (LNH); A. YESSAYAN
!+        16/08/1994
!+        V5P1
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  J.M. HERVOUET (EDF R&D, LNHE)
!+        31/12/2013
!+        V7P0
!+   Prints of LIGNED limited to maximum size LGVAR.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| EXTREM         |-->| SEPARATEUR DE CHAINE = ' OU "
!| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
!| LCAR           |<--| LONGUEUR DE LA CHAINE DE CARACTERES
!| LGVAR          |-->| LONGUEUR MAXIMUM DE LA CHAINE A LIRE
!| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
!| LONIGN         |-->| TABLEAU DES LONGUEURS DES MOTS EDAMOX
!| MOTCLE         |-->| TABLEAU DES MOTS CLES ACTIFS
!| MOTIGN         |-->| TABLEAU DES MOTS CLES DUS A EDAMOX A IGNORER
!| NFICDA         |-->| NUMERO DE CANAL DU FICHIER DES DONNEES
!| NMAXR          |-->| TABLEAU DES INDEX MAXIMUM REELS PAR TYPES
!| SIZE           |-->| TABLEAU DES LONGUEURS DES MOTS CLES
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_damocles
      USE declarations_special
      IMPLICIT NONE
!
      INTEGER       LCAR,ICOL,NMAXR(4),NFICDA,LGVAR,SIZE(4,*)
      INTEGER       LONIGN(100)
      CHARACTER(LEN=*) LIGNE
      CHARACTER(LEN=1) EXTREM
      CHARACTER(LEN=72) MOTIGN(100),MOTCLE(4,*)
!
      INTEGER  NEXT,PRECAR,LONGLU
      EXTERNAL next,precar,longlu
!
!-----------------------------------------------------------------------
!
      INTEGER       I,IDEB,IFIN,NCAR,ICOL2,NLIGN2,ITYP,K,LGLU
      INTEGER    :: LONPRO(15)
      INTEGER       QCAS
      LOGICAL       COTE,LISUIV,LUFIC,LUCOTE
      CHARACTER(LEN=1)   QUOTE,TABUL
      CHARACTER(LEN=9)   :: MOTPRO(15)
      CHARACTER(LEN=72)  LIGNE2
      CHARACTER(LEN=PATH_LEN) LIGNED
!
!-----------------------------------------------------------------------
!
      INTRINSIC char
!
!-----------------------------------------------------------------------
!
      parameter( motpro = (/
     &  'NOM      ','TYPE     ','INDEX    ','TAILLE   ','DEFAUT   ',
     &  'AIDE     ','CHOIX    ','RUBRIQUE ','NIVEAU   ','MNEMO    ',
     &  'COMPOSE  ','COMPORT  ','CONTROLE ','APPARENCE','SUBMIT   ' /) )
!
!     LENGTH OF PROTECTED WORDS
!
      parameter( lonpro = (/ 3,4,5,6,6,4,5,8,6,5,7,7,8,9,6 /) )
!
!***********************************************************************
!                                    RCS AND SCCS MARKING
!
!***********************************************************************
!
      cote   = .false.
      lisuiv = .false.
      lufic  = .false.
      lucote = .false.
      lcar   = 1
      carlu  = ' '
      quote  = ''''
      tabul  = char(9)
      nlign2 = nlign
      icol2  = icol
      ligne2 = ligne(1:min(72,len(ligne)))
      ligned = ' '
      lglu   = 0
      qcas   = 0
!
      icol   = next( icol+1 , ligne )
!
!        //// FINDS THE ENDS OF THE STRING ////
!
!    NOTE: THE STRING CAN BE BETWEEN QUOTES OR WITHOUT QUOTES
!          IT CANNOT CONTAIN WHITE CHARACTERS IF THERE ARE
!          NO QUOTES
!
      IF ( ligne(icol:icol).NE.extrem ) THEN
        ideb = icol
!              PRECAR : SAME ROLE AS PREVAL, EXCEPT IT DOES NOT
!                       SKIP COMMENTED LINES
        icol = precar( icol+1 , ligne , ' ' , ';' , tabul) - 1
        ifin = icol
        ligned = ligne(ideb:ifin)
        lglu = ifin-ideb+1
!
! STEERING FILE : GOES TO THE NEXT, WHEN GETS TO THE END OF A LINE
!
290     IF (ifin.GE.longli) THEN
          lisuiv = .true.
          lufic = .true.
          READ(nfic,end=900,err=998,fmt='(A)') ligne2
          icol2 = 0
          IF (ligne2(1:1).EQ.'&'.OR.
     &        ligne2(1:1).EQ.'='.OR.ligne2(1:1).EQ.':'.OR.
     &        ligne2(1:1).EQ.';'.OR.ligne2(1:1).EQ.'/' ) THEN
            lisuiv = .false.
            GO TO 96
          ENDIF
!
! CHECKS IF IT'S A KNOWN KEYWORD FOR THE STEERING FILE
!
          IF (nfic.EQ.nficda) THEN
            DO ityp = 1,4
              DO i=1,nmaxr(ityp)
!               K=LONGLU(MOTCLE(ITYP,I))
                k=SIZE(ityp,i)
                IF (k.GT.0.AND.ligne2(1:k).EQ.motcle(ityp,i)(1:k)) THEN
                  lisuiv = .false.
                  GO TO 96
                ENDIF
              ENDDO ! I
            ENDDO ! ITYP
            DO i=1,100
!             K = LONGLU(MOTIGN(I))
              k = lonign(i)
              IF(k.GT.0.AND.ligne2(1:k).EQ.motign(i)(1:k)) THEN
                lisuiv = .false.
                GO TO 96
              ENDIF
            ENDDO ! I
          ELSE
            DO i=1,15
!             K = LONGLU(MOTPRO(I))
              k = lonpro(i)
              IF(k.GT.0.AND.ligne2(1:k).EQ.motpro(i)(1:k)) THEN
                lisuiv = .false.
                GO TO 96
              ENDIF
            ENDDO ! I
          ENDIF
!
! GETS TO THIS POINT IF/WHEN HAS TO READ THE NEXT LINE
!
          icol2 =precar(1 , ligne2 , ' ' , tabul ,' ') - 1
!
          lglu = lglu + icol2
!
          IF(lglu.GT.lgvar) THEN
            erreur = .true.
            IF (longlu(ligned).GT.0) THEN
              ligned = ligned(1:longlu(ligned))//ligne2(1:icol2)
            ELSE
              ligned = ligne2(1:icol2)
            ENDIF
            IF(lglu.GT.0) WRITE(lu,'(1X,A)')
     &               ligned(1:min(lglu,path_len))
            WRITE(lu,*) ' '
            WRITE(lu,'(1X,A5,I4,1X,A23)') 'LINE: ',nlign,
     &              'ERROR : STRING TOO LONG'
            icol = icol -1
            GO TO 1000
          ELSE
!           NEEDS TO READ ANOTHER LINE - SIMULATES A SHIFT OF LINE
            lisuiv = .false.
            ligne = ligne2
            IF (longlu(ligned).GT.0) THEN
              ligned = ligned(1:longlu(ligned))//ligne2(1:longli)
            ELSE
              ligned = ligne2(1:longli)
            ENDIF
            nlign = nlign2
            icol = icol2
            ifin = longli+1
            GO TO 290
          ENDIF
  96      IF(lisuiv) THEN
            IF(longlu(ligned).GT.0) THEN
              ligned = ligned(1:longlu(ligned))//ligne2(1:icol2)
            ELSE
              ligned = ligne2(1:longli)
            ENDIF
            ifin = lglu+icol2
            ideb = 1
          ENDIF
        ENDIF
!
        GO TO 901
 900    CONTINUE
        retour = .true.
 901    CONTINUE
        DO i = 1 , lglu
          IF (ligned(i:i).EQ.quote.OR.ligned(i:i).EQ.'&'.OR.
     &       ligned(i:i).EQ.'='.OR.ligned(i:i).EQ.':'.OR.
     &       ligned(i:i).EQ.'/') THEN
            IF (nlign2.NE.nlign.AND.(.NOT.(lufic)))
     &             WRITE(lu,'(1X,A)') ligne2(1:longli)
            IF (lglu.GT.0) WRITE(lu,'(1X,A)') ligned(1:lglu)
              WRITE(lu,'(1X,A5,I4,A)') 'LINE: ',nlign,
     &       ' ERROR: UNEXPECTED CHARACTER IN A STRING WITHOUT QUOTES'
            erreur = .true.
            GO TO 1000
          ENDIF
        ENDDO ! I
!
      ELSE
!
! CASE WHERE THERE ARE QUOTES
!
        ideb = icol + 1
!
! THE 1ST QUOTE IS IN LAST POSITION (QCAS=4 OR QCAS=5)
        IF (icol.EQ.longli) qcas=45
!
 100    icol   = precar( icol+1 , ligne , extrem , extrem , extrem )
        IF (icol.EQ.longli) icol = longli+1
!
! CASE WHERE DOUBLE QUOTES CAN BE FOUND IN THE 1ST LINE EXCEPT IN COLUMN 72
!
        IF(icol.LT.longli) THEN
          IF(ligne(icol+1:icol+1).EQ.extrem.AND.extrem.EQ.quote) THEN
            icol = icol + 1
! THE QUOTE IN 72 IS THE 2ND QUOTE OF A DOUBLE QUOTE (QCAS=3)
            IF (icol.EQ.longli) qcas=3
            cote = .true.
            GO TO 100
          ENDIF
        ENDIF
!
        lglu = max(0,icol-ideb)
        IF (lglu.GT.0) ligned = ligne(ideb:icol-1)
!
! HAS NOT FOUND THE END, OR A QUOTE WAS FOUND IN COLUMN 72
!
        IF (icol.GT.longli) THEN
390       lisuiv = .true.
          lufic = .true.
          READ(nfic,end=905,err=998,fmt='(A)') ligne2
!
! CASE WHERE THE PRECEDING LINE ENDS WITH A QUOTE
!
          IF (ligne(longli:longli).EQ.quote) THEN
! THE QUOTE IN COLUMN 72 STARTS A STRING, OR IS THE 2ND OF A DOUBLE QUOTE
            IF (qcas.EQ.45.OR.qcas.EQ.3) THEN
              qcas=0
            ELSEIF (ligne2(1:1).EQ.quote) THEN
              cote = .true.
              lucote = .true.
              qcas=0
            ELSE
              lglu=lglu-1
              IF (lglu.GT.0) ligned = ligned(1:lglu)
              lisuiv = .false.
              qcas=0
              GO TO 920
            ENDIF
          ENDIF
!
          icol2 = 0
          IF(ligne2(1:1).EQ.quote.AND.lucote) THEN
            lucote = .false.
            icol2=1
          ENDIF
 110      icol2 =precar(icol2+1,ligne2,extrem,extrem,extrem)
          IF(icol2.LT.longli) THEN
          IF(ligne2(icol2+1:icol2+1).EQ.
     &      extrem.AND.extrem.EQ.quote) THEN
!           ICOL2 = PRECAR(ICOL2+1,LIGNE2,EXTREM,EXTREM,EXTREM)
            icol2=icol2+1
            cote=.true.
            IF (icol2.EQ.longli) qcas=3
            GO TO 110
          ENDIF
          ENDIF
          IF(icol2.EQ.longli) icol2=icol2+1
          IF(lglu.GT.0) THEN
            ligned = ligned(1:lglu)//ligne2(1:icol2-1)
          ELSE
            ligned = ligne2(1:icol2-1)
          ENDIF
          lglu = lglu + icol2-1
!
          IF(lglu.GT.lgvar) GO TO 910
!
! GOES TO NEXT LINE IF NOT COMPLETE, OR IF HAS FOUND A QUOTE IN 72
!
          IF(icol2.GE.longli) THEN
            lisuiv = .false.
            ligne = ligne2
            nlign = nlign2
            icol = icol2
            ifin = icol2
            GO TO 390
          ENDIF
! HERE IT'S OK
          GO TO 920
!
 905      CONTINUE
          retour = .true.
!
 910      CONTINUE
          WRITE(lu,'(1X,A)') ligned(1:max(1,min(lglu,lgvar)))
          WRITE(lu,*)
          WRITE(lu,'(1X,A5,I4,A)') 'LINE: ',nlign,
     &    ' ERROR: QUOTE MISSING AT THE END OF THE STRING'
          WRITE(lu,*)'OR STRING TOO LONG ... '
          erreur = .true.
          icol = longli
          GO TO 1000
!
        ENDIF
        ifin   = icol - 1
      ENDIF
!
 920  CONTINUE
      IF(lglu.NE.0) THEN
        lcar = min(lglu,lgvar)
        carlu = ligned(1:lglu)
      ENDIF
!
!  CHANGES DOUBLE QUOTES WITH SIMPLE QUOTES
!
      IF(cote) THEN
        ncar = lcar
        i = 1
 200    CONTINUE
        IF(i.GT.ncar) THEN
          lcar = ncar
          GO TO 1000
        ENDIF
        IF(carlu(i:i).EQ.quote.AND.carlu(i+1:i+1).EQ.quote) THEN
          carlu(i+1:lcar) = carlu(i+2:lcar)//' '
          ncar = ncar - 1
        ENDIF
        i = i + 1
        GO TO 200
      ENDIF
!
1000  CONTINUE
!
      IF (lufic) THEN
        nlign = nlign + 1
        ligne = ligne2
        IF (lisuiv) THEN
          icol = icol2
        ELSE
          icol = 0
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
!
998   CONTINUE
      WRITE(lu,1999) nfic,nlign+1
1999  FORMAT(1x,'LOGICAL UNIT ',1i2,'   ERROR LINE ',1i6)
      retour = .true.
      RETURN
!
!-----------------------------------------------------------------------
!
      END