The TELEMAC-MASCARET system  trunk
lectri.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE lectri
3 ! *****************
4 !
5  & (x, y, ikle, ncolor,ngeo , nfo1)
6 !
7 !***********************************************************************
8 ! PROGICIEL : STBTEL V5.2 18/08/93 P. LANG (LHF)
9 !***********************************************************************
10 !
11 ! FONCTION : LECTURE DES INFOS DE GEOMETRIE DANS LES FICHIERS TRIGR
12 !
13 !-----------------------------------------------------------------------
14 ! ARGUMENTS
15 ! .________________.____.______________________________________________
16 ! ! NOM !MODE! ROLE
17 ! !________________!____!______________________________________________
18 ! ! X,Y !<-- ! COORDONNEES DES POINTS DU MAILLAGE
19 ! ! IKLE !<-- ! NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
20 ! ! NCOLOR !<-- ! TABLEAU DES COULEURS DES NOEUDS(POUR LES CL)
21 ! ! NGEO !--> ! NUMERO DU CANAL DU FICHIER MAILLEUR
22 ! ! NFO1 !--> ! NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
23 ! !________________!____!______________________________________________
24 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
25 !-----------------------------------------------------------------------
26 ! APPELE PAR :
27 ! APPEL DE :
28 !***********************************************************************
29 !
32  IMPLICIT NONE
33 !
34  INTEGER, INTENT(IN) :: NGEO, NFO1
35  INTEGER, INTENT(INOUT) :: IKLE(nelmax,4)
36  INTEGER, INTENT(INOUT) :: NCOLOR(*)
37  DOUBLE PRECISION, INTENT(INOUT) :: X(*), Y(*)
38 !
39  INTEGER ITYPND,NUMNOD,I,J
40 !
41 ! COMMON
42 !
43 !
44  rewind(ngeo)
45  rewind(nfo1)
46  READ (ngeo,'(//)')
47  DO i=1,npoin
48  READ (ngeo,*,err=8000,end=9000) numnod,x(i),y(i),itypnd
49  IF (itypnd.EQ.1) ncolor(i) = 11
50  IF (itypnd.EQ.2) ncolor(i) = 4
51  IF (itypnd.EQ.3) ncolor(i) = 5
52  IF (itypnd.EQ.4) ncolor(i) = 7
53  IF (itypnd.EQ.5) ncolor(i) = 8
54  IF (itypnd.EQ.6) ncolor(i) = 9
55  IF (itypnd.EQ.7) ncolor(i) = 1
56  IF (itypnd.EQ.8) ncolor(i) = 12
57  IF (itypnd.EQ.9) ncolor(i) = 15
58  IF (itypnd.EQ.10) ncolor(i) = 2
59  IF (itypnd.EQ.11) ncolor(i) = 3
60  IF (itypnd.EQ.12) ncolor(i) = 14
61  IF (itypnd.EQ.13) ncolor(i) = 13
62  ENDDO
63 !
64  DO i=1,nelem
65  READ (nfo1, * , err=8010, end=9010) (ikle(i,j),j=1,3)
66  ENDDO
67  RETURN
68  8000 CONTINUE
69  WRITE (lu,4001)
70  4001 FORMAT (//,1x,'****************************'
71  & ,/,1x,'SUBROUTINE LECTRI :'
72  & ,/,1x,'ERROR READING TRIGRID FILE.'
73  & ,/,1x,'****************************')
74  CALL plante(1)
75  stop
76  9000 CONTINUE
77  WRITE (lu,4011)
78  4011 FORMAT (//,1x,'***************************************'
79  & ,/,1x,'SUBROUTINE LECTRI : UNEXPECTED END OF'
80  & ,/,1x,'TRIGRID FILE ENCOUNTERED'
81  & ,/,1x,'***************************************')
82  CALL plante(1)
83  stop
84  8010 CONTINUE
85  WRITE (lu,4021)
86  4021 FORMAT (//,1x,'***************************************'
87  & ,/,1x,'SUBROUTINE LECTRI : ERROR READING'
88  & ,/,1x,'TRIGRID TRIANGLE FILE'
89  & ,/,1x,'***************************************')
90  CALL plante(1)
91  stop
92  9010 CONTINUE
93  WRITE (lu,4031)
94  4031 FORMAT (//,1x,'***************************************'
95  & ,/,1x,'SUBROUTINE LECTRI : END OF'
96  & ,/,1x,'TRIGRID TRIANGLE FILE ENCOUNTERED'
97  & ,/,1x,'***************************************')
98  CALL plante(1)
99  stop
100  END
subroutine lectri(X, Y, IKLE, NCOLOR, NGEO, NFO1)
Definition: lectri.f:7