realu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\realu.f
00002 !
00074                      DOUBLE PRECISION FUNCTION REALU
00075 !                    *******************************
00076 !
00077      &( ICOL , LIGNE )
00078 !
00079 !***********************************************************************
00080 ! DAMOCLES   V6P2                                   21/08/2010
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
00092 !| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !
00095       IMPLICIT NONE
00096 !
00097       INTEGER          ICOL
00098       CHARACTER*(*)    LIGNE
00099 !
00100       INTEGER          NEXT,PREVAL
00101       EXTERNAL         NEXT,PREVAL
00102 !
00103       INTEGER          LNG,LU
00104       INTEGER          NLIGN,LONGLI
00105       INTEGER          NFIC
00106       LOGICAL          ERREUR , RETOUR
00107 !
00108 !-----------------------------------------------------------------------
00109 !
00110       INTRINSIC DLOG10,DBLE,INT,CHAR
00111 !
00112       INTEGER          I,I1,I2,ILONG,IPOINT,IFDECI,ILDECI,JD1,JD2,I3
00113       LOGICAL          FORMAE,LUFIC,LISUIV,VUPOIN
00114       CHARACTER*1      CODE,CDEB,CDEB2,TABUL
00115       CHARACTER*3      LLONG,LLDECI
00116       CHARACTER*72     FORMA,LIGNE2
00117       DOUBLE PRECISION RSIGNE , RVAL
00118 !
00119 !-----------------------------------------------------------------------
00120 !
00121       COMMON / DCINFO / LNG,LU
00122       COMMON / DCRARE / ERREUR , RETOUR
00123       COMMON / DCMLIG / NLIGN , LONGLI
00124       COMMON / DCCHIE / NFIC
00125 !
00126 !***********************************************************************
00127 !
00128       LUFIC = .FALSE.
00129       LISUIV = .FALSE.
00130       VUPOIN = .FALSE.
00131       TABUL = CHAR(9)
00132 !
00133       I1     = NEXT( ICOL+1 , LIGNE )
00134 !
00135 !     //// DETERMINES THE FORMAT: F OR E ////
00136 !
00137       FORMAE = .FALSE.
00138 !
00139 !     //// DECODES THE SIGN IF NEED BE ////
00140 !
00141       RSIGNE = +1.D0
00142       IF ( LIGNE(I1:I1).EQ.'-' ) THEN
00143            RSIGNE = -1.D0
00144            I1     =   NEXT ( I1+1      , LIGNE )
00145       ELSE IF ( LIGNE(I1:I1).EQ.'+' ) THEN
00146            RSIGNE = +1.D0
00147            I1     =   NEXT ( I1+1      , LIGNE )
00148       ENDIF
00149 !
00150 !     //// SEEKS THE FIRST WHITE CHARACTER FOLLOWING THE NUMBER ////
00151 !                       OR A SEPARATOR ';'
00152 !
00153       I2     = PREVAL (  I1  , LIGNE ,  ' ' , ';' ,TABUL)
00154 !
00155 !     CASE WHERE THE REAL DOES NOT FINISH ON THE LINE                                                                                                                                                                                                                                                                                                                                                                                                                                              LINE
00156 !
00157       IF (I2.GT.LONGLI) THEN
00158         LUFIC=.TRUE.
00159         READ(NFIC,END=900,ERR=998,FMT='(A)') LIGNE2
00160         CDEB = LIGNE2(1:1)
00161         CDEB2 = LIGNE2(2:2)
00162 !
00163         IF ((CDEB.EQ.'0'.OR.CDEB.EQ.'1'.OR.CDEB.EQ.'2'.OR.
00164      &       CDEB.EQ.'3'.OR.CDEB.EQ.'4'.OR.CDEB.EQ.'5'.OR.
00165      &       CDEB.EQ.'6'.OR.CDEB.EQ.'7'.OR.CDEB.EQ.'8'.OR.
00166      &       CDEB.EQ.'9'.OR.CDEB.EQ.'.'.OR.CDEB.EQ.'+'.OR.
00167      &       CDEB.EQ.'-'.OR.CDEB.EQ.',')
00168 !
00169      &     .OR.
00170 !
00171 ! CASE WHERE IT DEPENDS ON THE SECOND CHARACTER OF THE FOLLOWING LINE
00172 !
00173      &     ( (CDEB.EQ.'E'.OR.CDEB.EQ.'D')
00174      &     .AND.
00175      &     ( CDEB2.EQ.'0'.OR.CDEB2.EQ.'1'.OR.CDEB2.EQ.'2'.OR.
00176      &       CDEB2.EQ.'3'.OR.CDEB2.EQ.'4'.OR.CDEB2.EQ.'5'.OR.
00177      &       CDEB2.EQ.'6'.OR.CDEB2.EQ.'7'.OR.CDEB2.EQ.'8'.OR.
00178      &       CDEB2.EQ.'9'.OR.CDEB2.EQ.'+'.OR.CDEB2.EQ.'-'    )))
00179 !
00180      &     THEN
00181 !
00182           LISUIV = .TRUE.
00183           I3=1
00184           I3=PREVAL(I3,LIGNE2 , ' ' , ';' ,TABUL)
00185           IF (I1.LE.LONGLI) THEN
00186             LIGNE = LIGNE(I1:LONGLI)//LIGNE2(1:I3)
00187           ELSE
00188             LIGNE = LIGNE2(1:I3)
00189           ENDIF
00190           I2 = LONGLI-I1+1+I3
00191           I1 = 1
00192         ENDIF
00193       ENDIF
00194       GOTO 910
00195 !
00196  900  CONTINUE
00197       RETOUR = .TRUE.
00198  910  CONTINUE
00199 !
00200 !     ILONG: LENGTH OF THE REAL
00201       ILONG  = I2 - I1
00202       IPOINT = I2 - 1
00203       IFDECI = I2 - 1
00204       DO I = I1 , I2-1
00205 !       ACCEPTS '.' AND ','
00206         IF ( LIGNE(I:I).EQ.'.' ) THEN
00207           IPOINT = I
00208           VUPOIN=.TRUE.
00209         ELSEIF ( LIGNE(I:I).EQ.',' ) THEN
00210           LIGNE(I:I)='.'
00211           IPOINT = I
00212           VUPOIN=.TRUE.
00213         ELSEIF (LIGNE(I:I).EQ.'E') THEN
00214 !       ACCEPTS BOTH FORMATS E AND D
00215           FORMAE = .TRUE.
00216           IFDECI = I-1
00217         ELSEIF (LIGNE(I:I).EQ.'D') THEN
00218           LIGNE(I:I)='E'
00219           FORMAE = .TRUE.
00220           IFDECI = I-1
00221         ENDIF
00222       ENDDO ! I
00223 !
00224 !     //// NUMBER OF DECIMAL POINTS ///
00225 !
00226       IF (VUPOIN) THEN
00227         ILDECI = IFDECI - IPOINT
00228       ELSE
00229         ILDECI = 0
00230       ENDIF
00231 !
00232 !     //// DECODING FORMAT ////
00233 !
00234       CODE = 'F'
00235       IF ( FORMAE ) CODE = 'E'
00236       JD1 = 3 - INT(DLOG10(DBLE(ILONG)))
00237       WRITE (LLONG,'(I3)') ILONG
00238       JD2 = 3
00239       IF ( ILDECI.GT.0 ) JD2 = 3-INT(DLOG10(DBLE(ILDECI)))
00240       WRITE (LLDECI,'(I3)') ILDECI
00241       IF ( I1.GT.1 ) THEN
00242         WRITE ( FORMA , 1010 )  I1-1,CODE,LLONG(JD1:3),LLDECI(JD2:3)
00243       ELSE
00244         WRITE ( FORMA , 1020 )  CODE,LLONG(JD1:3),LLDECI(JD2:3)
00245       ENDIF
00246 !
00247 1010  FORMAT('(',I3,'X,',A1,A,'.',A,')' )
00248 1020  FORMAT('(',A1,A,'.',A,')' )
00249 !
00250 !     ////  DECODES ////
00251 !
00252       READ  ( LIGNE , FORMA , ERR=995 ) RVAL
00253       REALU = RSIGNE * RVAL
00254 !
00255 !     //// UPDATES THE POINTER ////
00256 !
00257       IF (LUFIC) THEN
00258         NLIGN = NLIGN + 1
00259         LIGNE = LIGNE2
00260         IF (LISUIV) THEN
00261           ICOL = I3-1
00262         ELSE
00263           ICOL = 0
00264         ENDIF
00265       ELSE
00266         ICOL = I2 - 1
00267       ENDIF
00268 !
00269 !-----------------------------------------------------------------------
00270 !
00271       RETURN
00272 !
00273 ! TREATS THE ERRORS DUE TO THE INTERNAL READ FOR CONVERSION
00274 !
00275 995   CONTINUE
00276       IF(LNG.EQ.1) WRITE(6,996) NLIGN
00277       IF(LNG.EQ.2) WRITE(6,1996) NLIGN
00278       WRITE(6,*) LIGNE
00279 996   FORMAT(1X,'ERREUR LIGNE ',1I6,', UN REEL EST ATTENDU : ',/)
00280 1996  FORMAT(1X,'ERREUR LINE ',1I6,', REAL EXPECTED : ',/)
00281       ERREUR=.TRUE.
00282       RETURN
00283 !
00284 ! TREATS THE ERRORS DUE TO FILE MISREADING
00285 !
00286 998   CONTINUE
00287       IF(LNG.EQ.1) WRITE(6,999)  NFIC,NLIGN+1
00288       IF(LNG.EQ.2) WRITE(6,1999) NFIC,NLIGN+1
00289 999   FORMAT(1X,'UNITE LOGIQUE ',1I2,'   ERREUR LIGNE ',1I6)
00290 1999  FORMAT(1X,'LOGICAL UNIT ',1I2,'   ERROR LINE ',1I6)
00291       RETOUR = .TRUE.
00292       RETURN
00293 !
00294       END

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