realu.f

Go to the documentation of this file.

!                   *******************************
                    DOUBLE PRECISION FUNCTION realu
!                   *******************************
!
     &( icol , ligne )
!
!***********************************************************************
! DAMOCLES   V6P2                                   21/08/2010
!***********************************************************************
!
!brief    DECODES A REAL, FROM COLUMN ICOL+1 OF THE LINE.
!+             MOVES THE POINTER ICOL TO THE LAST DECODED CHARACTER.
!+             ACCEPTS F FORMAT OR E FORMAT.
!+             ACCEPTS REALS WITH DECIMAL POINTS; ACCEPTS ',' FOR '.'.
!+             IF THE STRING IS NOT COMPLETE, GOES TO THE NEXT LINE
!+             IF NEED BE.
!+             MOVES THE POINTER ICOL TO THE LAST DECODED CHARACTER
!+             OR TO ICOL=0 IF THE NEXT LINE WAS READ.
!
!note     PORTABILITY : IBM,CRAY,HP,SUN
!
!warning  IF THE VALUE READ IS NOT A REAL, COULD YIELD A
!+            NON-CONTROLLED ERROR BY THE PROGRAM
!
!history  J.M. HERVOUET (LNH); A. YESSAYAN
!+        30/09/1993
!+        V5P1
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  J-M HERVOUET (LNHE)
!+        30/05/2012
!+   Test  CDEB.EQ.'E'.OR.CDEB.EQ.'E'.OR.CDEB.EQ.'D'.OR.CDEB.EQ.'D'
!+   Replaced by  CDEB.EQ.'E'.OR.CDEB.EQ.'D', other stupid tests alike.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
!| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_damocles
      USE declarations_special
      IMPLICIT NONE
!
      INTEGER          ICOL
      CHARACTER(LEN=*)    LIGNE
!
      INTEGER          NEXT,PREVAL
      EXTERNAL         next,preval
!
!-----------------------------------------------------------------------
!
      INTRINSIC log10,dble,int,char
!
      INTEGER          I,I1,I2,ILONG,IPOINT,IFDECI,ILDECI,JD1,JD2,I3
      LOGICAL          FORMAE,LUFIC,LISUIV,VUPOIN
      CHARACTER(LEN=1)      CODE,CDEB,CDEB2,TABUL
      CHARACTER(LEN=3)      LLONG,LLDECI
      CHARACTER(LEN=72)     FORMA,LIGNE2
      DOUBLE PRECISION RSIGNE , RVAL
!
!***********************************************************************
!
      lufic = .false.
      lisuiv = .false.
      vupoin = .false.
      tabul = char(9)
!
      i1     = next( icol+1 , ligne )
!
!     //// DETERMINES THE FORMAT: F OR E ////
!
      formae = .false.
!
!     //// DECODES THE SIGN IF NEED BE ////
!
      rsigne = +1.d0
      IF ( ligne(i1:i1).EQ.'-' ) THEN
        rsigne = -1.d0
        i1     =   next( i1+1      , ligne )
      ELSE IF ( ligne(i1:i1).EQ.'+' ) THEN
        rsigne = +1.d0
        i1     =   next( i1+1      , ligne )
      ENDIF
!
!     //// SEEKS THE FIRST WHITE CHARACTER FOLLOWING THE NUMBER ////
!                       OR A SEPARATOR ';'
!
      i2     = preval(  i1  , ligne ,  ' ' , ';' ,tabul)
!
!     CASE WHERE THE REAL DOES NOT FINISH ON THE LINE                                                                                                                                                                                                                                                                                                                                                                                                                                              LINE
!
      IF (i2.GT.longli) THEN
        lufic=.true.
        READ(nfic,end=900,err=998,fmt='(A)') ligne2
        cdeb = ligne2(1:1)
        cdeb2 = ligne2(2:2)
