The TELEMAC-MASCARET system  trunk
lecsel.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE lecsel
3 ! *****************
4 !
5  &(xinit,yinit,ikinit,npinit,neinit,x,y,ikle,ikles,w,titre,texte,
6  & nvarin,nvar2,std,fusion,ngeo,nfo1,ipobo,iparam,date,
7  & time,x_orig,y_orig)
8 !
9 !***********************************************************************
10 ! PROGICIEL : STBTEL V5.2 11/02/93 J.M. JANIN
11 !***********************************************************************
12 !
13 ! FONCTION : RECHERCHE LES NOMBRES TOTAUX DE NOEUDS ET D'ELEMENTS DU
14 ! MAILLAGE DANS LE FICHIER D'ENTREE SELAFIN
15 !
16 !-----------------------------------------------------------------------
17 ! ARGUMENTS
18 ! .________________.____.______________________________________________
19 ! | NOM |MODE| ROLE
20 ! |________________|____|______________________________________________
21 ! | NPOIN1 |<-- | NOMBRE REEL DE POINTS DU MAILLAGE
22 ! | | | (NPOIN REPRESENTE L'INDICE MAX DES NOEUDS CAR
23 ! | | | SUPERTAB LAISSE DES TROUS DANS LA NUMEROTATION
24 ! | TYPELE |<-- | TYPE D'ELEMENTS
25 ! |________________|____|______________________________________________
26 ! | COMMON: | |
27 ! | GEO: | |
28 ! | MESH |<-- | TYPE DES ELEMENTS DU MAILLAGE
29 ! | NDP | -->| NOMBRE DE NOEUDS PAR ELEMENTS
30 ! | NPOIN |<-- | NOMBRE TOTAL DE NOEUDS DU MAILLAGE
31 ! | NELEM |<-- | NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
32 ! | NPMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
33 ! | | | (NPMAX = NPOIN + 0.1*NELEM)
34 ! | NELMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
35 ! | | | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
36 ! | FICH: | |
37 ! | NRES |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
38 ! | NGEO |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
39 ! | NLIM |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
40 ! | NFO1 |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
41 ! |________________|____|______________________________________________
42 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
43 !-----------------------------------------------------------------------
44 ! APPELE PAR : HOMERE
45 ! APPEL DE : -
46 !***********************************************************************
47 !
50  & typ_elem,typ_bnd_elem
52  USE interface_stbtel, ex_lecsel => lecsel
53  IMPLICIT NONE
54 !
55  DOUBLE PRECISION, INTENT(INOUT) :: XINIT(*), YINIT(*), X(*), Y(*)
56  REAL, INTENT(INOUT) :: W(*)
57  INTEGER, INTENT(IN) :: NGEO , NFO1
58  INTEGER, INTENT(INOUT) :: IPARAM(10),DATE(3),TIME(3)
59  INTEGER, INTENT(INOUT) :: NEINIT , NPINIT
60  INTEGER, INTENT(INOUT) :: NVARIN , NVAR2
61  INTEGER, INTENT(INOUT) :: IKINIT(nelem,ndp)
62  INTEGER, INTENT(INOUT) :: IKLE(nelmax,ndp),IKLES(ndp,nelem)
63  INTEGER, INTENT(INOUT) :: IPOBO(*)
64  LOGICAL, INTENT(IN) :: FUSION
65  INTEGER, INTENT(INOUT) :: X_ORIG, Y_ORIG
66  CHARACTER(LEN=72), INTENT(INOUT) :: TITRE
67  CHARACTER(LEN=32), INTENT(INOUT) :: TEXTE(26)
68  CHARACTER(LEN=3), INTENT(IN) :: STD
69 !
70  INTEGER NPOIN1 , NELEM1 , NPOIN2 , NELEM2
71  INTEGER I , IELEM
72  CHARACTER(LEN=80) FULL_TITLE
73 
74  CHARACTER(LEN=16), ALLOCATABLE :: VARUNIT(:), VARNAME(:)
75  INTEGER :: IERR
76  INTEGER DATETIME(6)
77  INTEGER NPTFR
78 !
79 !
80 !=======================================================================
81 ! LECTURE SEQUENTIELLE DU PREMIER FICHIER
82 !=======================================================================
83 !
84  CALL get_mesh_title(fformat, ngeo, full_title, ierr)
85  CALL check_call(ierr, 'LECSEL:GET_MESH_TITLE')
86  titre = full_title(1:72)
87 
88  CALL get_data_nvar(fformat, ngeo, nvarin, ierr)
89  CALL check_call(ierr, 'LECSEL:GET_DATA_NVAR')
90 
91  IF(nvarin.GT.26) THEN
92  WRITE(lu,*) 'NVAR > 26 NOT HANDLED'
93  CALL plante(1)
94  ENDIF
95 
96  ALLOCATE(varunit(nvarin))
97  ALLOCATE(varname(nvarin))
98  CALL get_data_var_list(fformat,ngeo,nvarin,varname,varunit,ierr)
99  CALL check_call(ierr, 'LECSEL:GET_DATA_VAR_LIST')
100  DO i=1,nvarin
101  texte(i)(1:16) = varname(i)
102  texte(i)(17:32) = varunit(i)
103  ENDDO
104  DEALLOCATE(varunit)
105  DEALLOCATE(varname)
106 
107  CALL get_mesh_date(fformat,ngeo,datetime,ierr)
108  CALL check_call(ierr, 'LECSEL:GET_MESH_DATA')
109  date = datetime(1:3)
110  time = datetime(4:6)
111 
112  CALL get_mesh_nelem(fformat,ngeo,typ_elem,nelem1,ierr)
113  CALL check_call(ierr, 'GET_MESH_NELEM:TRIA')
114 
115  CALL get_mesh_npoin(fformat,ngeo,typ_elem,npoin1,ierr)
116  CALL check_call(ierr, 'GET_MESH_NPOIN:TRIA')
117 
118  CALL get_mesh_connectivity(fformat,ngeo,typ_elem,ikles,
119  & nelem1,ndp,ierr)
120  CALL check_call(ierr, 'GET_MESH_CONNECTIVITY:TRIA')
121 
122  CALL get_bnd_npoin(fformat,ngeo,typ_bnd_elem,nptfr,ierr)
123  WRITE(lu,*) 'NPTFR FROM LECSEL ', nptfr
124 
125  CALL get_bnd_ipobo(fformat,ngeo,npoin,nptfr,
126  & typ_bnd_elem,ipobo,ierr)
127 
128  CALL get_mesh_coord(fformat,ngeo,1,2,npoin1,x,ierr)
129  CALL get_mesh_coord(fformat,ngeo,2,2,npoin1,y,ierr)
130  CALL get_mesh_orig(fformat,ngeo,x_orig,y_orig,ierr)
131 !
132 !=======================================================================
133 ! LECTURE SEQUENTIELLE DU SECOND FICHIER EN CAS DE FUSION
134 !=======================================================================
135 !
136  IF (fusion) THEN
137 !
138  CALL get_mesh_nelem(fformat,nfo1,typ_elem,nelem2,ierr)
139  CALL check_call(ierr, 'GET_MESH_NELEM:TRIA')
140 
141  CALL get_mesh_npoin(fformat,nfo1,typ_elem,npoin2,ierr)
142  CALL check_call(ierr, 'GET_MESH_NPOIN:TRIA')
143 !
144  CALL get_mesh_connectivity(fformat,ngeo,typ_elem,
145  & ikles(1,nelem1+1),
146  & nelem2,ndp,ierr)
147  CALL check_call(ierr, 'GET_MESH_CONNECTIVITY:TRIA')
148 
149  CALL get_mesh_coord(fformat,ngeo,1,2,npoin2,x(npoin1+1),ierr)
150  CALL get_mesh_coord(fformat,ngeo,2,2,npoin2,y(npoin1+1),ierr)
151 !
152  ENDIF
153 !
154 !=======================================================================
155 ! AFFECTATION DES VALEURS LUES AUX VARIABLES CONCERNEES
156 !=======================================================================
157 !
158  neinit = nelem
159  npinit = npoin
160 !
161 ! INVERSION DE IKLES EN IKLE.
162 !
163  DO i = 1,ndp
164  DO ielem = 1,nelem1
165  ikle(ielem,i) = ikles(i,ielem)
166  ikinit(ielem,i) = ikles(i,ielem)
167  ENDDO
168  IF (fusion) THEN
169  DO ielem = nelem1+1,nelem
170  ikle(ielem,i) = ikles(i,ielem) + npoin1
171  ikinit(ielem,i) = ikles(i,ielem) + npoin1
172  ENDDO
173  ENDIF
174  ENDDO
175 !
176  DO i = 1,npoin
177  xinit(i) = x(i)
178  yinit(i) = y(i)
179  ENDDO
180 !
181 !=======================================================================
182 !
183  RETURN
184  END
subroutine get_mesh_npoin(FFORMAT, FID, TYP_ELEM, NPOIN, IERR)
Definition: get_mesh_npoin.f:7
subroutine get_bnd_npoin(FFORMAT, FID, TYPE_BND_ELEM, NPTFR, IERR)
Definition: get_bnd_npoin.f:7
subroutine get_mesh_orig(FFORMAT, FID, X_ORIG, Y_ORIG, IERR)
Definition: get_mesh_orig.f:7
subroutine get_data_nvar(FFORMAT, FID, NVAR, IERR)
Definition: get_data_nvar.f:7
character(len=8) fformat
subroutine get_data_var_list(FFORMAT, FID, NVAR, VARLIST, UNITLIST, IERR)
subroutine get_bnd_ipobo(FFORMAT, FID, NPOIN, NELEBD, TYP_BND_ELEM, IPOBO, IERR)
Definition: get_bnd_ipobo.f:7
subroutine get_mesh_nelem(FFORMAT, FID, TYP_ELEM, NELEM, IERR)
Definition: get_mesh_nelem.f:7
subroutine get_mesh_title(FFORMAT, FID, TITLE, IERR)
Definition: get_mesh_title.f:7
subroutine get_mesh_date(FFORMAT, FID, DATE, IERR)
Definition: get_mesh_date.f:7
subroutine get_mesh_coord(FFORMAT, FID, JDIM, NDIM, NPOIN, COORD, IERR)
Definition: get_mesh_coord.f:7
subroutine get_mesh_connectivity(FFORMAT, FID, TYP_ELEM, IKLE, NELEM, NDP, IERR)
subroutine lecsel(XINIT, YINIT, IKINIT, NPINIT, NEINIT, X, Y, IKLE, IKLES, W, TITRE, TEXTE, NVARIN, NVAR2, STD, FUSION, NGEO, NFO1, IPOBO, IPARAM, DATE, TIME, X_ORIG, Y_ORIG)
Definition: lecsel.f:9