lecstb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\lecstb.f
00002 !
00031                         SUBROUTINE LECSTB
00032 !                       *****************
00033 !
00034      &( X , Y ,IKLE , NCOLOR , TITRE , NPOIN1 ,
00035      &  NGEO , NSEC2,NSEC3,NSEC11,NSEC12)
00036 !
00037 !***********************************************************************
00038 ! PROGICIEL : STBTEL V5.2         09/08/89    J-C GALLAND  (LNH)
00039 !***********************************************************************
00040 !
00041 !     FONCTION  :  LECTURE DU FICHIER DE LA GEOMETRIE CREE PAR SUPERTAB
00042 !
00043 !-----------------------------------------------------------------------
00044 !                             ARGUMENTS
00045 ! .________________.____.______________________________________________
00046 ! |      NOM       |MODE|                   ROLE
00047 ! |________________|____|______________________________________________
00048 ! |   X,Y          |<-- | COORDONNEES DU MAILLAGE .
00049 ! |   IKLE         |<-- | LISTE DES POINTS DE CHAQUE ELEMENT
00050 ! |   NCOLOR       |<-- | TABLEAU DES COULEURS DES POINTS DU MAILLAGE
00051 ! |   TITRE        |<-- | TITRE DU MAILLAGE
00052 ! |   TRAV1,2      |<-->| TABLEAUX DE TRAVAIL
00053 ! |   NPOIN1       | -->| NOMBRE TOTAL DE POINTS
00054 ! |________________|____|______________________________________________
00055 ! | COMMON:        |    |
00056 ! |  GEO:          |    |
00057 ! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
00058 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00059 ! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00060 ! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00061 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00062 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00063 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00064 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00065 ! |  FICH:         |    |
00066 ! |    NRES        |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
00067 ! |    NGEO       |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
00068 ! |    NLIM      |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
00069 ! |    NFO1      |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
00070 ! |  SECT:         |    |
00071 ! |    NSEC11      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
00072 ! |                |    | (LECTURE EN SIMPLE PRECISION)
00073 ! |    NSEC12      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
00074 ! |                |    | (LECTURE EN DOUBLE PRECISION)
00075 ! |    NSEC2       |--> | INDICATEUR DU SECTEUR CONTENANT LES ELEMENTS
00076 ! |    NSEC3       |--> | INDICATEUR DU SECTEUR CONTENANT LE TITRE
00077 ! |________________|____|______________________________________________
00078 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00079 !----------------------------------------------------------------------
00080 ! APPELE PAR : STBTEL
00081 ! APPEL DE : -
00082 !***********************************************************************
00083 !
00084 !    LISTE DES ENREGISTREMENTS DU FICHIER GEOMETRIQUE:
00085 !             (DOCUMENTION: NOTICE SUPERTAB)
00086 !
00087 !***********************************************************************
00088 !
00089       IMPLICIT NONE
00090       INTEGER LNG,LU
00091       COMMON/INFO/LNG,LU
00092 !
00093       INTEGER INDIC3 , NGEO , NPOIN , NSEC3 , NPOIN1 , N1 , N2 ,NCOLOI
00094       INTEGER NELEM , MESH , NDP , NELMAX , NPMAX
00095       INTEGER IKLE(NELMAX,4) , NCOLOR(*)
00096       INTEGER NSEC11 , NSEC12 , NSEC2 , NSEC
00097       INTEGER INDIC1 , INDIC2 , I
00098 !
00099       DOUBLE PRECISION X(*) , Y(*) , X2 , Y2
00100       REAL X1 , Y1
00101 !
00102       CHARACTER*2  MOINS1
00103       CHARACTER*80 TITRE
00104       CHARACTER*4  BLANC
00105 !
00106       INTRINSIC DBLE
00107 !
00108 ! COMMON
00109 !
00110       COMMON/GEO/ MESH , NDP , NPOIN , NELEM , NPMAX , NELMAX
00111 !
00112 !=======================================================================
00113 !   INITIALISATION
00114 !=======================================================================
00115 !
00116       INDIC1 = 0
00117       INDIC2 = 0
00118       INDIC3 = 0
00119       REWIND NGEO
00120 !
00121       DO I=1,NPOIN
00122         X(I) = 9999999.D0
00123         Y(I) = 9999999.D0
00124         NCOLOR(I) = 99999
00125       ENDDO
00126 !
00127 !=======================================================================
00128 ! LECTURE SEQUENTIELLE DU FICHIER ET RECHERCHE DES INDICATEURS
00129 ! NSEC1 , NSEC2 ET NSEC3
00130 !=======================================================================
00131 !
00132  10   READ(NGEO,1000,ERR=110,END=120) BLANC,MOINS1
00133       IF (MOINS1.NE.'-1'.OR.BLANC.NE.'    ') GOTO 10
00134  1000 FORMAT(A4,A2)
00135 !
00136  20   READ(NGEO,2000,ERR=110,END=120) NSEC
00137       IF (NSEC.EQ.-1) THEN
00138         GOTO 20
00139 !
00140 !=======================================================================
00141 ! LECTURE DU TITRE DU MAILLAGE
00142 !=======================================================================
00143 !
00144       ELSE IF (NSEC.EQ.NSEC3) THEN
00145         INDIC3 = 1
00146         READ(NGEO,25,ERR=110,END=120) TITRE
00147  25     FORMAT(A80)
00148 !
00149 !=======================================================================
00150 ! LECTURE DES COORDONNEES ET DE LA COULEUR DES POINTS
00151 !=======================================================================
00152 !
00153 ! LECTURE EN SIMPLE PRECISION
00154 !
00155       ELSE IF (NSEC.EQ.NSEC11) THEN
00156         INDIC1 = 1
00157 !
00158         DO I=1,NPOIN1
00159           READ(NGEO,35,ERR=110,END=120) NSEC,N1,N2,NCOLOI,X1,Y1
00160 !
00161 ! PASSAGE EN DOUBLE PRECISION
00162 !
00163           X(NSEC) = DBLE(X1)
00164           Y(NSEC) = DBLE(Y1)
00165           NCOLOR(NSEC) = NCOLOI
00166         ENDDO
00167 !
00168  35     FORMAT(4I10,2E13.5)
00169 !
00170         GOTO 50
00171 !
00172 ! LECTURE EN DOUBLE PRECISION
00173 !
00174       ELSE IF (NSEC.EQ.NSEC12) THEN
00175         INDIC1 = 1
00176 !
00177         DO I=1,NPOIN1
00178           READ(NGEO,36,ERR=110,END=120) NSEC,N1,N2,NCOLOI
00179           READ(NGEO,37,ERR=110,END=120) X2,Y2
00180           X(NSEC) = X2
00181           Y(NSEC) = Y2
00182           NCOLOR(NSEC) = NCOLOI
00183         ENDDO
00184 !
00185  36     FORMAT(4I10)
00186  37     FORMAT(2D25.16)
00187 !
00188         GOTO 50
00189 !
00190 !=======================================================================
00191 ! LECTURE DE IKLE
00192 !=======================================================================
00193 !
00194       ELSE IF (NSEC.EQ.NSEC2) THEN
00195         INDIC2 = 1
00196         DO I=1,NELEM
00197           IF (MESH.EQ.2) THEN
00198             READ(NGEO,2000,ERR=110,END=120) NSEC
00199             READ(NGEO,4000,ERR=110,END=120) IKLE(I,1),IKLE(I,2),
00200      &                                       IKLE(I,3),IKLE(I,4)
00201           ELSE IF (MESH.EQ.3) THEN
00202             READ(NGEO,2000,ERR=110,END=120) NSEC
00203             READ(NGEO,4000,ERR=110,END=120) IKLE(I,1),IKLE(I,2),
00204      &                                       IKLE(I,3)
00205           ELSE
00206             IF (LNG.EQ.1) WRITE(LU,1400) MESH
00207             IF (LNG.EQ.2) WRITE(LU,4400) MESH
00208  1400       FORMAT(2X,'TYPE DE MAILLAGE NON PREVU : MESH = ',I3)
00209  4400       FORMAT(2X,'TYPE OF MESH NOT AVAILABLE : MESH = ',I3)
00210             CALL PLANTE(1)
00211             STOP
00212           ENDIF
00213         ENDDO
00214         GOTO 50
00215 !
00216       ENDIF
00217 !
00218  50   IF (INDIC1.EQ.1.AND.INDIC2.EQ.1.AND.INDIC3.EQ.1) THEN
00219         GOTO 60
00220       ELSE
00221         GOTO 10
00222       ENDIF
00223 !
00224  110  IF (LNG.EQ.1) WRITE(LU,1100)
00225       IF (LNG.EQ.2) WRITE(LU,4100)
00226       CALL PLANTE(1)
00227       STOP
00228  120  IF (LNG.EQ.1) WRITE(LU,1200)
00229       IF (LNG.EQ.2) WRITE(LU,4200)
00230       CALL PLANTE(1)
00231       STOP
00232 !
00233  60   CONTINUE
00234 !
00235  2000 FORMAT(I10)
00236  4000 FORMAT(4I10)
00237  1100 FORMAT(/,'*************************************************',/,
00238      &         'ERREUR A LA LECTURE DU FICHIER UNIVERSEL (LECSTB)',/,
00239      &         '*************************************************')
00240  4100 FORMAT(/,'****************************************',/,
00241      &         'ERROR IN READING UNIVERSAL FILE (LECSTB)',/,
00242      &         '****************************************')
00243  1200 FORMAT(/,'******************************************',/,
00244      &         'FIN DU FICHIER UNIVERSEL : ERREUR (LECSTB)',/,
00245      &         '******************************************')
00246  4200 FORMAT(/,'******************************************',/,
00247      &         'END OF THE UNIVERSAL FILE : ERROR (LECSTB)',/,
00248      &         '******************************************')
00249 !
00250       RETURN
00251       END

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