The TELEMAC-MASCARET system  trunk
coupeh.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE coupeh
3 ! *****************
4 !
5  &(irec,at,z,u,v,w,href,nplref,plinf,nc2dh,npoin2,nplan,ncou,
6  & fformat,var,shz,nva3,tab,textelu)
7 !
8 !***********************************************************************
9 ! POSTEL3D VERSION 6.0 01/09/99 T. DENOT (LNH) 01 30 87 74 89
10 ! FORTRAN90
11 !***********************************************************************
12 !
13 ! FONCTION : ECRIT POUR CHAQUE COUPE HORIZONTALES LES VARIABLES
14 ! D'UN PAS DE TEMPS
15 !
16 ! ATTENTION : LORSQUE LE PLAN DE COUPE SE SITUE EN DEHORS DU DOMAINE
17 ! (EN DESSOUS DU FOND OU AU DESSUS DE LA SURFACE) :
18 !
19 ! ON FIXE LES VITESSES HORIZONTALES A ZERO
20 ! CE QUI EST BIEN ADAPTE POUR TRACER DES VECTEURS
21 !
22 ! ON EXTRAPOLE LES AUTRES VARIABLES A PARTIR DE LEURS
23 ! VALEURS AU PREMIER ETAGE SI EN DESSOUS DU FOND
24 ! AU DERNIER ETAGE SI AU DESSUS DE LA SURFACE
25 ! CE QUI EST BIEN ADAPTE POUR TRACER DES ISOCOURBES
26 !
27 !-----------------------------------------------------------------------
28 ! ARGUMENTS
29 ! .________________.____.______________________________________________.
30 ! ! NOM !MODE! ROLE !
31 ! !________________!____!______________________________________________!
32 ! ! IREC ! -->! PAS TRAITE !
33 ! ! AT ! -->! TEMPS CORRESPONDANT AU PAS TRAITE !
34 ! ! Z ! -->! COTES DES NOEUDS !
35 ! ! U,V,W ! -->! COMPOSANTES 3D DE LA VITESSE !
36 ! ! TA,TP ! -->! CONCENTRATIONS DES TRACEURS !
37 ! ! NUX,NUY,NUZ ! -->! COEFFICIENTS DE VISCOSITE POUR LES VITESSES !
38 ! ! NAX,NAY,NAZ ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.ACTIFS !
39 ! ! NPX,NPY,NPZ ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.PASSIFS!
40 ! ! RI ! -->! NOMBRE DE RICHARDSON !
41 ! ! AK,EP ! -->! VARIABLES DU MODELE K-EPSILON !
42 ! ! RHO ! -->! ECARTS RELATIFS DE DENSITE !
43 ! ! VAR ! -->! TABLEAU DE TRAVAIL POUR PROJETER LES VARIABLES
44 ! ! SHZ ! -->! COORDONNEE BARYCENTRIQUE SUIVANT Z !
45 ! ! HREF ! -->! DECALAGE PAR RAPPORT AU PLAN DE REFERENCE !
46 ! ! NPLREF ! -->! PLAN DE REFERENCE !
47 ! ! PLINF ! -->! PLAN SUITE IMMEDIATEMENT SOUS LA COUPE !
48 ! ! NC2DH ! -->! NOMBRE DE COUPES HORIZONTALES !
49 ! ! NPOIN2 ! -->! NOMBRE DE POINTS DU MAILLAGE 2D !
50 ! ! NCOU ! -->! NUMERO DE CANAL - 1 DE LA PREMIERE COUPE !
51 ! ! NPLAN ! -->! NOMBRE DE PLANS !
52 ! ! NTRAC ! -->! NOMBRE DE TRACEURS ACTIFS !
53 ! ! NTRPA ! -->! NOMBRE DE TRACEURS PASSIFS !
54 ! ! SORG3D ! -->! INDICATEUR DES VARIABLES ENREGISTREES !
55 ! !________________!____!______________________________________________!
56 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
57 !-----------------------------------------------------------------------
58 !
59 ! SOUS-PROGRAMME APPELE PAR : POSTEL3D
60 ! SOUS-PROGRAMME APPELES : ECRI2
61 !
62 !history Y AUDOUIN (LNHE)
63 !+ 25/05/2015
64 !+ V7P0
65 !+ Modification to comply with the hermes module
66 !
67 !**********************************************************************
68 !
69  USE bief
71  USE declarations_postel3d, ONLY: prez => z
72 !
73  IMPLICIT NONE
74 !
75 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
76 !
77  INTEGER, INTENT(IN) :: NC2DH,NPOIN2,NPLAN
78  INTEGER, INTENT(IN) :: NCOU(nc2dh)
79  INTEGER, INTENT(IN) :: IREC
80  DOUBLE PRECISION, INTENT(IN) :: U(npoin2,nplan)
81  DOUBLE PRECISION, INTENT(IN) :: V(npoin2,nplan)
82  DOUBLE PRECISION, INTENT(IN) :: W(npoin2,nplan)
83  DOUBLE PRECISION, INTENT(IN) :: Z(npoin2,nplan)
84  DOUBLE PRECISION, INTENT(INOUT) :: AT
85  DOUBLE PRECISION, INTENT(IN) :: HREF(9)
86  INTEGER , INTENT(IN) :: NPLREF(9)
87  INTEGER , INTENT(INOUT) :: PLINF(npoin2)
88  type(bief_obj), INTENT(INOUT) :: tab
89  INTEGER, INTENT(IN) :: NVA3
90  CHARACTER(LEN=8) :: FFORMAT
91  DOUBLE PRECISION,INTENT(INOUT) :: VAR(npoin2),SHZ(npoin2)
92  CHARACTER(LEN=32), INTENT(IN) :: TEXTELU(100)
93 !
94 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
95 !
96  INTEGER IC,I,J,CANAL
97 !
98  INTEGER IERR
99  CHARACTER(LEN=32) :: VAR_NAME
100 !
101 !***********************************************************************
102 !
103 ! POUR CHAQUE COUPE HORIZONTALE FAIRE :
104 !
105  DO ic = 1,nc2dh
106 !
107  canal = ncou(ic)
108 !
109  DO i = 1,npoin2
110  var(i) = href(ic)
111 ! IF (NPLREF(IC).GE.1) VAR(I) = VAR(I) + Z(I,NPLREF(IC))
112  IF (nplref(ic).GE.1) THEN
113  var(i) = var(i) + z(i,nplref(ic))
114  ENDIF
115  plinf(i) = 1
116  ENDDO
117 !
118  IF (nplan.GE.3) THEN
119  DO j = 2,nplan-1
120  DO i = 1,npoin2
121  IF (z(i,j).LE.var(i)) plinf(i) = j
122  ENDDO
123  ENDDO
124  ENDIF
125 !
126 !
127  DO i = 1,npoin2
128 !..01/2004
129 ! ATTENTION : Cas des bancs decouvrants (plans confondus)
130  shz(i) = ( var(i) -z(i,plinf(i)))
131  & / max((z(i,plinf(i)+1)-z(i,plinf(i))),1.d-6)
132 !..01/2004
133  ENDDO
134 !
135 !-----------------------------------------------------------------------
136 !
137 ! INDICATEUR DU DOMAINE
138 ! ---------------------
139  DO i = 1,npoin2
140  var(i) = min(shz(i),1.d0-shz(i)) + 1.d-6
141  ENDDO
142  IF (lng.EQ.lng_fr) var_name = 'INDICATEUR DOM. '
143  IF (lng.EQ.lng_en) var_name = 'DOMAIN INDICATOR '
144  CALL add_data(fformat,canal,var_name,at,irec,.true.,var,
145  & npoin2,ierr)
146  CALL check_call(ierr,'COUPEH:ADD_DATA:DOM')
147 !
148 ! Adding z
149 !
150  DO i = 1,npoin2
151  var(i) = 0.d0
152  IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
153  & var(i) =
154  & prez((plinf(i)-1)*npoin2+i)*(1.-shz(i))
155  & + prez( plinf(i) *npoin2+i)* shz(i)
156  ENDDO
157  CALL add_data(fformat,canal,textelu(1),at,irec,.false.,var,
158  & npoin2,ierr)
159  CALL check_call(ierr,'COUPEH:ADD_DATA:J')
160 !
161 !
162 ! COMPOSANTE U DE LA VITESSE
163 ! --------------------------
164  DO i = 1,npoin2
165  var(i) = 0.d0
166  IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
167  & var(i) = u(i,plinf(i))*(1.-shz(i))+u(i,plinf(i)+1)*shz(i)
168  ENDDO
169  var_name = textelu(2)
170  CALL add_data(fformat,canal,var_name,at,irec,.false.,var,
171  & npoin2,ierr)
172  CALL check_call(ierr,'COUPEH:ADD_DATA:U')
173 !
174 !
175 ! COMPOSANTE V DE LA VITESSE
176 ! --------------------------
177  DO i = 1,npoin2
178  var(i) = 0.d0
179  IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
180  & var(i) = v(i,plinf(i))*(1.-shz(i))+v(i,plinf(i)+1)*shz(i)
181  ENDDO
182  var_name = textelu(3)
183  CALL add_data(fformat,canal,var_name,at,irec,.false.,var,
184  & npoin2,ierr)
185  CALL check_call(ierr,'COUPEH:ADD_DATA:V')
186 !
187 ! COMPOSANTE W DE LA VITESSE
188 ! --------------------------
189  DO i = 1,npoin2
190  var(i) = w(i,plinf(i))*(1.-shz(i))+w(i,plinf(i)+1)*shz(i)
191  ENDDO
192  var_name = textelu(4)
193  CALL add_data(fformat,canal,var_name,at,irec,.false.,var,
194  & npoin2,ierr)
195  CALL check_call(ierr,'COUPEH:ADD_DATA:W')
196 !
197 ! Other variables
198 !
199  IF (nva3.GT.4) THEN
200  DO j=5,nva3
201  DO i = 1,npoin2
202  var(i) = 0.d0
203  IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
204  & var(i) =
205  & tab%ADR(j-4)%P%R((plinf(i)-1)*npoin2+i)*(1.-shz(i))
206  & + tab%ADR(j-4)%P%R( plinf(i) *npoin2+i)* shz(i)
207  ENDDO
208  CALL add_data(fformat,canal,textelu(j),at,irec,.false.,var,
209  & npoin2,ierr)
210  CALL check_call(ierr,'COUPEH:ADD_DATA:J')
211  ENDDO
212  ENDIF
213 !
214 !
215  ENDDO !IC
216 !
217 !-----------------------------------------------------------------------
218 !
219  RETURN
220  END SUBROUTINE
subroutine add_data(FFORMAT, FILE_ID, VAR_NAME, TIME, RECORD, FIRST_VAR, VAR_VALUE, N, IERR)
Definition: add_data.f:8
integer, parameter lng_en
subroutine href
Definition: href.f:4
integer, parameter lng_fr
Y. AUDOUIN & J-M HERVOUET (EDF LAB, LNHE) 09/05/2014 V7P0 First version.
double precision, dimension(:), pointer z
subroutine coupeh(IREC, AT, Z, U, V, W, HREF, NPLREF, PLINF, NC2DH, NPOIN2, NPLAN, NCOU, FFORMAT, VAR, SHZ, NVA3, TAB, TEXTELU)
Definition: coupeh.f:8
Definition: bief.f:3