!
        IF ((cdeb.EQ.'0'.OR.cdeb.EQ.'1'.OR.cdeb.EQ.'2'.OR.
     &       cdeb.EQ.'3'.OR.cdeb.EQ.'4'.OR.cdeb.EQ.'5'.OR.
     &       cdeb.EQ.'6'.OR.cdeb.EQ.'7'.OR.cdeb.EQ.'8'.OR.
     &       cdeb.EQ.'9'.OR.cdeb.EQ.'.'.OR.cdeb.EQ.'+'.OR.
     &       cdeb.EQ.'-'.OR.cdeb.EQ.',')
!
     &     .OR.
!
! CASE WHERE IT DEPENDS ON THE SECOND CHARACTER OF THE FOLLOWING LINE
!
     &     ( (cdeb.EQ.'E'.OR.cdeb.EQ.'D')
     &     .AND.
     &     ( cdeb2.EQ.'0'.OR.cdeb2.EQ.'1'.OR.cdeb2.EQ.'2'.OR.
     &       cdeb2.EQ.'3'.OR.cdeb2.EQ.'4'.OR.cdeb2.EQ.'5'.OR.
     &       cdeb2.EQ.'6'.OR.cdeb2.EQ.'7'.OR.cdeb2.EQ.'8'.OR.
     &       cdeb2.EQ.'9'.OR.cdeb2.EQ.'+'.OR.cdeb2.EQ.'-'    )))
!
     &     THEN
!
          lisuiv = .true.
          i3=1
          i3=preval(i3,ligne2 , ' ' , ';' ,tabul)
          IF (i1.LE.longli) THEN
            ligne = ligne(i1:longli)//ligne2(1:i3)
          ELSE
            ligne = ligne2(1:i3)
          ENDIF
          i2 = longli-i1+1+i3
          i1 = 1
        ENDIF
      ENDIF
      GOTO 910
!
 900  CONTINUE
      retour = .true.
 910  CONTINUE
!
!     ILONG: LENGTH OF THE REAL
      ilong  = i2 - i1
      ipoint = i2 - 1
      ifdeci = i2 - 1
      DO i = i1 , i2-1
!       ACCEPTS '.' AND ','
        IF ( ligne(i:i).EQ.'.' ) THEN
          ipoint = i
          vupoin=.true.
        ELSEIF ( ligne(i:i).EQ.',' ) THEN
          ligne(i:i)='.'
          ipoint = i
          vupoin=.true.
        ELSEIF (ligne(i:i).EQ.'E') THEN
!       ACCEPTS BOTH FORMATS E AND D
          formae = .true.
          ifdeci = i-1
        ELSEIF (ligne(i:i).EQ.'D') THEN
          ligne(i:i)='E'
          formae = .true.
          ifdeci = i-1
        ENDIF
      ENDDO ! I
!
!     //// NUMBER OF DECIMAL POINTS ///
!
      IF (vupoin) THEN
        ildeci = ifdeci - ipoint
      ELSE
        ildeci = 0
      ENDIF
!
!     //// DECODING FORMAT ////
!
      code = 'F'
      IF ( formae ) code = 'E'
      jd1 = 3 - int(log10(dble(ilong)))
      WRITE (llong,'(I3)') ilong
      jd2 = 3
      IF ( ildeci.GT.0 ) jd2 = 3-int(log10(dble(ildeci)))
      WRITE (lldeci,'(I3)') ildeci
      IF ( i1.GT.1 ) THEN
        WRITE ( forma , 1010 )  i1-1,code,llong(jd1:3),lldeci(jd2:3)
      ELSE
        WRITE ( forma , 1020 )  code,llong(jd1:3),lldeci(jd2:3)
      ENDIF
!
1010  FORMAT('(',i3,'X,',a1,a,'.',a,')' )
1020  FORMAT('(',a1,a,'.',a,')' )
!
!     ////  DECODES ////
!
      READ  ( ligne , forma , err=995 ) rval
      realu = rsigne * rval
!
!     //// UPDATES THE POINTER ////
!
      IF (lufic) THEN
        nlign = nlign + 1
        ligne = ligne2
        IF (lisuiv) THEN
          icol = i3-1
        ELSE
          icol = 0
        ENDIF
      ELSE
        icol = i2 - 1
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
!
! TREATS THE ERRORS DUE TO THE INTERNAL READ FOR CONVERSION
!
995   CONTINUE
      WRITE(lu,1996) nlign
      WRITE(lu,*) ligne
1996  FORMAT(1x,'ERREUR LINE ',1i6,', REAL EXPECTED : ',/)
      erreur=.true.
      RETURN
!
! TREATS THE ERRORS DUE TO FILE MISREADING
!
998   CONTINUE
      WRITE(lu,1999) nfic,nlign+1
1999  FORMAT(1x,'LOGICAL UNIT ',1i2,'   ERROR LINE ',1i6)
      retour = .true.
      RETURN
!
      END