The TELEMAC-MASCARET system  trunk
ecrsel.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE ecrsel
3 ! *****************
4 !
5  &(vainit,ikinit,npinit,neinit,shp,elt,npoin,npoin1,npmax,w,
6  & x,zf,nsfond,ncolor,color,var,nvarin,nvarou,nvar2,std,fusion,
7  & nres,ngeo,nfo1,maille,texte)
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 !
49  USE interface_stbtel, ex_ecrsel => ecrsel
52  IMPLICIT NONE
53 !
54  INTEGER, INTENT(IN) :: NPINIT,NEINIT,NPOIN,NPMAX
55  INTEGER, INTENT(IN) :: NPOIN1,NVAR2
56  DOUBLE PRECISION, INTENT(INOUT) :: VAINIT(npinit)
57  DOUBLE PRECISION, INTENT(IN) :: SHP(npmax,3)
58  INTEGER, INTENT(IN) :: IKINIT(neinit,3),ELT(npoin)
59  REAL, INTENT(INOUT) :: W(*)
60  DOUBLE PRECISION, INTENT(INOUT) :: X(npoin)
61  DOUBLE PRECISION, INTENT(IN) :: ZF(npoin)
62  INTEGER, INTENT(IN) :: NSFOND
63  INTEGER, INTENT(IN) :: NCOLOR(npoin)
64  LOGICAL, INTENT(IN) :: COLOR,FUSION
65  DOUBLE PRECISION, INTENT(INOUT) :: VAR(npoin)
66  INTEGER, INTENT(IN) :: NVARIN,NVAROU
67  CHARACTER(LEN=3), INTENT(IN) :: STD
68  INTEGER, INTENT(IN) :: NGEO,NRES,NFO1
69  CHARACTER(LEN=9), INTENT(IN) :: MAILLE
70  CHARACTER(LEN=32), INTENT(IN) ::TEXTE(nvarin)
71 !
72  INTEGER NPOIN2
73  INTEGER IVAR,IPOIN,I
74 !
75  DOUBLE PRECISION TIME
76  INTEGER NTIMESTEP, IERR
77  CHARACTER(LEN=32) :: VARNAME
78 !
79 !=======================================================================
80 !
81  npoin2 = npinit - npoin1
82 
83  ntimestep = 1
84 
85  IF (maille.EQ.'SELAFIN') THEN
86 
87  CALL get_data_ntimestep(fformat, ngeo, ntimestep, ierr)
88  CALL check_call(ierr, 'ECRSEL:GET_DATA_NTIMESTEP')
89 
90  DO i=0,ntimestep-1
91  CALL get_data_time(fformat, ngeo, i, time, ierr)
92  CALL check_call(ierr, 'ECRSEL:GET_DATA_TIME')
93 
94  DO ivar = 1, nvarin
95  CALL get_data_value(fformat, ngeo, i, texte(ivar),
96  & vainit, npoin1, ierr)
97  CALL check_call(ierr,
98  & 'ECRSEL:GET_DATA_VALUE:'//texte(ivar))
99 
100  IF(fusion) THEN
101  CALL get_data_value(fformat, ngeo, i, texte(ivar),
102  & vainit(npoin1+1:npinit), npoin2, ierr)
103  IF(ierr.NE.0) THEN
104  vainit(npoin1+1:npinit) = 0.d0
105  ENDIF
106  ENDIF
107 
108  ! WRITTING DATA VALUE
109  IF(ivar.EQ.nsfond) THEN
110  var = zf
111  ELSE
112  DO ipoin = 1,npoin
113  var(ipoin) = vainit(ikinit(elt(ipoin),1))*shp(ipoin,1)
114  & + vainit(ikinit(elt(ipoin),2))*shp(ipoin,2)
115  & + vainit(ikinit(elt(ipoin),3))*shp(ipoin,3)
116  ENDDO
117  ENDIF
118  CALL add_data(out_format,nres,texte(ivar),time,i,
119  & ivar==1,var,npoin,ierr)
120  CALL check_call(ierr,
121  & 'ECRSEL:ADD_DATA_VALUE:'//texte(ivar))
122  ENDDO ! IVAR
123  ENDDO !I
124  ENDIF ! MAILLE=='SELAFIN'
125 
126  IF(nsfond.EQ.nvarin+1.OR.maille.EQ.'ADCIRC') THEN
127  varname = repeat(' ', 32)
128  varname = 'BOTTOM M'
129  ! WRITING BOTTOM FOR ALL TIMESTEPS
130  ivar=max(nsfond, 1)
131  DO i=0,ntimestep-1
132  CALL add_data(out_format,nres,varname,0.d0,i,
133  & ivar==1,zf,npoin,ierr)
134  CALL check_call(ierr, 'ECRSEL:ADD_DATA_VALUE:BOTTOM')
135  ENDDO
136  ENDIF
137  IF(nvarou.EQ.0.AND.maille.NE.'ADCIRC') THEN
138  varname = repeat(' ', 32)
139  varname = 'MAILLAGE'
140  CALL add_data(out_format,nres,varname,0.d0,0,
141  & .true.,x,npoin,ierr)
142  CALL check_call(ierr, 'ECRSEL:ADD_DATA_VALUE:BOTTOM')
143  ENDIF
144 !
145 !=======================================================================
146 !
147  RETURN
148  END
subroutine add_data(FFORMAT, FILE_ID, VAR_NAME, TIME, RECORD, FIRST_VAR, VAR_VALUE, N, IERR)
Definition: add_data.f:8
character(len=8) fformat
subroutine get_data_value(FFORMAT, FID, RECORD, VAR_NAME, RES_VALUE, N, IERR)
Definition: get_data_value.f:7
character(len=8) out_format
subroutine ecrsel(VAINIT, IKINIT, NPINIT, NEINIT, SHP, ELT, NPOIN, NPOIN1, NPMAX, W, X, ZF, NSFOND, NCOLOR, COLOR, VAR, NVARIN, NVAROU, NVAR2, STD, FUSION, NRES, NGEO, NFO1, MAILLE, TEXTE)
Definition: ecrsel.f:9
subroutine get_data_time(FFORMAT, FID, RECORD, TIME, IERR)
Definition: get_data_time.f:7
subroutine get_data_ntimestep(FFORMAT, FID, NTIMESTEP, IERR)