aidelu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\aidelu.f
00002 !
00063                      SUBROUTINE AIDELU
00064 !                    *****************
00065 !
00066      &( ICOL , LIGNE, DOC )
00067 !
00068 !***********************************************************************
00069 ! DAMOCLES   V6P0                                   21/08/2010
00070 !***********************************************************************
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| DOC            |-->| LOGIQUE DE DOCUMENTATION DE LA SORTIE
00080 !|                |   | = VRAI : IMPRIME L'AIDE (FICHIER RESULTAT)
00081 !|                |   | = FAUX : N'IMPRIME PAS L'AIDE
00082 !| ICOL           |<->| INDICE DU CARACTERE COURANT DANS LA LIGNE
00083 !| LIGNE          |<->| LIGNE EN COURS DE DECODAGE.
00084 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00085 !
00086       IMPLICIT NONE
00087 !
00088 !
00089       INTEGER       ICOL
00090       LOGICAL       DOC
00091       CHARACTER*(*) LIGNE
00092 !
00093       INTEGER  NEXT,PRECAR
00094       EXTERNAL NEXT,PRECAR
00095 !
00096       INTEGER       LNG,LU
00097       INTEGER       NLIGN,LONGLI
00098       INTEGER       NFIC
00099       LOGICAL       ERREUR,RETOUR
00100 !
00101 !-----------------------------------------------------------------------
00102 !
00103       INTEGER       IDEB,IFIN,JCOL
00104       CHARACTER*1   QUOTE,TABUL,PTVIRG
00105 !
00106 !-----------------------------------------------------------------------
00107 !
00108       COMMON / DCINFO / LNG,LU
00109       COMMON / DCRARE / ERREUR,RETOUR
00110       COMMON / DCMLIG / NLIGN,LONGLI
00111       COMMON / DCCHIE / NFIC
00112 !
00113       INTRINSIC CHAR
00114 !
00115 !***********************************************************************
00116 !                                   MARKS RCS AND SCCS
00117 !
00118 !***********************************************************************
00119 !
00120       QUOTE  = ''''
00121       PTVIRG = ';'
00122       TABUL =CHAR(9)
00123 9     ICOL   = NEXT( ICOL+1 , LIGNE )
00124 !
00125 !        //// FINDS THE ENDS OF THE STRING ////
00126 !
00127 !    NOTE: THE STRING CAN BE BETWEEN QUOTES OR NOT.
00128 !          IF NOT, IT CANNOT CONTAIN WHITE CHARACTERS.
00129 !
00130 !
00131 !
00132       IF ( LIGNE(ICOL:ICOL).NE.QUOTE ) THEN
00133         IDEB = ICOL
00134 !              PRECAR: SAME FUNCTION AS PREVAL, BUT DOES NOT JUMP
00135 !                      OVER COMMENTED LINES
00136         ICOL = PRECAR (ICOL+1,LIGNE,' ',PTVIRG,TABUL) - 1
00137         IFIN = ICOL
00138         IF (DOC) WRITE(LU,10) LIGNE(IDEB:IFIN)
00139 10      FORMAT(1X,A)
00140       ELSE
00141 !
00142 ! IF THE STRING IS BETWEEN QUOTES
00143 !
00144         IDEB = ICOL + 1
00145 !
00146 ! WHILE THERE IS NO QUOTE ON THE LINE
00147 !
00148 100     ICOL = PRECAR(ICOL+1,LIGNE,QUOTE,QUOTE,QUOTE)
00149         IF (ICOL.GT.LONGLI) THEN
00150 !         NO QUOTE ON THE LINE, IT'S WRITTEN OUT AND GOES TO NEXT
00151           IF (DOC) WRITE(LU,10) LIGNE(IDEB:LONGLI)
00152 !         READS NEXT LINE
00153           READ(NFIC,END=900,ERR=998,FMT='(A)') LIGNE
00154           NLIGN = NLIGN + 1
00155           ICOL = 1
00156           IDEB = 1
00157           GO TO 100
00158         ELSEIF(ICOL.EQ.LONGLI) THEN
00159 !       QUOTE AT THE END OF THE LINE, THE LINE IS WRITTEN OUT (EXCEPT
00160 !       THE QUOTE) AND THAT'S IT
00161           IF (DOC) WRITE(LU,10) LIGNE(IDEB:ICOL-1)
00162         ELSE
00163 !         NEXT QUOTE
00164           JCOL = PRECAR(ICOL+1,LIGNE,QUOTE,QUOTE,QUOTE)
00165 !         IF THERE IS A DOUBLE QUOTE, IT IS DELETED
00166           IF ((JCOL-ICOL).EQ.1) THEN
00167             ICOL=JCOL
00168             LIGNE(JCOL:LONGLI)=LIGNE(JCOL+1:LONGLI) // ' '
00169             GO TO 100
00170           ELSE
00171 !           PRINTS OUT THE 'HELP' WHEN DELETING THE LAST QUOTE
00172             IF (DOC) WRITE(LU,10) LIGNE(IDEB:ICOL-1)
00173           ENDIF
00174         ENDIF
00175       ENDIF
00176       ICOL = NEXT(ICOL+1,LIGNE)
00177       IF(ICOL.LE.LONGLI) THEN
00178         IF(LIGNE(ICOL:ICOL).EQ.PTVIRG(1:1)) GO TO 9
00179       ENDIF
00180       GO TO 1000
00181 !
00182 ! WRITES OUT ERRORS
00183 !
00184 998   CONTINUE
00185       IF(LNG.EQ.1) THEN
00186         WRITE(LU,999) NFIC, NLIGN
00187 999     FORMAT(1X,'UNITE LOGIQUE ',1I2,'   ERREUR LIGNE ',1I6)
00188       ENDIF
00189       IF(LNG.EQ.2) THEN
00190         WRITE(LU,1999) NFIC, NLIGN
00191 1999    FORMAT(1X,'LOGICAL UNIT ',1I2,'   ERROR ON LINE ',1I6)
00192       ENDIF
00193 900   CONTINUE
00194       RETOUR = .TRUE.
00195 !
00196 ! END OF THE WRITING OF ERRORS
00197 !
00198 1000  CONTINUE
00199 !
00200 ! TWO EMPTY LINES FOR THE PAGE LAYOUT
00201 !
00202       IF (DOC) WRITE(LU,*) ' '
00203       IF (DOC) WRITE(LU,*) ' '
00204 !
00205 !-----------------------------------------------------------------------
00206 !
00207       RETURN
00208       END

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