carlu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\carlu.f
00002 !
00074                      CHARACTER(LEN=144) FUNCTION CARLU
00075 !                    *********************************
00076 !
00077      &( LCAR   , ICOL  , LIGNE  , EXTREM , MOTCLE , SIZE , MOTIGN ,
00078      &  LONIGN , NMAXR , NFICDA , LGVAR  )
00079 !
00080 !***********************************************************************
00081 ! DAMOCLES   V7P0                                   21/08/2010
00082 !***********************************************************************
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00093 !| EXTREM         |-->| SEPARATEUR DE CHAINE = ' OU "
00094 !| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
00095 !| LCAR           |<--| LONGUEUR DE LA CHAINE DE CARACTERES
00096 !| LGVAR          |-->| LONGUEUR MAXIMUM DE LA CHAINE A LIRE
00097 !| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
00098 !| LONIGN         |-->| TABLEAU DES LONGUEURS DES MOTS EDAMOX
00099 !| MOTCLE         |-->| TABLEAU DES MOTS CLES ACTIFS
00100 !| MOTIGN         |-->| TABLEAU DES MOTS CLES DUS A EDAMOX A IGNORER
00101 !| NFICDA         |-->| NUMERO DE CANAL DU FICHIER DES DONNEES
00102 !| NMAXR          |-->| TABLEAU DES INDEX MAXIMUM REELS PAR TYPES
00103 !| SIZE           |-->| TABLEAU DES LONGUEURS DES MOTS CLES
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !
00106       IMPLICIT NONE
00107 !
00108       INTEGER       LCAR,ICOL,NMAXR(4),NFICDA,LGVAR,SIZE(4,*)
00109       INTEGER       LONIGN(100)
00110       CHARACTER(LEN=*) LIGNE
00111       CHARACTER(LEN=1) EXTREM
00112       CHARACTER(LEN=72) MOTIGN(100),MOTCLE(4,*)
00113 !
00114       INTEGER  NEXT,PRECAR,LONGLU
00115       EXTERNAL NEXT,PRECAR,LONGLU
00116 !
00117       INTEGER       LNG,LU
00118       INTEGER       NLIGN,LONGLI
00119       INTEGER       NFIC
00120       LOGICAL       ERREUR , RETOUR
00121 !
00122 !-----------------------------------------------------------------------
00123 !
00124       INTEGER       I,IDEB,IFIN,NCAR,ICOL2,NLIGN2,ITYP,K,LGLU,LONPRO(15)
00125       INTEGER       QCAS
00126       LOGICAL       COTE,LISUIV,LUFIC,LUCOTE
00127       CHARACTER(LEN=1)   QUOTE,TABUL
00128       CHARACTER(LEN=9)   MOTPRO(15)
00129       CHARACTER(LEN=72)  LIGNE2
00130       CHARACTER(LEN=144) LIGNED
00131 !
00132 !-----------------------------------------------------------------------
00133 !
00134       COMMON / DCINFO / LNG,LU
00135       COMMON / DCRARE / ERREUR,RETOUR
00136       COMMON / DCMLIG / NLIGN,LONGLI
00137       COMMON / DCCHIE / NFIC
00138 !
00139       INTRINSIC CHAR
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143       DATA MOTPRO/'NOM','TYPE','INDEX','TAILLE','DEFAUT','AIDE',
00144      & 'CHOIX','RUBRIQUE','NIVEAU','MNEMO','COMPOSE','COMPORT',
00145      & 'CONTROLE','APPARENCE','SUBMIT'/
00146 !
00147 !     LENGTH OF PROTECTED WORDS
00148 !
00149       DATA LONPRO /3,4,5,6,6,4,5,8,6,5,7,7,8,9,6/
00150 !
00151 !***********************************************************************
00152 !                                    RCS AND SCCS MARKING
00153 !
00154 !***********************************************************************
00155 !
00156       COTE   = .FALSE.
00157       LISUIV = .FALSE.
00158       LUFIC  = .FALSE.
00159       LUCOTE = .FALSE.
00160       LCAR   = 1
00161       CARLU  = ' '
00162       QUOTE  = ''''
00163       TABUL  = CHAR(9)
00164       NLIGN2 = NLIGN
00165       ICOL2  = ICOL
00166       LIGNE2 = LIGNE(1:MIN(72,LEN(LIGNE)))
00167       LIGNED = ' '
00168       LGLU   = 0
00169       QCAS   = 0
00170 !
00171       ICOL   = NEXT( ICOL+1 , LIGNE )
00172 !
00173 !        //// FINDS THE ENDS OF THE STRING ////
00174 !
00175 !    NOTE: THE STRING CAN BE BETWEEN QUOTES OR WITHOUT QUOTES
00176 !          IT CANNOT CONTAIN WHITE CHARACTERS IF THERE ARE
00177 !          NO QUOTES
00178 !
00179       IF ( LIGNE(ICOL:ICOL).NE.EXTREM ) THEN
00180         IDEB = ICOL
00181 !              PRECAR : SAME ROLE AS PREVAL, EXCEPT IT DOES NOT
00182 !                       SKIP COMMENTED LINES
00183         ICOL = PRECAR ( ICOL+1 , LIGNE , ' ' , ';' , TABUL) - 1
00184         IFIN = ICOL
00185         LIGNED = LIGNE(IDEB:IFIN)
00186         LGLU = IFIN-IDEB+1
00187 !
00188 ! STEERING FILE : GOES TO THE NEXT, WHEN GETS TO THE END OF A LINE
00189 !
00190 290     IF (IFIN.GE.LONGLI) THEN
00191           LISUIV = .TRUE.
00192           LUFIC = .TRUE.
00193           READ(NFIC,END=900,ERR=998,FMT='(A)') LIGNE2
00194           ICOL2 = 0
00195           IF (LIGNE2(1:1).EQ.'&'.OR.
00196      &        LIGNE2(1:1).EQ.'='.OR.LIGNE2(1:1).EQ.':'.OR.
00197      &        LIGNE2(1:1).EQ.';'.OR.LIGNE2(1:1).EQ.'/' ) THEN
00198             LISUIV = .FALSE.
00199             GO TO 96
00200           ENDIF
00201 !
00202 ! CHECKS IF IT'S A KNOWN KEYWORD FOR THE STEERING FILE
00203 !
00204           IF (NFIC.EQ.NFICDA) THEN
00205             DO ITYP = 1,4
00206               DO I=1,NMAXR(ITYP)
00207 !               K=LONGLU(MOTCLE(ITYP,I))
00208                 K=SIZE(ITYP,I)
00209                 IF (K.GT.0.AND.LIGNE2(1:K).EQ.MOTCLE(ITYP,I)(1:K)) THEN
00210                   LISUIV = .FALSE.
00211                   GO TO 96
00212                 ENDIF
00213               ENDDO ! I
00214             ENDDO ! ITYP
00215             DO I=1,100
00216 !             K = LONGLU(MOTIGN(I))
00217               K = LONIGN(I)
00218               IF(K.GT.0.AND.LIGNE2(1:K).EQ.MOTIGN(I)(1:K)) THEN
00219                 LISUIV = .FALSE.
00220                 GO TO 96
00221               ENDIF
00222             ENDDO ! I
00223           ELSE
00224             DO I=1,15
00225 !             K = LONGLU(MOTPRO(I))
00226               K = LONPRO(I)
00227               IF(K.GT.0.AND.LIGNE2(1:K).EQ.MOTPRO(I)(1:K)) THEN
00228                 LISUIV = .FALSE.
00229                 GO TO 96
00230               ENDIF
00231             ENDDO ! I
00232           ENDIF
00233 !
00234 ! GETS TO THIS POINT IF/WHEN HAS TO READ THE NEXT LINE
00235 !
00236           ICOL2 =PRECAR (1 , LIGNE2 , ' ' , TABUL ,' ') - 1
00237 !
00238           LGLU = LGLU + ICOL2
00239 !
00240           IF(LGLU.GT.LGVAR) THEN
00241             ERREUR = .TRUE.
00242             IF (LONGLU(LIGNED).GT.0) THEN
00243               LIGNED = LIGNED(1:LONGLU(LIGNED))//LIGNE2(1:ICOL2)
00244             ELSE
00245               LIGNED = LIGNE2(1:ICOL2)
00246             ENDIF
00247             IF(LGLU.GT.0) WRITE(LU,'(1X,A)') LIGNED(1:MIN(LGLU,144))
00248             WRITE(LU,*) ' '
00249             IF(LNG.EQ.1) THEN
00250               WRITE(LU,'(1X,A6,I4,1X,A27)') 'LIGNE: ',NLIGN,
00251      &                'ERREUR : CHAINE TROP LONGUE'
00252             ELSEIF (LNG.EQ.2) THEN
00253               WRITE(LU,'(1X,A5,I4,1X,A23)') 'LINE: ',NLIGN,
00254      &                'ERROR : STRING TOO LONG'
00255             ENDIF
00256             ICOL = ICOL -1
00257             GO TO 1000
00258           ELSE
00259 !           NEEDS TO READ ANOTHER LINE - SIMULATES A SHIFT OF LINE
00260             LISUIV = .FALSE.
00261             LIGNE = LIGNE2
00262             IF (LONGLU(LIGNED).GT.0) THEN
00263               LIGNED = LIGNED(1:LONGLU(LIGNED))//LIGNE2(1:LONGLI)
00264             ELSE
00265               LIGNED = LIGNE2(1:LONGLI)
00266             ENDIF
00267             NLIGN = NLIGN2
00268             ICOL = ICOL2
00269             IFIN = LONGLI+1
00270             GO TO 290
00271           ENDIF
00272   96      IF(LISUIV) THEN
00273             IF(LONGLU(LIGNED).GT.0) THEN
00274               LIGNED = LIGNED(1:LONGLU(LIGNED))//LIGNE2(1:ICOL2)
00275             ELSE
00276               LIGNED = LIGNE2(1:LONGLI)
00277             ENDIF
00278             IFIN = LGLU+ICOL2
00279             IDEB = 1
00280           ENDIF
00281         ENDIF
00282 !
00283         GO TO 901
00284  900    CONTINUE
00285         RETOUR = .TRUE.
00286  901    CONTINUE
00287         DO I = 1 , LGLU
00288           IF (LIGNED(I:I).EQ.QUOTE.OR.LIGNED(I:I).EQ.'&'.OR.
00289      &       LIGNED(I:I).EQ.'='.OR.LIGNED(I:I).EQ.':'.OR.
00290      &       LIGNED(I:I).EQ.'/') THEN
00291             IF (NLIGN2.NE.NLIGN.AND.(.NOT.(LUFIC)))
00292      &             WRITE(LU,'(1X,A)') LIGNE2(1:LONGLI)
00293             IF (LGLU.GT.0) WRITE(LU,'(1X,A)') LIGNED(1:LGLU)
00294             IF(LNG.EQ.1) THEN
00295               WRITE(LU,'(1X,A6,I4,A45,A)') 'LIGNE: ',NLIGN,
00296      &        ' ERREUR : CARACTERE INTERDIT DANS UNE CHAINE ',
00297      &        'SANS APOSTROPHES'
00298             ENDIF
00299             IF(LNG.EQ.2) THEN
00300                 WRITE(LU,'(1X,A5,I4,A)') 'LINE: ',NLIGN,
00301      &       ' ERROR: UNEXPECTED CHARACTER IN A STRING WITHOUT QUOTES'
00302             ENDIF
00303             ERREUR = .TRUE.
00304             GO TO 1000
00305           ENDIF
00306         ENDDO ! I
00307 !
00308       ELSE
00309 !
00310 ! CASE WHERE THERE ARE QUOTES
00311 !
00312         IDEB = ICOL + 1
00313 !
00314 ! THE 1ST QUOTE IS IN LAST POSITION (QCAS=4 OR QCAS=5)
00315         IF (ICOL.EQ.LONGLI) QCAS=45
00316 !
00317  100    ICOL   = PRECAR ( ICOL+1 , LIGNE , EXTREM , EXTREM , EXTREM )
00318         IF (ICOL.EQ.LONGLI) ICOL = LONGLI+1
00319 !
00320 ! CASE WHERE DOUBLE QUOTES CAN BE FOUND IN THE 1ST LINE EXCEPT IN COLUMN 72
00321 !
00322         IF(ICOL.LT.LONGLI) THEN
00323           IF(LIGNE(ICOL+1:ICOL+1).EQ.EXTREM.AND.EXTREM.EQ.QUOTE) THEN
00324             ICOL = ICOL + 1
00325 ! THE QUOTE IN 72 IS THE 2ND QUOTE OF A DOUBLE QUOTE (QCAS=3)
00326             IF (ICOL.EQ.LONGLI) QCAS=3
00327             COTE = .TRUE.
00328             GO TO 100
00329           ENDIF
00330         ENDIF
00331 !
00332         LGLU = MAX(0,ICOL-IDEB)
00333         IF (LGLU.GT.0) LIGNED = LIGNE(IDEB:ICOL-1)
00334 !
00335 ! HAS NOT FOUND THE END, OR A QUOTE WAS FOUND IN COLUMN 72
00336 !
00337         IF (ICOL.GT.LONGLI) THEN
00338 390       LISUIV = .TRUE.
00339           LUFIC = .TRUE.
00340           READ(NFIC,END=905,ERR=998,FMT='(A)') LIGNE2
00341 !
00342 ! CASE WHERE THE PRECEDING LINE ENDS WITH A QUOTE
00343 !
00344           IF (LIGNE(LONGLI:LONGLI).EQ.QUOTE) THEN
00345 ! THE QUOTE IN COLUMN 72 STARTS A STRING, OR IS THE 2ND OF A DOUBLE QUOTE
00346             IF (QCAS.EQ.45.OR.QCAS.EQ.3) THEN
00347               QCAS=0
00348             ELSEIF (LIGNE2(1:1).EQ.QUOTE) THEN
00349               COTE = .TRUE.
00350               LUCOTE = .TRUE.
00351               QCAS=0
00352             ELSE
00353               LGLU=LGLU-1
00354               IF (LGLU.GT.0) LIGNED = LIGNED(1:LGLU)
00355               LISUIV = .FALSE.
00356               QCAS=0
00357               GO TO 920
00358             ENDIF
00359           ENDIF
00360 !
00361           ICOL2 = 0
00362           IF(LIGNE2(1:1).EQ.QUOTE.AND.LUCOTE) THEN
00363             LUCOTE = .FALSE.
00364             ICOL2=1
00365           ENDIF
00366  110      ICOL2 =PRECAR (ICOL2+1,LIGNE2,EXTREM,EXTREM,EXTREM)
00367           IF(ICOL2.LT.LONGLI) THEN
00368           IF(LIGNE2(ICOL2+1:ICOL2+1).EQ.
00369      &      EXTREM.AND.EXTREM.EQ.QUOTE) THEN
00370 !           ICOL2 = PRECAR(ICOL2+1,LIGNE2,EXTREM,EXTREM,EXTREM)
00371             ICOL2=ICOL2+1
00372             COTE=.TRUE.
00373             IF (ICOL2.EQ.LONGLI) QCAS=3
00374             GO TO 110
00375           ENDIF
00376           ENDIF
00377           IF(ICOL2.EQ.LONGLI) ICOL2=ICOL2+1
00378           IF(LGLU.GT.0) THEN
00379             LIGNED = LIGNED(1:LGLU)//LIGNE2(1:ICOL2-1)
00380           ELSE
00381             LIGNED = LIGNE2(1:ICOL2-1)
00382           ENDIF
00383           LGLU = LGLU + ICOL2-1
00384 !
00385           IF(LGLU.GT.LGVAR) GO TO 910
00386 !
00387 ! GOES TO NEXT LINE IF NOT COMPLETE, OR IF HAS FOUND A QUOTE IN 72
00388 !
00389           IF(ICOL2.GE.LONGLI) THEN
00390             LISUIV = .FALSE.
00391             LIGNE = LIGNE2
00392             NLIGN = NLIGN2
00393             ICOL = ICOL2
00394             IFIN = ICOL2
00395             GO TO 390
00396           ENDIF
00397 ! HERE IT'S OK
00398           GO TO 920
00399 !
00400  905      CONTINUE
00401           RETOUR = .TRUE.
00402 !
00403  910      CONTINUE
00404           WRITE(LU,'(1X,A)') LIGNED(1:MAX(1,MIN(LGLU,LGVAR)))
00405           WRITE(LU,*)
00406           IF(LNG.EQ.1) THEN
00407             WRITE(LU,'(1X,A6,I4,A)') 'LIGNE: ',NLIGN,
00408      &      ' ERREUR : COTE MANQUANTE EN FIN DE CHAINE DE CARACTERES'
00409             WRITE(LU,*)'OU CHAINE TROP LONGUE ... '
00410           ENDIF
00411           IF(LNG.EQ.2) THEN
00412             WRITE(LU,'(1X,A5,I4,A)') 'LINE: ',NLIGN,
00413      &      ' ERROR: QUOTE MISSING AT THE END OF THE STRING'
00414             WRITE(LU,*)'OR STRING TOO LONG ... '
00415           ENDIF
00416           ERREUR = .TRUE.
00417           ICOL = LONGLI
00418           GO TO 1000
00419 !
00420         ENDIF
00421         IFIN   = ICOL - 1
00422       ENDIF
00423 !
00424  920  CONTINUE
00425       IF(LGLU.NE.0) THEN
00426         LCAR = MIN(LGLU,LGVAR)
00427         CARLU = LIGNED(1:LGLU)
00428       ENDIF
00429 !
00430 !  CHANGES DOUBLE QUOTES WITH SIMPLE QUOTES
00431 !
00432       IF(COTE) THEN
00433         NCAR = LCAR
00434         I = 1
00435  200    CONTINUE
00436         IF(I.GT.NCAR) THEN
00437           LCAR = NCAR
00438           GO TO 1000
00439         ENDIF
00440         IF(CARLU(I:I).EQ.QUOTE.AND.CARLU(I+1:I+1).EQ.QUOTE) THEN
00441           CARLU(I+1:LCAR) = CARLU(I+2:LCAR)//' '
00442           NCAR = NCAR - 1
00443         ENDIF
00444         I = I + 1
00445         GO TO 200
00446       ENDIF
00447 !
00448 1000  CONTINUE
00449 !
00450       IF (LUFIC) THEN
00451         NLIGN = NLIGN + 1
00452         LIGNE = LIGNE2
00453         IF (LISUIV) THEN
00454           ICOL = ICOL2
00455         ELSE
00456           ICOL = 0
00457         ENDIF
00458       ENDIF
00459 !
00460 !-----------------------------------------------------------------------
00461 !
00462       RETURN
00463 !
00464 998   CONTINUE
00465       IF(LNG.EQ.1) WRITE(6,999) NFIC,NLIGN+1
00466       IF(LNG.EQ.2) WRITE(6,1999) NFIC,NLIGN+1
00467 999   FORMAT(1X,'UNITE LOGIQUE ',1I2,'   ERREUR LIGNE ',1I6)
00468 1999  FORMAT(1X,'LOGICAL UNIT ',1I2,'   ERROR LINE ',1I6)
00469       RETOUR = .TRUE.
00470       RETURN
00471 !
00472 !-----------------------------------------------------------------------
00473 !
00474       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0