intlu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\intlu.f
00002 !
00072                      INTEGER FUNCTION INTLU
00073 !                    **********************
00074 !
00075      &( ICOL , LIGNE )
00076 !
00077 !***********************************************************************
00078 ! DAMOCLES   V6P0                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00089 !| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
00090 !| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
00091 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00092 !
00093       IMPLICIT NONE
00094 !
00095       INTEGER          ICOL
00096       CHARACTER*(*)    LIGNE
00097 !
00098       INTEGER          NEXT,PREVAL
00099       EXTERNAL NEXT,PREVAL
00100 !
00101       INTEGER          LNG,LU
00102       INTEGER          NLIGN,LONGLI
00103       INTEGER          NFIC
00104       LOGICAL          ERREUR , RETOUR
00105 !
00106 !-----------------------------------------------------------------------
00107 !
00108       INTRINSIC DLOG10,DBLE,INT,CHAR
00109 !
00110       INTEGER          I1,I2,ILONG,ISIGNE,IVAL,JD1,I3
00111       LOGICAL          LUFIC,LISUIV
00112       CHARACTER*1      CDEB,TABUL
00113       CHARACTER*3      LLONG
00114       CHARACTER*72     LIGNE2,FORMA
00115 !
00116 !-----------------------------------------------------------------------
00117 !
00118       COMMON / DCINFO / LNG,LU
00119       COMMON / DCRARE / ERREUR , RETOUR
00120       COMMON / DCMLIG / NLIGN , LONGLI
00121       COMMON / DCCHIE / NFIC
00122 !
00123 !***********************************************************************
00124 !
00125       LUFIC = .FALSE.
00126       LISUIV = .FALSE.
00127       TABUL = CHAR(9)
00128 !
00129       I1     = NEXT( ICOL+1 , LIGNE )
00130 !
00131 !     //// DECODES THE SIGN IF NEED BE ////
00132 !
00133       IF ( LIGNE(I1:I1).EQ.'-' ) THEN
00134            ISIGNE = -1
00135            I1     =   NEXT ( I1+1      , LIGNE )
00136       ELSE IF ( LIGNE(I1:I1).EQ.'+' ) THEN
00137            ISIGNE = +1
00138            I1     =   NEXT ( I1+1      , LIGNE )
00139       ELSE
00140            ISIGNE = +1
00141       ENDIF
00142 !
00143 !     //// SEEKS THE FIRST WHITE CHARACTER FOLLOWING THE NUMBER ////
00144 !                       OR A SEPARATOR ';'
00145 !
00146       I2 = PREVAL (  I1  , LIGNE ,  ' ' , ';' , TABUL)
00147 !
00148 !     CASE WHERE THE INTEGER DOES NOT FINISH ON THE LINE                                                                                                                                                                                                                                                                                                                                                                                                                                              LINE
00149 !
00150       IF (I2.GT.LONGLI) THEN
00151         LUFIC=.TRUE.
00152         READ(NFIC,END=900,ERR=998,FMT='(A)') LIGNE2
00153         CDEB = LIGNE2(1:1)
00154         IF (CDEB.EQ.'0'.OR.CDEB.EQ.'1'.OR.CDEB.EQ.'2'.OR.
00155      &     CDEB.EQ.'3'.OR.CDEB.EQ.'4'.OR.CDEB.EQ.'5'.OR.
00156      &     CDEB.EQ.'6'.OR.CDEB.EQ.'7'.OR.CDEB.EQ.'8'.OR.
00157      &     CDEB.EQ.'9'.OR.CDEB.EQ.'.') THEN
00158           LISUIV = .TRUE.
00159           I3=1
00160           I3=PREVAL(I3,LIGNE2 , ' ' , ';', TABUL)
00161           IF (I1.LE.LONGLI) THEN
00162             LIGNE = LIGNE(I1:LONGLI)//LIGNE2(1:I3)
00163           ELSE
00164             LIGNE =LIGNE2(1:I3)
00165           ENDIF
00166           I2 = LONGLI-I1+1+I3
00167           I1 = 1
00168         ENDIF
00169       ENDIF
00170       GOTO 910
00171 !
00172  900  CONTINUE
00173       RETOUR = .TRUE.
00174  910  CONTINUE
00175 !     ACCEPTS THE CASE WHERE A USER WRITES AN INTEGER IN
00176 !     REAL FORM WITH A POINT AT THE END
00177       IF(LIGNE(I2-1:I2-1).EQ.'.') THEN
00178         LIGNE(I2-1:I2-1)=' '
00179         I2 = I2 - 1
00180       ENDIF
00181 !
00182 !     ILONG: LENGTH OF THE INTEGER
00183       ILONG  = I2 - I1
00184 !
00185 !     //// DECODING FORMAT ////
00186 !
00187       JD1 = 3 - INT(DLOG10(DBLE(ILONG)))
00188       WRITE ( LLONG , '(I3)' ) ILONG
00189 !
00190       IF(I1.EQ.1) THEN
00191         WRITE (FORMA , 1101 )  LLONG(JD1:3)
00192       ELSE
00193         WRITE (FORMA , 1100 )  I1-1 , LLONG(JD1:3)
00194       ENDIF
00195 !
00196 !     ////  DECODES ////
00197 !
00198       READ  ( LIGNE , FORMA , ERR=995 ) IVAL
00199       INTLU = ISIGNE * IVAL
00200 !
00201 !     //// UPDATES THE POINTER ////
00202 !
00203       IF (LUFIC) THEN
00204         NLIGN = NLIGN + 1
00205         LIGNE = LIGNE2
00206         IF (LISUIV) THEN
00207           ICOL = I3-1
00208         ELSE
00209           ICOL = 0
00210         ENDIF
00211       ELSE
00212         ICOL = I2 - 1
00213       ENDIF
00214 !
00215 1100  FORMAT('(',I3,'X,I',A,')')
00216 1101  FORMAT('(I',A,')')
00217 !
00218 !-----------------------------------------------------------------------
00219 !
00220       RETURN
00221 !
00222 ! TREATS THE ERRORS DUE TO THE INTERNAL READ FOR CONVERSION
00223 !
00224 995   CONTINUE
00225       IF(LNG.EQ.1) WRITE(6,996) NLIGN
00226       IF(LNG.EQ.2) WRITE(6,1996) NLIGN
00227       WRITE(6,*) LIGNE
00228 996   FORMAT(1X,'ERREUR LIGNE ',1I6,', UN ENTIER EST ATTENDU : ',/)
00229 1996  FORMAT(1X,'ERREUR LINE ',1I6,', INTEGER EXPECTED : ',/)
00230       ERREUR=.TRUE.
00231       RETURN
00232 !
00233 ! TREATS THE ERRORS DUE TO FILE MISREADING
00234 !
00235 998   CONTINUE
00236       IF(LNG.EQ.1) WRITE(6,999) NFIC,NLIGN+1
00237       IF(LNG.EQ.2) WRITE(6,1999) NFIC,NLIGN+1
00238 999   FORMAT(1X,'UNITE LOGIQUE ',1I2,'   ERREUR LIGNE ',1I6)
00239 1999  FORMAT(1X,'LOGICAL UNIT ',1I2,'   ERROR LINE ',1I6)
00240       RETOUR = .TRUE.
00241       RETURN
00242 !
00243       END

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