lecstb.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE lecstb
!                       *****************
!
     &( x , y ,ikle , ncolor , titre , npoin1 ,
     &  ngeo , nsec2,nsec3,nsec11,nsec12)
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2         09/08/89    J-C GALLAND  (LNH)
!***********************************************************************
!
!     FONCTION  :  LECTURE DU FICHIER DE LA GEOMETRIE CREE PAR SUPERTAB
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |   X,Y          |<-- | COORDONNEES DU MAILLAGE .
! |   IKLE         |<-- | LISTE DES POINTS DE CHAQUE ELEMENT
! |   NCOLOR       |<-- | TABLEAU DES COULEURS DES POINTS DU MAILLAGE
! |   TITRE        |<-- | TITRE DU MAILLAGE
! |   TRAV1,2      |<-->| TABLEAUX DE TRAVAIL
! |   NPOIN1       | -->| NOMBRE TOTAL DE POINTS
! |________________|____|______________________________________________
! | COMMON:        |    |
! |  GEO:          |    |
! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
! |  FICH:         |    |
! |    NRES        |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
! |    NGEO       |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
! |    NLIM      |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
! |    NFO1      |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
! |  SECT:         |    |
! |    NSEC11      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
! |                |    | (LECTURE EN SIMPLE PRECISION)
! |    NSEC12      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
! |                |    | (LECTURE EN DOUBLE PRECISION)
! |    NSEC2       |--> | INDICATEUR DU SECTEUR CONTENANT LES ELEMENTS
! |    NSEC3       |--> | INDICATEUR DU SECTEUR CONTENANT LE TITRE
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!----------------------------------------------------------------------
! APPELE PAR : STBTEL
! APPEL DE : -
!***********************************************************************
!
!    LISTE DES ENREGISTREMENTS DU FICHIER GEOMETRIQUE:
!             (DOCUMENTION: NOTICE SUPERTAB)
!
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel, ONLY: nelem,mesh,npoin,nelmax
      IMPLICIT NONE
!
      DOUBLE PRECISION, INTENT(INOUT) :: X(*) , Y(*)
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,4) , NCOLOR(*)
      CHARACTER(LEN=80), INTENT(INOUT) :: TITRE
      INTEGER, INTENT(IN) :: NPOIN1
      INTEGER, INTENT(IN) :: NGEO
      INTEGER, INTENT(IN) :: NSEC11 , NSEC12 , NSEC2 , NSEC3
!
      INTEGER INDIC3 , NSEC , N1 , N2 ,NCOLOI
      INTEGER INDIC1 , INDIC2 , I
!
      DOUBLE PRECISION X2 , Y2
      REAL X1 , Y1
!
      CHARACTER(LEN=2)  MOINS1
      CHARACTER(LEN=4)  BLANC
!
      INTRINSIC dble
!
!=======================================================================
!   INITIALISATION
!=======================================================================
!
      indic1 = 0
      indic2 = 0
      indic3 = 0
      rewind ngeo
!
      DO i=1,npoin
        x(i) = 9999999.d0
        y(i) = 9999999.d0
        ncolor(i) = 99999
      ENDDO
!
!=======================================================================
! LECTURE SEQUENTIELLE DU FICHIER ET RECHERCHE DES INDICATEURS
! NSEC1 , NSEC2 ET NSEC3
!=======================================================================
!
 10   READ(ngeo,1000,err=110,end=120) blanc,moins1
      IF (moins1.NE.'-1'.OR.blanc.NE.'    ') GOTO 10
 1000 FORMAT(a4,a2)
!
 20   READ(ngeo,2000,err=110,end=120) nsec
      IF (nsec.EQ.-1) THEN
        GOTO 20
!
!=======================================================================
! LECTURE DU TITRE DU MAILLAGE
!=======================================================================
!
      ELSE IF (nsec.EQ.nsec3) THEN
        indic3 = 1
        READ(ngeo,25,err=110,end=120) titre
 25     FORMAT(a80)
!
!=======================================================================
! LECTURE DES COORDONNEES ET DE LA COULEUR DES POINTS
!=======================================================================
!
! LECTURE EN SIMPLE PRECISION
!
      ELSE IF (nsec.EQ.nsec11) THEN
        indic1 = 1
!
        DO i=1,npoin1
          READ(ngeo,35,err=110,end=120) nsec,n1,n2,ncoloi,x1,y1
!
! PASSAGE EN DOUBLE PRECISION
!
          x(nsec) = dble(x1)
          y(nsec) = dble(y1)
          ncolor(nsec) = ncoloi
        ENDDO
!
 35     FORMAT(4i10,2e13.5)
!
        GOTO 50
!
! LECTURE EN DOUBLE PRECISION
!
      ELSE IF (nsec.EQ.nsec12) THEN
        indic1 = 1
!
        DO i=1,npoin1
          READ(ngeo,36,err=110,end=120) nsec,n1,n2,ncoloi
          READ(ngeo,37,err=110,end=120) x2,y2
          x(nsec) = x2
          y(nsec) = y2
          ncolor(nsec) = ncoloi
        ENDDO
!
 36     FORMAT(4i10)
 37     FORMAT(2d25.16)
!
        GOTO 50
!
!=======================================================================
! LECTURE DE IKLE
!=======================================================================
!
      ELSE IF (nsec.EQ.nsec2) THEN
        indic2 = 1
        DO i=1,nelem
          IF (mesh.EQ.2) THEN
            READ(ngeo,2000,err=110,end=120) nsec
            READ(ngeo,4000,err=110,end=120) ikle(i,1),ikle(i,2),
     &                                       ikle(i,3),ikle(i,4)
          ELSE IF (mesh.EQ.3) THEN
            READ(ngeo,2000,err=110,end=120) nsec
            READ(ngeo,4000,err=110,end=120) ikle(i,1),ikle(i,2),
     &                                       ikle(i,3)
          ELSE
            WRITE(lu,4400) mesh
 4400       FORMAT(2x,'TYPE OF MESH NOT AVAILABLE : MESH = ',i3)
            CALL plante(1)
            stop
          ENDIF
        ENDDO
        GOTO 50
!
      ENDIF
!
 50   IF (indic1.EQ.1.AND.indic2.EQ.1.AND.indic3.EQ.1) THEN
        GOTO 60
      ELSE
        GOTO 10
      ENDIF
!
 110  CONTINUE
      WRITE(lu,4100)
      CALL plante(1)
      stop
 120  CONTINUE
      WRITE(lu,4200)
      CALL plante(1)
      stop
!
 60   CONTINUE
!
 2000 FORMAT(i10)
 4000 FORMAT(4i10)
 4100 FORMAT(/,'****************************************',/,
     &         'ERROR IN READING UNIVERSAL FILE (LECSTB)',/,
     &         '****************************************')
 4200 FORMAT(/,'******************************************',/,
     &         'END OF THE UNIVERSAL FILE : ERROR (LECSTB)',/,
     &         '******************************************')
!
      RETURN
      END