The TELEMAC-MASCARET system  trunk
pre2dv.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE pre2dv
3 ! *****************
4 !
5  &(x,y,shp,nseg,imseg,x2dv,y2dv,ikles,elem,
6  & npoin2,nelem2,im,nc2dv)
7 !
8 !***********************************************************************
9 ! POSTEL3D VERSION 5.1 01/09/99 T. DENOT (LNH) 01 30 87 74 89
10 ! FORTRAN90
11 !***********************************************************************
12 !
13 ! FONCTION : PREPARATION DES FICHIERS DES COUPES VERTICALES
14 !
15 !-----------------------------------------------------------------------
16 ! ARGUMENTS
17 ! .________________.____.______________________________________________.
18 ! ! NOM !MODE! ROLE !
19 ! !________________!____!______________________________________________!
20 ! ! X,Y ! -->! COORDONNEES DU MAILLAGE CURVILIGNE !
21 ! ! SHP !<-- ! COORDONNEES BARYCENTRIQUES DES PTS DE COUPE !
22 ! ! NSEG ! -->! NOMBRE DE SEGMENTS CONSTITUANT CHAQUE COUPE !
23 ! ! IMSEG ! -->! NOMBRE DE POINTS PAR SEGMENTS !
24 ! ! X2DV ! -->! ABSCISSES DES SOMMETS DES COUPES VERTICALES !
25 ! ! Y2DV ! -->! ORDONNEES DES SOMMETS DES COUPES VERTICALES !
26 ! ! IKLES ! -->! TABLE DE CONNECTIVITE !
27 ! ! ELEM !<-- ! NUMERO DES ELEMENTS CONTENANT LES PTS DE COUPE
28 ! ! NPOIN2 ! -->! NOMBRE DE POINTS DU MAILLAGE 2D !
29 ! ! NELEM2 ! -->! NOMBRE D'ELEMENTS DU MAILLAGE 2D !
30 ! ! IM (LU) ! -->! NOMBRE DE PTS DE COUPE SUIVANT L'HORIZONTALE !
31 ! ! NC2DV ! -->! NOMBRE DE COUPES VERTICALES !
32 ! !________________!____!______________________________________________!
33 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
34 !-----------------------------------------------------------------------
35 !
36 ! SOUS-PROGRAMME APPELE PAR : POSTEL
37 !
38 !**********************************************************************
39 !
41  IMPLICIT NONE
42 !
43 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
44 !
45 !
46  INTEGER, INTENT(IN) :: NPOIN2,NELEM2,IM,NC2DV
47  DOUBLE PRECISION, INTENT(IN) :: X(npoin2),Y(npoin2)
48  DOUBLE PRECISION , INTENT(INOUT) :: SHP(im,3,nc2dv)
49  DOUBLE PRECISION, INTENT(IN) :: X2DV(50,nc2dv),Y2DV(50,nc2dv)
50  INTEGER, INTENT(INOUT) :: IKLES(3,nelem2)
51  INTEGER, INTENT(INOUT) :: ELEM(im,nc2dv)
52  INTEGER, INTENT(INOUT) :: NSEG(nc2dv),IMSEG(49,nc2dv)
53 !
54 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
55 !
56  DOUBLE PRECISION :: XM,YM,A1,A2,A3,SURDET,LGTOT
57  INTEGER IMTOT,IMMAX,NSEGMA,ISEG,IDSEG,IFSEG
58  INTEGER IC,N1,N2,N3,I,N
59  DOUBLE PRECISION :: LGSEG(49)
60 !
61  LOGICAL FLAG
62 !
63 !***********************************************************************
64 !
65 ! PARAMETRES IDENTIQUES A TOUS LES PAS DE TEMPS
66 !
67  DO ic = 1,nc2dv
68 !
69  lgtot = 0.d0
70  DO i = 1,nseg(ic)
71  lgseg(i) = sqrt((x2dv(i+1,ic)-x2dv(i,ic))**2
72  & +(y2dv(i+1,ic)-y2dv(i,ic))**2)
73  lgtot = lgtot + lgseg(i)
74  ENDDO
75  lgtot = max(lgtot,1d-6)
76 !
77  imtot = 0
78  immax = 0
79  nsegma = 1
80  DO i = 1,nseg(ic)
81  imseg(i,ic) = max(nint(lgseg(i)*float(im-1)/lgtot),1)
82  imtot = imtot + imseg(i,ic)
83  IF (imseg(i,ic).GT.immax) THEN
84  immax = imseg(i,ic)
85  nsegma = i
86  ENDIF
87  ENDDO
88  imseg(nsegma,ic) = immax + im-1 - imtot
89 !
90  flag = .true.
91  iseg = 0
92  ifseg = 1
93 !
94  DO i = 1,im
95 !
96  IF (i.GT.ifseg.OR.i.EQ.1) THEN
97  iseg = iseg + 1
98  idseg = ifseg
99  ifseg = ifseg + imseg(iseg,ic)
100  ENDIF
101 !
102  xm = ((ifseg-i)*x2dv(iseg,ic) + (i-idseg)*x2dv(iseg+1,ic))
103  & / float(ifseg-idseg)
104  ym = ((ifseg-i)*y2dv(iseg,ic) + (i-idseg)*y2dv(iseg+1,ic))
105  & / float(ifseg-idseg)
106 !
107  elem(i,ic) = 1
108  shp(i,1,ic) = 1.
109  shp(i,2,ic) = 0.
110  shp(i,3,ic) = 0.
111 !
112  DO n = 1,nelem2
113  n1 = ikles(1,n)
114  n2 = ikles(2,n)
115  n3 = ikles(3,n)
116  a1 = (xm-x(n3))*(y(n2)-y(n3)) - (ym-y(n3))*(x(n2)-x(n3))
117  a2 = (xm-x(n1))*(y(n3)-y(n1)) - (ym-y(n1))*(x(n3)-x(n1))
118  a3 = (xm-x(n2))*(y(n1)-y(n2)) - (ym-y(n2))*(x(n1)-x(n2))
119  IF (a1.GE.0..AND.a2.GE.0..AND.a3.GE.0.) THEN
120  flag = .false.
121  surdet = 1. / ((x(n2)-x(n1))*(y(n3)-y(n1)) -
122  & (y(n2)-y(n1))*(x(n3)-x(n1)))
123  elem(i,ic) = n
124  shp(i,1,ic) = a1 * surdet
125  shp(i,2,ic) = a2 * surdet
126  shp(i,3,ic) = a3 * surdet
127  ENDIF
128  ENDDO !N
129 !
130  ENDDO !N
131 !
132  IF (flag) THEN
133  WRITE(lu,102) ic
134  ENDIF
135 !
136  ENDDO !IC
137 !
138 !-----------------------------------------------------------------------
139 !
140 102 FORMAT('ATTENTION, YOUR VERTICAL CROSS SECTION NUMBER',i2,/,
141  & 'HAS NO INTERSECTION WITH THE COMPUTATIONAL DOMAIN')
142 !
143 !-----------------------------------------------------------------------
144 !
145  RETURN
146  END SUBROUTINE
subroutine pre2dv(X, Y, SHP, NSEG, IMSEG, X2DV, Y2DV, IKLES, ELEM, NPOIN2, NELEM2, IM, NC2DV)
Definition: pre2dv.f:8