The TELEMAC-MASCARET system  trunk
vector.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE vector
3 ! *****************
4 !
5  &(vec,op,formul,ielm1,xmul,f,g,h,u,v,w,mesh,msk,maskel,lego,asspar)
6 !
7 !***********************************************************************
8 ! BIEF V7P0 08/01/2014
9 !***********************************************************************
10 !
11 !brief COMPUTES VECTORS.
12 !+
13 !+ THE VECTOR IS IDENTIFIED BY THE FORMULATION IN
14 !+ THE CHARACTER STRING 'FORMUL'.
15 !+
16 !+ 'OP' IS = OR +.
17 !code
18 !+ MEANING OF IELM1
19 !+
20 !+ TYPE OF ELEMENT NUMBER OF POINTS
21 !+
22 !+ 0 : P0 SEGMENT 1
23 !+ 1 : P1 SEGMENT 2
24 !+
25 !+ 10 : P0 TRIANGLE 1
26 !+ 11 : P1 TRIANGLE 3
27 !+ 12 : QUASI-BUBBLE TRIANGLE 4
28 !+
29 !+ 20 : Q0 QUADRILATERAL 1
30 !+ 21 : Q1 QUADRILATERAL 4
31 !+
32 !+ 40 : TELEMAC-3D P0 PRISMS 1
33 !+ 41 : TELEMAC-3D P1 PRISMS 6
34 !
35 !
36 !history JM HERVOUET (LNHE)
37 !+ 25/06/2008
38 !+ V5P9
39 !+ NO CALL TO VECTOS IF THE NUMBER OF ELEMENTS IS 0
40 !
41 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
42 !+ 13/07/2010
43 !+ V6P0
44 !+ Translation of French comments within the FORTRAN sources into
45 !+ English comments
46 !
47 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
48 !+ 21/08/2010
49 !+ V6P0
50 !+ Creation of DOXYGEN tags for automated documentation and
51 !+ cross-referencing of the FORTRAN sources
52 !
53 !history J-M HERVOUET (EDF R&D, LNHE)
54 !+ 11/01/2013
55 !+ V6P3
56 !+ Arguments added to VECTOS
57 !
58 !history J-M HERVOUET (EDF R&D, LNHE)
59 !+ 03/05/2013
60 !+ V6P3
61 !+ Checking size of vector, and status=0 allowed if OP='='.
62 !
63 !history J-M HERVOUET (EDF R&D, LNHE)
64 !+ 08/01/2014
65 !+ V7P0
66 !+ New optional argument ASSPAR, to assemble the vector in parallel.
67 !+ This will avoid a lot of CALL PARCOM everywhere.
68 !
69 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
70 !| ASSPAR |-->| IF YES, RARALLEL ASSEMBLY OF THE VECTOR IS DONE
71 !| F |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
72 !| FORMUL |-->| STRING WITH THE FORMULA DESCRIBING THE VECTOR
73 !| G |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
74 !| H |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
75 !| IELM1 |-->| TYPE OF ELEMENT
76 !| MASKEL |-->| MASKING OF ELEMENTS
77 !| | | =1. : NORMAL =0. : MASKED ELEMENT
78 !| MESH |-->| MESH STRUCTURE
79 !| MSK |-->| IF YES, THERE IS MASKED ELEMENTS
80 !| OP |-->| '=' : WE DO VEC= THE VECTOR
81 !| | | '+' : WE DO VEC=VEC+ THE VECTOR
82 !| U |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
83 !| V |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
84 !| W |-->| FUNCTION USED IN THE VECTOR FORMULA (BIEF_OBJ)
85 !| VEC |<->| RESULTING VECTOR
86 !| XMUL |-->| MULTIPLICATION COEFFICIENT
87 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
88 !
89  USE bief, ex_vector => vector
90 !
92  IMPLICIT NONE
93 !
94 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
95 !
96  TYPE(bief_obj), INTENT(INOUT) :: VEC
97  DOUBLE PRECISION, INTENT(IN) :: XMUL
98  INTEGER, INTENT(IN) :: IELM1
99  LOGICAL, INTENT(IN) :: MSK
100  CHARACTER(LEN=16), INTENT(IN) :: FORMUL
101  CHARACTER(LEN=1), INTENT(IN) :: OP
102  TYPE(bief_obj), INTENT(IN) :: F,G,H,U,V,W,MASKEL
103  TYPE(bief_mesh), INTENT(INOUT) :: MESH
104  LOGICAL, OPTIONAL, INTENT(IN) :: LEGO,ASSPAR
105 !
106 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
107 !
108  INTEGER :: NPT ! NUMBER OF POINTS PER ELEMENT
109  INTEGER :: DIM1T ! FIRST DIMENSION OF T IN VECTOS
110  LOGICAL :: LLEGO,AASSPAR ! ASSEMBLY OR NOT
111  INTEGER :: IELM0 ! P0 DISCRETISATION
112 !
113  IF(PRESENT(lego)) THEN
114  llego=lego
115  ELSE
116  llego=.true.
117  ENDIF
118 !
119 !-----------------------------------------------------------------------
120 ! POSSIBLE CHANGE OF DISCRETISATION
121 !-----------------------------------------------------------------------
122 ! IF A VECTOR HAS BEEN ALLOCATED WITH STATUS 1, I.E ITS DISCRETISATION
123 ! CANNOT CHANGE, IT IS NECESSARY TO TEST THE COHERENCE BETWEEN THE
124 ! DISCRETISATION OF THE VECTOR AND THAT PROPOSED IN ARGUMENT.
125 ! MIGHT HAVE SURPRISES OTHERWISE !!!!
126 !
127  IF(vec%STATUS.EQ.1.AND.vec%ELM.NE.ielm1) THEN
128  WRITE(lu,1002) vec%NAME,vec%ELM,ielm1
129 1002 FORMAT(1x,'VECTOR: CHANGING DISCRETIZATION FORBIDDEN',
130  & ' FOR THE VECTOR ',a6,' : ',1i6,' <=> ',1i6)
131  CALL plante(1)
132  stop
133  ELSEIF(vec%STATUS.EQ.2.OR.vec%STATUS.EQ.1.OR.
134  & (vec%STATUS.EQ.0.AND.op.EQ.'=')) THEN
135  npt = bief_nbpts(ielm1,mesh)
136  vec%ELM = ielm1
137  IF(npt.GT.vec%MAXDIM1) THEN
138  WRITE(lu,*) 'VECTOR ',vec%NAME
139  WRITE(lu,*) 'HAS A FIRST DIMENSION OF: ',vec%MAXDIM1
140  WRITE(lu,*) 'IT CANNOT BE USED IN VECTOR'
141  WRITE(lu,*) 'FOR A SIZE OF ',npt
142  CALL plante(1)
143  stop
144  ELSE
145  vec%DIM1= npt
146  IF(vec%STATUS.EQ.0) vec%STATUS=2
147  ENDIF
148  ELSE
149  WRITE(lu,*) 'VECTOR ',vec%NAME,' HAS A STATUS ',vec%STATUS,
150  & ' IT CANNOT BE USED IN SUBROUTINE VECTOR'
151  CALL plante(1)
152  stop
153  ENDIF
154 !
155 ! ASSEMBLY: NOT PERFORMED FOR VECTORS
156 ! RESULT OF P0 DISCRETISATION
157 ! LLEGO IS SET TO TRUE IF THE RESULTANT VECTOR DISCRETISATION
158 ! IS P1, FALSE OTHERWISE.
159 !
160  ielm0 = 10*(ielm1/10)
161  IF(ielm0.EQ.ielm1) llego=.false.
162 !
163 !-----------------------------------------------------------------------
164 ! CALLS THE SUBROUTINE THAT SHUNTS AND ASSEMBLES
165 !-----------------------------------------------------------------------
166 !
167  IF(dimens(ielm1).EQ.mesh%DIM1) THEN
168  dim1t=mesh%NELMAX
169  ELSE
170  dim1t=mesh%NELEBX
171  ENDIF
172 !
173 !-----------------------------------------------------------------------
174 ! OPTIONAL ASSEMBLY: VALUES OF VEC SUMMED AT INTERFACE POINTS
175 !-----------------------------------------------------------------------
176 !
177  aasspar=.false.
178  IF(ncsize.GT.1) THEN
179  IF(PRESENT(asspar).AND.dimens(ielm1).EQ.mesh%DIM1) THEN
180  aasspar=asspar
181  ENDIF
182  ENDIF
183 !
184  IF(dimens(ielm1).EQ.mesh%DIM1.OR.mesh%NELEB.GT.0) THEN
185 !
186  CALL vectos(vec,vec%R,op,formul,xmul,
187  & f%R,g%R,h%R,u%R,v%R,w%R,
188  & f,g,h,u,v,w,mesh%W%R,llego,
189  & mesh%XEL%R , mesh%YEL%R ,
190  & mesh%X%R , mesh%Y%R , mesh%Z%R ,
191  & mesh%SURFAC%R, mesh%LGSEG%R ,
192  & mesh%IKLE%I , mesh%IKLBOR%I, mesh%NBOR%I ,
193  & mesh%XSGBOR%R, mesh%YSGBOR%R,
194  & npt,mesh%NELEM,mesh%NELEB,
195  & mesh%NELMAX,mesh%NELEBX,
196  & ielm1,mesh%LV,msk,maskel%R,mesh,dim1t,
197  & mesh%NELBOR%I,mesh%NULONE%I,aasspar)
198 !
199  ENDIF
200 !
201 !-----------------------------------------------------------------------
202 !
203  RETURN
204  END
subroutine vectos(SVEC, VEC, OP, FORMUL, XMUL, F, G, H, U, V, W, SF, SG, SH, SU, SV, SW, T, LEGO, XEL, YEL, XPT, YPT, ZPT, SURFAC, LGSEG, IKLE, IKLBOR, NBOR, XNOR, YNOR, NPT, NELEM, NELEB, NELMAX, NELEBX, IELM1, LV, MSK, MASKEL, MESH, DIM1T, NELBOR, NULONE, ASSPAR)
Definition: vectos.f:12
integer function dimens(IELM)
Definition: dimens.f:7
integer function bief_nbpts(IELM, MESH)
Definition: bief_nbpts.f:7
subroutine vector(VEC, OP, FORMUL, IELM1, XMUL, F, G, H, U, V, W, MESH, MSK, MASKEL, LEGO, ASSPAR)
Definition: vector.f:7
Definition: bief.f:3