lit.F

Go to the documentation of this file.

!                   **************
                    SUBROUTINE lit
!                   **************
!
     &( x , w , i , c , nval , TYPE , canal , std2 , istat )
!
!***********************************************************************
! HERMES   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    READS VALUES ACCORDING TO VARIOUS STANDARDS.
!
!warning  IF THE CHARACTER STRING STD EQUALS IBM OR I3E, CALLS THE
!+            SUBROUTINES LECIBM OR LECI3E, WHICH DEPEND ON THE TYPE
!+            OF MACHINE USED
!
!history  J-M HERVOUET (LNHE)
!+        01/04/2009
!+        V6P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| X              |-->| DOUBLE PRECISION ARRAY TO BE READ
!| W              |<--| REAL WORK ARRAY (IN CASE OF
!|                |   | CONVERSION FROM SIMPLE TO DOUBLE PRECISION)
!| I              |-->| INTEGER ARRAY TO BE READ
!| C              |<--| CHARACTER STRING TO BE READ
!| NVAL           |-->| NUMBER OF VALUES (INTEGER, CHARACTER, ETC.)
!|                |   | TO BE READ
!| TYPE           |-->| TYPE OF DATA : 'I' , 'CH' , 'R4' , 'R8'
!| CANAL          |-->| LOGICAL UNIT FOR READING
!| STD2           |-->| INPUT STANDARD : STD , IBM OU I3E, ETC.
!| ISTAT          |<--| ERROR NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: NVAL,CANAL
      INTEGER, INTENT(INOUT)          :: ISTAT
      CHARACTER(LEN=*), INTENT(IN)       :: TYPE,STD2
      INTEGER, INTENT(INOUT)          :: I(*)
      DOUBLE PRECISION, INTENT(INOUT) :: X(*)
      REAL, INTENT(INOUT)             :: W(*)
      CHARACTER(LEN=*), INTENT(INOUT)    :: C
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER J
      CHARACTER(LEN=8) STD
!
      INTRINSIC dble,min,len
!
!-----------------------------------------------------------------------
!
      istat = 0
!
!-----------------------------------------------------------------------
!
!     STD2 MAY BE SHORTER THAN 8 CHARACTERS
      std='        '
      std(1:min(8,len(std2)))=std2(1:min(8,len(std2)))
!
!-----------------------------------------------------------------------
!
      IF(std(1:3).EQ.'STD'.OR.std(1:7).EQ.'SERAFIN') THEN
!
        IF(TYPE(1:2).EQ.'R4') then
          READ(canal,end=100,err=101)(w(j),j=1,nval)
          DO j=1,nval
            x(j) = dble(w(j))
          ENDDO
        ELSEIF(TYPE(1:2).EQ.'R8') then
          READ(canal,end=100,err=101)(x(j),j=1,nval)
        ELSEIF (TYPE(1:1).EQ.'I') then
          READ(canal,end=100,err=101)(i(j),j=1,nval)
        ELSEIF(TYPE(1:2).EQ.'CH') then
          READ(canal,end=100,err=101) c(1:nval)
        ELSE
          WRITE(lu,21) TYPE
21        FORMAT(1x,'LIT : UNKNOWN TYPE :',a2)
          CALL plante(1)
          stop
        ENDIF
!
        GO TO 102
!
100     CONTINUE
        WRITE(lu,'(1X,A)')       'LIT : ABNORMAL END OF FILE'
        WRITE(lu,'(1X,A)')       'ONE INTENDED TO READ'
        WRITE(lu,'(1X,A,1I6,A)') 'A RECORD OF ',nval,' VALUES'
        WRITE(lu,'(1X,A,A)')     'OF TYPE : ',TYPE
        WRITE(lu,'(1X,A,1I6)')   'ON LOGICAL UNIT : ',canal
!       ISTAT = -6
        CALL plante(1)
        stop
!
101     CONTINUE
        WRITE(lu,'(1X,A)')       'LIT : READ ERROR'
        WRITE(lu,'(1X,A)')       'ONE INTENDED TO READ'
        WRITE(lu,'(1X,A,1I6,A)') 'A RECORD OF ',nval,' VALUES'
        WRITE(lu,'(1X,A,A)')     'OF TYPE : ',TYPE
        WRITE(lu,'(1X,A,1I6)')   'ON LOGICAL UNIT : ',canal
!       ISTAT = -6
        CALL plante(1)
        stop
!
102     CONTINUE
!
      ELSE
!
        WRITE(lu,11) std
11      FORMAT(1x,'LIT : UNKNOWN STANDARD:',a8)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END