loglu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\loglu.f
00002 !
00060                      LOGICAL FUNCTION LOGLU
00061 !                    **********************
00062 !
00063      &( ICOL , LIGNE )
00064 !
00065 !***********************************************************************
00066 ! DAMOCLES   V6P3                                   21/08/2010
00067 !***********************************************************************
00068 !
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00075 !| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
00076 !| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
00077 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00078 !
00079       IMPLICIT NONE
00080 !
00081 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00082 !
00083       INTEGER,       INTENT(INOUT) :: ICOL
00084       CHARACTER*(*), INTENT(INOUT) :: LIGNE
00085 !
00086 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00087 !
00088       INTEGER       LNG,LU
00089       INTEGER       NLIGN,LONGLI
00090       INTEGER       NFIC
00091       LOGICAL       ERREUR,RETOUR
00092 !
00093       INTEGER  NEXT,PRECAR
00094       EXTERNAL NEXT,PRECAR
00095 !
00096 !-----------------------------------------------------------------------
00097 !
00098       INTEGER       I1,I2
00099       CHARACTER*1   TABUL
00100       CHARACTER*7   L
00101       CHARACTER*72  LIGNE2
00102       LOGICAL       LUFIC,LISUIV
00103 !
00104 !-----------------------------------------------------------------------
00105 !
00106       COMMON / DCINFO / LNG,LU
00107       COMMON / DCRARE / ERREUR , RETOUR
00108       COMMON / DCMLIG / NLIGN , LONGLI
00109       COMMON / DCCHIE / NFIC
00110 !
00111       INTRINSIC CHAR
00112 !
00113 !***********************************************************************
00114 !                                    RCS AND SCCS MARKING
00115 !
00116 !***********************************************************************
00117 !
00118       LUFIC  = .FALSE.
00119       LISUIV = .FALSE.
00120       LIGNE2 = ' '
00121       TABUL  = CHAR(9)
00122 !
00123       I1 = NEXT( ICOL+1 , LIGNE )
00124       I2 = PRECAR(I1,LIGNE,' ',';',TABUL)
00125 !
00126 !     CASE WHERE WE MIGHT HAVE TO READ THE FOLLOWING LINE
00127 !
00128       IF(I2.GT.LONGLI.AND.I1+6.GT.LONGLI) THEN
00129         LUFIC=.TRUE.
00130         READ(NFIC,END=900,ERR=998,FMT='(A)') LIGNE2
00131         IF(I1.LE.LONGLI) THEN
00132           L(1:7)=LIGNE(I1:LONGLI)//LIGNE2(1:(7-(LONGLI-I1+1)))
00133         ELSE
00134           L(1:7)=LIGNE2(1:7)
00135         ENDIF
00136         I2 = 0
00137         I2 = PRECAR(I2+1,LIGNE2,' ',';',TABUL)
00138       ELSEIF(I1+6.GT.LONGLI) THEN
00139         L(2:7) = '      '
00140         L(1:LONGLI-I1+1)= LIGNE(I1:LONGLI)
00141       ELSE
00142         L(1:7) = LIGNE(I1:I1+6)
00143       ENDIF
00144       CALL MAJUS(L)
00145       GO TO 910
00146 !
00147  900  CONTINUE
00148       RETOUR = .TRUE.
00149 !
00150  910  CONTINUE
00151 !
00152 ! ORDERED IN THE MOST PROBABLE ORDER: NON OUI NO YES 0 1 ...
00153 !
00154       IF(L(1:3).EQ.'NON') THEN
00155         LOGLU = .FALSE.
00156         ICOL = I1 + 2
00157       ELSEIF(L(1:2).EQ.'NO') THEN
00158         LOGLU = .FALSE.
00159         ICOL = I1 + 1
00160       ELSEIF(L(1:3).EQ.'OUI' ) THEN
00161         LOGLU = .TRUE.
00162         ICOL = I1 + 2
00163       ELSEIF(L(1:3).EQ.'YES' ) THEN
00164         LOGLU = .TRUE.
00165         ICOL = I1 + 2
00166       ELSEIF(L(1:1).EQ.'0') THEN
00167         LOGLU = .FALSE.
00168         ICOL = I1
00169       ELSEIF(L(1:1).EQ.'1') THEN
00170         LOGLU = .TRUE.
00171         ICOL = I1
00172       ELSEIF(L(1:7).EQ.'.FALSE.' ) THEN
00173         LOGLU = .FALSE.
00174         ICOL = I1 + 6
00175       ELSEIF(L(1:5).EQ.'FALSE' ) THEN
00176         LOGLU = .FALSE.
00177         ICOL = I1 + 4
00178       ELSEIF(L(1:4).EQ.'FAUX') THEN
00179         LOGLU = .FALSE.
00180         ICOL = I1 + 3
00181       ELSEIF(L(1:6).EQ.'.TRUE.' ) THEN
00182         LOGLU = .TRUE.
00183         ICOL = I1 + 5
00184       ELSEIF(L(1:4).EQ.'TRUE' ) THEN
00185         LOGLU = .TRUE.
00186         ICOL = I1 + 3
00187       ELSEIF(L(1:4).EQ.'VRAI' ) THEN
00188         LOGLU = .TRUE.
00189         ICOL = I1 + 3
00190       ELSE
00191 !
00192 !       ERROR: NOT A LOGICAL VALUE
00193 !
00194         ERREUR = .TRUE.
00195         WRITE(LU,'(1X,A)') LIGNE(1:LONGLI)
00196         IF(LUFIC) WRITE(LU,'(1X,A)') LIGNE2(1:LONGLI)
00197         WRITE(LU,*) ' '
00198         IF(LNG.EQ.1) THEN
00199           WRITE(LU,'(1X,A6,I4,A)') 'LOGLU (UTILE) : LIGNE: ',NLIGN,
00200      &                             ' ERREUR, LOGIQUE MAL CODE'
00201         ENDIF
00202         IF(LNG.EQ.2) THEN
00203           WRITE(LU,'(1X,A6,I4,A)') 'LOGLU (UTILE) : LINE: ',NLIGN,
00204      &                             ' WRONG LOGICAL VALUE'
00205         ENDIF
00206         LOGLU = .FALSE.
00207         GO TO 1000
00208 !
00209       ENDIF
00210 !
00211 !       //// UPDATES THE POINTER ////
00212 !
00213       IF (LUFIC) THEN
00214         NLIGN = NLIGN + 1
00215         LIGNE = LIGNE2
00216         IF(ICOL.GT.LONGLI) LISUIV = .TRUE.
00217         IF(LISUIV) THEN
00218           ICOL = I2-1
00219         ELSE
00220           ICOL = 0
00221         ENDIF
00222       ELSE
00223         ICOL = I2 - 1
00224       ENDIF
00225 !
00226 1000  CONTINUE
00227 !
00228 !-----------------------------------------------------------------------
00229 !
00230       RETURN
00231 !
00232 998   CONTINUE
00233       IF(LNG.EQ.1) WRITE(6,999) NFIC,NLIGN+1
00234       IF(LNG.EQ.2) WRITE(6,1999) NFIC,NLIGN+1
00235 999   FORMAT(1X,'UNITE LOGIQUE ',1I2,'   ERREUR LIGNE ',1I6)
00236 1999  FORMAT(1X,'LOGICAL UNIT ',1I2,'   ERROR LINE ',1I6)
00237       RETOUR = .TRUE.
00238 !
00239 !-----------------------------------------------------------------------
00240 !
00241       RETURN
00242       END

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