The TELEMAC-MASCARET system  trunk
mv0603.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE mv0603
3 ! *****************
4 !
5  &(op, x , da,typdia,
6  & xa12,xa13,xa21,xa23,xa31,xa32,xa41,xa42,xa43,
7  & xa51,xa52,xa53,xa61,xa62,xa63,
8  & typext, y,c,
9  & ikle1,ikle2,ikle3,ikle4,ikle5,ikle6,
10  & npoin,npt2,nelem,w1,w2,w3,w4,w5,w6)
11 !
12 !***********************************************************************
13 ! BIEF V6P1 21/08/2010
14 !***********************************************************************
15 !
16 !brief MATRIX VECTOR OPERATIONS FOR P1 AND P2 TRIANGLES.
17 !code
18 !+ OP IS A STRING OF 8 CHARACTERS, WHICH INDICATES THE OPERATION TO BE
19 !+ PERFORMED ON VECTORS X,Y AND MATRIX M.
20 !+
21 !+ THE RESULT IS VECTOR X.
22 !+
23 !+ THESE OPERATIONS ARE DIFFERENT DEPENDING ON THE DIAGONAL TYPE
24 !+ AND THE TYPE OF EXTRADIAGONAL TERMS.
25 !+
26 !+ IMPLEMENTED OPERATIONS:
27 !+
28 !+ OP = 'X=AY ' : X = AY
29 !+ OP = 'X=-AY ' : X = - AY
30 !+ OP = 'X=X+AY ' : X = X + AY
31 !+ OP = 'X=X-AY ' : X = X - AY
32 !+ OP = 'X=X+CAY ' : X = X + C AY
33 !+ OP = 'X=TAY ' : X = TA Y (TRANSPOSE OF A)
34 !+ OP = 'X=-TAY ' : X = - TA Y (- TRANSPOSE OF A)
35 !+ OP = 'X=X+TAY ' : X = X + TA Y
36 !+ OP = 'X=X-TAY ' : X = X - TA Y
37 !+ OP = 'X=X+CTAY' : X = X + C TA Y
38 !
39 !history J-M HERVOUET (LNH) ; F LEPEINTRE (LNH)
40 !+ 05/02/91
41 !+ V5P9
42 !+
43 !
44 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
45 !+ 13/07/2010
46 !+ V6P0
47 !+ Translation of French comments within the FORTRAN sources into
48 !+ English comments
49 !
50 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
51 !+ 21/08/2010
52 !+ V6P0
53 !+ Creation of DOXYGEN tags for automated documentation and
54 !+ cross-referencing of the FORTRAN sources
55 !
56 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57 !| C |-->| A GIVEN CONSTANT
58 !| DA |-->| MATRIX DIAGONAL
59 !| IKLE1 |-->| FIRST POINTS OF ELEMENTS
60 !| IKLE2 |-->| SECOND POINTS OF ELEMENTS
61 !| IKLE3 |-->| THIRD POINTS OF ELEMENTS
62 !| IKLE4 |-->| FOURTH POINTS OF ELEMENTS
63 !| IKLE5 |-->| FIFTH POINTS OF ELEMENTS
64 !| IKLE6 |-->| SIXTH POINTS OF ELEMENTS
65 !| NELEM |-->| NUMBER OF ELEMENTS
66 !| NPOIN |-->| NUMBER OF LINEAR POINTS
67 !| NPT2 |-->| NUMBER OF QUADRATIC POINTS
68 !| OP |-->| OPERATION TO BE DONE (SEE ABOVE)
69 !| TYPDIA |-->| TYPE OF DIAGONAL:
70 !| | | TYPDIA = 'Q' : ANY VALUE
71 !| | | TYPDIA = 'I' : IDENTITY
72 !| | | TYPDIA = '0' : ZERO
73 !| TYPEXT |-->| TYPE OF OFF-DIAGONAL TERMS
74 !| | | TYPEXT = 'Q' : ANY VALUE
75 !| | | TYPEXT = 'S' : SYMMETRIC
76 !| | | TYPEXT = '0' : ZERO
77 !| W1 |<->| RESULT IN NON ASSEMBLED FORM
78 !| W2 |<->| RESULT IN NON ASSEMBLED FORM
79 !| W3 |<->| RESULT IN NON ASSEMBLED FORM
80 !| W4 |<->| RESULT IN NON ASSEMBLED FORM
81 !| W5 |<->| RESULT IN NON ASSEMBLED FORM
82 !| W6 |<->| RESULT IN NON ASSEMBLED FORM
83 !| X |<->| RESULT IN ASSEMBLED FORM
84 !| XA13 |-->| OFF-DIAGONAL TERM OF MATRIX
85 !| XA21 |-->| OFF-DIAGONAL TERM OF MATRIX
86 !| XA23 |-->| OFF-DIAGONAL TERM OF MATRIX
87 !| XA31 |-->| OFF-DIAGONAL TERM OF MATRIX
88 !| XA32 |-->| OFF-DIAGONAL TERM OF MATRIX
89 !| XA41 |-->| OFF-DIAGONAL TERM OF MATRIX
90 !| XA42 |-->| OFF-DIAGONAL TERM OF MATRIX
91 !| XA43 |-->| OFF-DIAGONAL TERM OF MATRIX|
92 !| XA51 |-->| OFF-DIAGONAL TERM OF MATRIX
93 !| XA52 |-->| OFF-DIAGONAL TERM OF MATRIX
94 !| XA53 |-->| OFF-DIAGONAL TERM OF MATRIX
95 !| XA61 |-->| OFF-DIAGONAL TERM OF MATRIX
96 !| XA62 |-->| OFF-DIAGONAL TERM OF MATRIX
97 !| XA63 |-->| OFF-DIAGONAL TERM OF MATRIX
98 !| Y |-->| VECTOR USED IN THE OPERATION
99 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
100 !
101  USE bief!, EX_MV0603 => MV0603
102 !
103  USE declarations_special
104  IMPLICIT NONE
105 !
106 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
107 !
108  INTEGER, INTENT(IN) :: NELEM,NPOIN,NPT2
109 !
110  INTEGER, INTENT(IN) :: IKLE1(*),IKLE2(*),IKLE3(*)
111  INTEGER, INTENT(IN) :: IKLE4(*),IKLE5(*),IKLE6(*)
112 !
113  DOUBLE PRECISION, INTENT(INOUT) :: W1(*),W2(*),W3(*)
114  DOUBLE PRECISION, INTENT(INOUT) :: W4(*),W5(*),W6(*)
115  DOUBLE PRECISION, INTENT(IN) :: Y(*),DA(*)
116  DOUBLE PRECISION, INTENT(INOUT) :: X(*)
117  DOUBLE PRECISION, INTENT(IN) :: XA12(*),XA13(*),XA21(*)
118  DOUBLE PRECISION, INTENT(IN) :: XA23(*),XA31(*),XA32(*)
119  DOUBLE PRECISION, INTENT(IN) :: XA41(*),XA42(*),XA43(*)
120  DOUBLE PRECISION, INTENT(IN) :: XA51(*),XA52(*),XA53(*)
121  DOUBLE PRECISION, INTENT(IN) :: XA61(*),XA62(*),XA63(*)
122  DOUBLE PRECISION, INTENT(IN) :: C
123 !
124  CHARACTER(LEN=8), INTENT(IN) :: OP
125  CHARACTER(LEN=1), INTENT(IN) :: TYPDIA,TYPEXT
126 !
127 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
128 !
129  INTEGER IELEM
130  DOUBLE PRECISION Z(1)
131 !
132 !-----------------------------------------------------------------------
133 !
134  IF(op(1:8).EQ.'X=AY ') THEN
135 !
136 ! CONTRIBUTION OF THE DIAGONAL:
137 !
138  IF(typdia(1:1).EQ.'Q') THEN
139  CALL ov ('X=YZ ', x , y , da , c , npoin )
140  ELSEIF(typdia(1:1).EQ.'I') THEN
141  CALL ov ('X=Y ', x , y , z , c , npoin )
142  ELSEIF(typdia(1:1).EQ.'0') THEN
143  CALL ov ('X=C ', x , y , z , 0.d0 , npoin )
144  ELSE
145  WRITE(lu,2001) typdia
146  CALL plante(1)
147  stop
148  ENDIF
149 !
150 ! THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
151 ! THEY ARE SET TO 0 HERE
152  CALL ov ('X=C ',x(npoin+1:npt2),y,z,0.d0,npt2-npoin)
153 !
154 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
155 !
156  IF(typext(1:1).EQ.'Q') THEN
157 !
158  DO ielem = 1 , nelem
159  w1(ielem) = xa12(ielem) * y(ikle2(ielem))
160  & + xa13(ielem) * y(ikle3(ielem))
161  w2(ielem) = xa21(ielem) * y(ikle1(ielem))
162  & + xa23(ielem) * y(ikle3(ielem))
163  w3(ielem) = xa31(ielem) * y(ikle1(ielem))
164  & + xa32(ielem) * y(ikle2(ielem))
165  w4(ielem) = xa41(ielem) * y(ikle1(ielem))
166  & + xa42(ielem) * y(ikle2(ielem))
167  & + xa43(ielem) * y(ikle3(ielem))
168  w5(ielem) = xa51(ielem) * y(ikle1(ielem))
169  & + xa52(ielem) * y(ikle2(ielem))
170  & + xa53(ielem) * y(ikle3(ielem))
171  w6(ielem) = xa61(ielem) * y(ikle1(ielem))
172  & + xa62(ielem) * y(ikle2(ielem))
173  & + xa63(ielem) * y(ikle3(ielem))
174  ENDDO ! IELEM
175 !
176  ELSEIF(typext(1:1).EQ.'0') THEN
177 !
178  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
179  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
180  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
181  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
182  CALL ov ('X=C ', w5 , y , z , 0.d0 , nelem )
183  CALL ov ('X=C ', w6 , y , z , 0.d0 , nelem )
184 !
185  ELSE
186 !
187  WRITE(lu,1001) typext
188  CALL plante(1)
189  stop
190 !
191  ENDIF
192 !
193 !-----------------------------------------------------------------------
194 !
195  ELSEIF(op(1:8).EQ.'X=-AY ') THEN
196 !
197 ! CONTRIBUTION OF THE DIAGONAL:
198 !
199  IF(typdia(1:1).EQ.'Q') THEN
200  CALL ov ('X=-YZ ', x , y , da , c , npoin )
201  ELSEIF(typdia(1:1).EQ.'I') THEN
202  CALL ov ('X=-Y ', x , y , z , c , npoin )
203  ELSEIF(typdia(1:1).EQ.'0') THEN
204  CALL ov ('X=C ', x , y , z , 0.d0 , npoin )
205  ELSE
206  WRITE(lu,2001) typdia
207  CALL plante(1)
208  stop
209  ENDIF
210 !
211 ! THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
212 ! THEY ARE SET TO 0 HERE
213  CALL ov ('X=C ',x(npoin+1:npt2),y,z,0.d0,npt2-npoin)
214 !
215 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
216 !
217  IF(typext(1:1).EQ.'Q') THEN
218 !
219  DO ielem = 1 , nelem
220  w1(ielem) = - xa12(ielem) * y(ikle2(ielem))
221  & - xa13(ielem) * y(ikle3(ielem))
222  w2(ielem) = - xa21(ielem) * y(ikle1(ielem))
223  & - xa23(ielem) * y(ikle3(ielem))
224  w3(ielem) = - xa31(ielem) * y(ikle1(ielem))
225  & - xa32(ielem) * y(ikle2(ielem))
226  w4(ielem) = - xa41(ielem) * y(ikle1(ielem))
227  & - xa42(ielem) * y(ikle2(ielem))
228  & - xa43(ielem) * y(ikle3(ielem))
229  w5(ielem) = - xa51(ielem) * y(ikle1(ielem))
230  & - xa52(ielem) * y(ikle2(ielem))
231  & - xa53(ielem) * y(ikle3(ielem))
232  w6(ielem) = - xa61(ielem) * y(ikle1(ielem))
233  & - xa62(ielem) * y(ikle2(ielem))
234  & - xa63(ielem) * y(ikle3(ielem))
235  ENDDO ! IELEM
236 !
237  ELSEIF(typext(1:1).EQ.'0') THEN
238 !
239  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
240  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
241  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
242  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
243  CALL ov ('X=C ', w5 , y , z , 0.d0 , nelem )
244  CALL ov ('X=C ', w6 , y , z , 0.d0 , nelem )
245 !
246  ELSE
247 !
248  WRITE(lu,1001) typext
249  CALL plante(1)
250  stop
251 !
252  ENDIF
253 !
254 !-----------------------------------------------------------------------
255 !
256  ELSEIF(op(1:8).EQ.'X=X+AY ') THEN
257 !
258 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
259 !
260  IF(typext(1:1).EQ.'Q') THEN
261 !
262  DO ielem = 1 , nelem
263  w1(ielem) = w1(ielem) + xa12(ielem) * y(ikle2(ielem))
264  & + xa13(ielem) * y(ikle3(ielem))
265  w2(ielem) = w2(ielem) + xa21(ielem) * y(ikle1(ielem))
266  & + xa23(ielem) * y(ikle3(ielem))
267  w3(ielem) = w3(ielem) + xa31(ielem) * y(ikle1(ielem))
268  & + xa32(ielem) * y(ikle2(ielem))
269  w4(ielem) = w4(ielem) + xa41(ielem) * y(ikle1(ielem))
270  & + xa42(ielem) * y(ikle2(ielem))
271  & + xa43(ielem) * y(ikle3(ielem))
272  w5(ielem) = w5(ielem) + xa51(ielem) * y(ikle1(ielem))
273  & + xa52(ielem) * y(ikle2(ielem))
274  & + xa53(ielem) * y(ikle3(ielem))
275  w6(ielem) = w6(ielem) + xa61(ielem) * y(ikle1(ielem))
276  & + xa62(ielem) * y(ikle2(ielem))
277  & + xa63(ielem) * y(ikle3(ielem))
278  ENDDO ! IELEM
279 !
280  ELSEIF(typext(1:1).NE.'0') THEN
281 !
282  WRITE(lu,1001) typext
283  CALL plante(1)
284  stop
285 !
286  ENDIF
287 !
288 ! CONTRIBUTION OF THE DIAGONAL:
289 !
290  IF(typdia(1:1).EQ.'Q') THEN
291  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
292  ELSEIF(typdia(1:1).EQ.'I') THEN
293  CALL ov ('X=X+Y ', x , y , z , c , npoin )
294  ELSEIF(typdia(1:1).NE.'0') THEN
295  WRITE(lu,2001) typdia
296  CALL plante(1)
297  stop
298  ENDIF
299 !
300 ! THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
301 ! THEY ARE SET TO 0 HERE
302  CALL ov ('X=C ',x(npoin+1:npt2),y,z,0.d0,npt2-npoin)
303 !
304 !-----------------------------------------------------------------------
305 !
306  ELSEIF(op(1:8).EQ.'X=X-AY ') THEN
307 !
308 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
309 !
310  IF(typext(1:1).EQ.'Q') THEN
311 !
312  DO ielem = 1 , nelem
313  w1(ielem) = w1(ielem) - xa12(ielem) * y(ikle2(ielem))
314  & - xa13(ielem) * y(ikle3(ielem))
315  w2(ielem) = w2(ielem) - xa21(ielem) * y(ikle1(ielem))
316  & - xa23(ielem) * y(ikle3(ielem))
317  w3(ielem) = w3(ielem) - xa31(ielem) * y(ikle1(ielem))
318  & - xa32(ielem) * y(ikle2(ielem))
319  w4(ielem) = w4(ielem) - xa41(ielem) * y(ikle1(ielem))
320  & - xa42(ielem) * y(ikle2(ielem))
321  & - xa43(ielem) * y(ikle3(ielem))
322  w5(ielem) = w5(ielem) - xa51(ielem) * y(ikle1(ielem))
323  & - xa52(ielem) * y(ikle2(ielem))
324  & - xa53(ielem) * y(ikle3(ielem))
325  w6(ielem) = w6(ielem) - xa61(ielem) * y(ikle1(ielem))
326  & - xa62(ielem) * y(ikle2(ielem))
327  & - xa63(ielem) * y(ikle3(ielem))
328  ENDDO ! IELEM
329 !
330  ELSEIF(typext(1:1).NE.'0') THEN
331 !
332  WRITE(lu,1001) typext
333  CALL plante(1)
334  stop
335 !
336  ENDIF
337 !
338 ! CONTRIBUTION OF THE DIAGONAL:
339 !
340  IF(typdia(1:1).EQ.'Q') THEN
341  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
342  ELSEIF(typdia(1:1).EQ.'I') THEN
343  CALL ov ('X=X-Y ', x , y , z , c , npoin )
344  ELSEIF(typdia(1:1).NE.'0') THEN
345  WRITE(lu,2001) typdia
346  CALL plante(1)
347  stop
348  ENDIF
349 !
350 ! THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
351 ! THEY ARE SET TO 0 HERE
352  CALL ov ('X=C ',x(npoin+1:npt2),y,z,0.d0,npt2-npoin)
353 !
354 !-----------------------------------------------------------------------
355 !
356  ELSEIF(op(1:8).EQ.'X=X+CAY ') THEN
357 !
358 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
359 !
360  IF(typext(1:1).EQ.'Q') THEN
361 !
362  DO ielem = 1 , nelem
363  w1(ielem) = w1(ielem)
364  & + c * ( xa12(ielem) * y(ikle2(ielem))
365  & + xa13(ielem) * y(ikle3(ielem)) )
366  w2(ielem) = w2(ielem)
367  & + c * ( xa21(ielem) * y(ikle1(ielem))
368  & + xa23(ielem) * y(ikle3(ielem)) )
369  w3(ielem) = w3(ielem)
370  & + c * ( xa31(ielem) * y(ikle1(ielem))
371  & + xa32(ielem) * y(ikle2(ielem)) )
372  w4(ielem) = w4(ielem)
373  & + c * ( xa41(ielem) * y(ikle1(ielem))
374  & + xa42(ielem) * y(ikle2(ielem))
375  & + xa43(ielem) * y(ikle3(ielem)) )
376  w5(ielem) = w5(ielem)
377  & + c * ( xa51(ielem) * y(ikle1(ielem))
378  & + xa52(ielem) * y(ikle2(ielem))
379  & + xa53(ielem) * y(ikle3(ielem)) )
380  w6(ielem) = w6(ielem)
381  & + c * ( xa61(ielem) * y(ikle1(ielem))
382  & + xa62(ielem) * y(ikle2(ielem))
383  & + xa63(ielem) * y(ikle3(ielem)) )
384  ENDDO ! IELEM
385 !
386  ELSEIF(typext(1:1).NE.'0') THEN
387 !
388  WRITE(lu,1001) typext
389  CALL plante(1)
390  stop
391 !
392  ENDIF
393 !
394 ! CONTRIBUTION OF THE DIAGONAL:
395 !
396  IF(typdia(1:1).EQ.'Q') THEN
397  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
398  ELSEIF(typdia(1:1).EQ.'I') THEN
399  CALL ov ('X=X+CY ', x , y , z , c , npoin )
400  ELSEIF(typdia(1:1).NE.'0') THEN
401  WRITE(lu,2001) typdia
402  CALL plante(1)
403  stop
404  ENDIF
405 !
406 ! THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
407 ! THEY ARE SET TO 0 HERE
408  CALL ov ('X=C ',x(npoin+1:npt2),y,z,0.d0,npt2-npoin)
409 !
410 !-----------------------------------------------------------------------
411 !
412  ELSEIF(op(1:8).EQ.'X=TAY ') THEN
413 !
414 ! CONTRIBUTION OF THE DIAGONAL
415 !
416  IF(typdia(1:1).EQ.'Q') THEN
417  CALL ov ('X=YZ ', x , y , da , c , npoin )
418  ELSEIF(typdia(1:1).EQ.'I') THEN
419  CALL ov ('X=Y ', x , y , z , c , npoin )
420  ELSEIF(typdia(1:1).EQ.'0') THEN
421  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
422  ELSE
423  WRITE(lu,2001) typdia
424  CALL plante(1)
425  stop
426  ENDIF
427 !
428 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
429 !
430  IF(typext(1:1).EQ.'Q') THEN
431 !
432  DO ielem = 1 , nelem
433  w1(ielem) = + xa21(ielem) * y(ikle2(ielem))
434  & + xa31(ielem) * y(ikle3(ielem))
435  & + xa41(ielem) * y(ikle4(ielem))
436  & + xa51(ielem) * y(ikle5(ielem))
437  & + xa61(ielem) * y(ikle6(ielem))
438  w2(ielem) = + xa12(ielem) * y(ikle1(ielem))
439  & + xa32(ielem) * y(ikle3(ielem))
440  & + xa42(ielem) * y(ikle4(ielem))
441  & + xa52(ielem) * y(ikle5(ielem))
442  & + xa62(ielem) * y(ikle6(ielem))
443  w3(ielem) = + xa13(ielem) * y(ikle1(ielem))
444  & + xa23(ielem) * y(ikle2(ielem))
445  & + xa43(ielem) * y(ikle4(ielem))
446  & + xa53(ielem) * y(ikle5(ielem))
447  & + xa63(ielem) * y(ikle6(ielem))
448  ENDDO ! IELEM
449 !
450  ELSEIF(typext(1:1).EQ.'0') THEN
451 !
452  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
453  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
454  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
455 !
456  ELSE
457 !
458  WRITE(lu,1001) typext
459  CALL plante(1)
460  stop
461 !
462  ENDIF
463 !
464 !-----------------------------------------------------------------------
465 !
466  ELSEIF(op(1:8).EQ.'X=-TAY ') THEN
467 !
468 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
469 !
470  IF(typext(1:1).EQ.'Q') THEN
471 !
472  DO ielem = 1 , nelem
473  w1(ielem) = - xa21(ielem) * y(ikle2(ielem))
474  & - xa31(ielem) * y(ikle3(ielem))
475  & - xa41(ielem) * y(ikle4(ielem))
476  & - xa51(ielem) * y(ikle5(ielem))
477  & - xa61(ielem) * y(ikle6(ielem))
478  w2(ielem) = - xa12(ielem) * y(ikle1(ielem))
479  & - xa32(ielem) * y(ikle3(ielem))
480  & - xa42(ielem) * y(ikle4(ielem))
481  & - xa52(ielem) * y(ikle5(ielem))
482  & - xa62(ielem) * y(ikle6(ielem))
483  w3(ielem) = - xa13(ielem) * y(ikle1(ielem))
484  & - xa23(ielem) * y(ikle2(ielem))
485  & - xa43(ielem) * y(ikle4(ielem))
486  & - xa53(ielem) * y(ikle5(ielem))
487  & - xa63(ielem) * y(ikle6(ielem))
488  ENDDO ! IELEM
489 !
490  ELSEIF(typext(1:1).EQ.'0') THEN
491 !
492  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
493  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
494  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
495 !
496  ELSE
497 !
498  WRITE(lu,1001) typext
499  CALL plante(1)
500  stop
501 !
502  ENDIF
503 !
504 ! CONTRIBUTION OF THE DIAGONAL
505 !
506  IF(typdia(1:1).EQ.'Q') THEN
507  CALL ov ('X=-YZ ', x , y , da , c , npoin )
508  ELSEIF(typdia(1:1).EQ.'I') THEN
509  CALL ov ('X=-Y ', x , y , z , c , npoin )
510  ELSEIF(typdia(1:1).EQ.'0') THEN
511  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
512  ELSE
513  WRITE(lu,2001) typdia
514  CALL plante(1)
515  stop
516  ENDIF
517 !
518 !-----------------------------------------------------------------------
519 !
520  ELSEIF(op(1:8).EQ.'X=X+TAY ') THEN
521 !
522 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
523 !
524  IF(typext(1:1).EQ.'Q') THEN
525 !
526  DO ielem = 1 , nelem
527  w1(ielem) = w1(ielem) + xa21(ielem) * y(ikle2(ielem))
528  & + xa31(ielem) * y(ikle3(ielem))
529  & + xa41(ielem) * y(ikle4(ielem))
530  & + xa51(ielem) * y(ikle5(ielem))
531  & + xa61(ielem) * y(ikle6(ielem))
532  w2(ielem) = w2(ielem) + xa12(ielem) * y(ikle1(ielem))
533  & + xa32(ielem) * y(ikle3(ielem))
534  & + xa42(ielem) * y(ikle4(ielem))
535  & + xa52(ielem) * y(ikle5(ielem))
536  & + xa62(ielem) * y(ikle6(ielem))
537  w3(ielem) = w3(ielem) + xa13(ielem) * y(ikle1(ielem))
538  & + xa23(ielem) * y(ikle2(ielem))
539  & + xa43(ielem) * y(ikle4(ielem))
540  & + xa53(ielem) * y(ikle5(ielem))
541  & + xa63(ielem) * y(ikle6(ielem))
542  ENDDO ! IELEM
543 !
544  ELSEIF(typext(1:1).NE.'0') THEN
545 !
546  WRITE(lu,1001) typext
547  CALL plante(1)
548  stop
549 !
550  ENDIF
551 !
552 ! CONTRIBUTION OF THE DIAGONAL
553 !
554  IF(typdia(1:1).EQ.'Q') THEN
555  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
556  ELSEIF(typdia(1:1).EQ.'I') THEN
557  CALL ov ('X=X+Y ', x , y , z , c , npoin )
558  ELSEIF(typdia(1:1).NE.'0') THEN
559  WRITE(lu,2001) typdia
560  CALL plante(1)
561  stop
562  ENDIF
563 !
564 !-----------------------------------------------------------------------
565 !
566  ELSEIF(op(1:8).EQ.'X=X-TAY ') THEN
567 !
568 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
569 !
570  IF(typext(1:1).EQ.'Q') THEN
571 !
572  DO ielem = 1 , nelem
573  w1(ielem) = w1(ielem) - xa21(ielem) * y(ikle2(ielem))
574  & - xa31(ielem) * y(ikle3(ielem))
575  & - xa41(ielem) * y(ikle4(ielem))
576  & - xa51(ielem) * y(ikle5(ielem))
577  & - xa61(ielem) * y(ikle6(ielem))
578  w2(ielem) = w2(ielem) - xa12(ielem) * y(ikle1(ielem))
579  & - xa32(ielem) * y(ikle3(ielem))
580  & - xa42(ielem) * y(ikle4(ielem))
581  & - xa52(ielem) * y(ikle5(ielem))
582  & - xa62(ielem) * y(ikle6(ielem))
583  w3(ielem) = w3(ielem) - xa13(ielem) * y(ikle1(ielem))
584  & - xa23(ielem) * y(ikle2(ielem))
585  & - xa43(ielem) * y(ikle4(ielem))
586  & - xa53(ielem) * y(ikle5(ielem))
587  & - xa63(ielem) * y(ikle6(ielem))
588  ENDDO ! IELEM
589 !
590  ELSEIF(typext(1:1).NE.'0') THEN
591 !
592  WRITE(lu,1001) typext
593  CALL plante(1)
594  stop
595 !
596  ENDIF
597 !
598 ! CONTRIBUTION OF THE DIAGONAL
599 !
600  IF(typdia(1:1).EQ.'Q') THEN
601  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
602  ELSEIF(typdia(1:1).EQ.'I') THEN
603  CALL ov ('X=X-Y ', x , y , z , c , npoin )
604  ELSEIF(typdia(1:1).NE.'0') THEN
605  WRITE(lu,2001) typdia
606  CALL plante(1)
607  stop
608  ENDIF
609 !
610 !-----------------------------------------------------------------------
611 !
612  ELSEIF(op(1:8).EQ.'X=X+CTAY') THEN
613 !
614 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
615 !
616  IF(typext(1:1).EQ.'Q') THEN
617 !
618  DO ielem = 1 , nelem
619  w1(ielem) = w1(ielem)
620  & + c * ( + xa21(ielem) * y(ikle2(ielem))
621  & + xa31(ielem) * y(ikle3(ielem))
622  & + xa41(ielem) * y(ikle4(ielem))
623  & + xa51(ielem) * y(ikle5(ielem))
624  & + xa61(ielem) * y(ikle6(ielem)) )
625  w2(ielem) = w2(ielem)
626  & + c * ( + xa12(ielem) * y(ikle1(ielem))
627  & + xa32(ielem) * y(ikle3(ielem))
628  & + xa42(ielem) * y(ikle4(ielem))
629  & + xa52(ielem) * y(ikle5(ielem))
630  & + xa62(ielem) * y(ikle6(ielem)) )
631  w3(ielem) = w3(ielem)
632  & + c * ( + xa13(ielem) * y(ikle1(ielem))
633  & + xa23(ielem) * y(ikle2(ielem))
634  & + xa43(ielem) * y(ikle4(ielem))
635  & + xa53(ielem) * y(ikle5(ielem))
636  & + xa63(ielem) * y(ikle6(ielem)))
637  ENDDO ! IELEM
638 !
639  ELSEIF(typext(1:1).NE.'0') THEN
640 !
641  WRITE(lu,1001) typext
642  CALL plante(1)
643  stop
644 !
645  ENDIF
646 !
647 ! CONTRIBUTION OF THE DIAGONAL
648 !
649  IF(typdia(1:1).EQ.'Q') THEN
650  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
651  ELSEIF(typdia(1:1).EQ.'I') THEN
652  CALL ov ('X=X+CY ', x , y , z , c , npoin )
653  ELSEIF(typdia(1:1).NE.'0') THEN
654  WRITE(lu,2001) typdia
655  CALL plante(1)
656  stop
657  ENDIF
658 !
659 !-----------------------------------------------------------------------
660 !
661  ELSE
662 !
663  WRITE(lu,3001) op
664  CALL plante(1)
665  stop
666 !
667 !-----------------------------------------------------------------------
668 !
669  ENDIF
670 !
671 !-----------------------------------------------------------------------
672 !
673  RETURN
674 !
675 1001 FORMAT(1x,'MV0603 (BIEF) : EXTRADIAG. TERMS UNKNOWN TYPE : ',a1)
676 2001 FORMAT(1x,'MV0603 (BIEF) : DIAGONAL : UNKNOWN TYPE : ',a1)
677 3001 FORMAT(1x,'MV0603 (BIEF) : UNKNOWN OPERATION : ',a8)
678 !
679 !-----------------------------------------------------------------------
680 !
681  END
ov
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
mv0603
subroutine mv0603(OP, X, DA, TYPDIA, XA12, XA13, XA21, XA23, XA31, XA32, XA41, XA42, XA43, XA51, XA52, XA53, XA61, XA62, XA63, TYPEXT, Y, C, IKLE1, IKLE2, IKLE3, IKLE4, IKLE5, IKLE6, NPOIN, NPT2, NELEM, W1, W2, W3, W4, W5, W6)
Definition: mv0603.f:12
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:17 for The TELEMAC-MASCARET system by doxygen 1.8.13