The TELEMAC-MASCARET system  trunk
mv0606_2.f
Go to the documentation of this file.
1 ! *******************
2  SUBROUTINE mv0606_2
3 ! *******************
4 !
5  &(op, x , da,typdia,xa,typext, y,c,
6  & ikle1,ikle2,ikle3,ikle4,ikle5,ikle6,
7  & npoin,nelem,w1,w2,w3,w4,w5,w6,dim1xa)
8 !
9 !***********************************************************************
10 ! BIEF V7P2
11 !***********************************************************************
12 !
13 !brief MATRIX VECTOR OPERATIONS FOR P1 TRIANGLES.
14 ! LIKE MV0606 BUT STORAGE OF OFF-DIAGONAL TERMS INVERTED.
15 !
16 !warning This is a copy of MV0606, only the dimensions of XA are changed.
17 !
18 !code
19 !+ OP IS A STRING OF 8 CHARACTERS, WHICH INDICATES THE OPERATION TO BE
20 !+ PERFORMED ON VECTORS X,Y AND MATRIX M.
21 !+
22 !+ THE RESULT IS VECTOR X.
23 !+
24 !+ THESE OPERATIONS ARE DIFFERENT DEPENDING ON THE DIAGONAL TYPE
25 !+ AND THE TYPE OF EXTRADIAGONAL TERMS.
26 !+
27 !+ IMPLEMENTED OPERATIONS:
28 !+
29 !+ OP = 'X=AY ' : X = AY
30 !+ OP = 'X=-AY ' : X = - AY
31 !+ OP = 'X=X+AY ' : X = X + AY
32 !+ OP = 'X=X-AY ' : X = X - AY
33 !+ OP = 'X=X+CAY ' : X = X + C AY
34 !+ OP = 'X=TAY ' : X = TA Y (TRANSPOSE OF A)
35 !+ OP = 'X=-TAY ' : X = - TA Y (- TRANSPOSE OF A)
36 !+ OP = 'X=X+TAY ' : X = X + TA Y
37 !+ OP = 'X=X-TAY ' : X = X - TA Y
38 !+ OP = 'X=X+CTAY' : X = X + C TA Y
39 !
40 !history J-M HERVOUET (EDF LAB, LNHE)
41 !+ 22/03/2016
42 !+ V7P2
43 !+ First version.
44 !
45 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
46 !| C |-->| A GIVEN CONSTANT
47 !| DA |-->| MATRIX DIAGONAL
48 !| DIM1XA |-->| FIRST DIMENSION OF XA
49 !| IKLE1 |-->| FIRST POINTS OF ELEMENTS
50 !| IKLE2 |-->| SECOND POINTS OF ELEMENTS
51 !| IKLE3 |-->| THIRD POINTS OF ELEMENTS
52 !| IKLE4 |-->| FOURTH POINTS OF ELEMENTS
53 !| IKLE5 |-->| FIFTH POINTS OF ELEMENTS
54 !| IKLE6 |-->| SIXTH POINTS OF ELEMENTS
55 !| NELEM |-->| NUMBER OF ELEMENTS
56 !| NPOIN |-->| NUMBER OF LINEAR POINTS
57 !| NPT2 |-->| NUMBER OF QUADRATIC POINTS
58 !| OP |-->| OPERATION TO BE DONE (SEE ABOVE)
59 !| TYPDIA |-->| TYPE OF DIAGONAL:
60 !| | | TYPDIA = 'Q' : ANY VALUE
61 !| | | TYPDIA = 'I' : IDENTITY
62 !| | | TYPDIA = '0' : ZERO
63 !| TYPEXT |-->| TYPE OF OFF-DIAGONAL TERMS
64 !| | | TYPEXT = 'Q' : ANY VALUE
65 !| | | TYPEXT = 'S' : SYMMETRIC
66 !| | | TYPEXT = '0' : ZERO
67 !| W1 |<->| RESULT IN NON ASSEMBLED FORM
68 !| W2 |<->| RESULT IN NON ASSEMBLED FORM
69 !| W3 |<->| RESULT IN NON ASSEMBLED FORM
70 !| W4 |<->| RESULT IN NON ASSEMBLED FORM
71 !| W5 |<->| RESULT IN NON ASSEMBLED FORM
72 !| W6 |<->| RESULT IN NON ASSEMBLED FORM
73 !| XA |<->| RESULT IN ASSEMBLED FORM
74 !| Y |-->| VECTOR USED IN THE OPERATION
75 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
76 !
77  USE bief, ex_mv0606_2 => mv0606_2
78  USE declarations_special
79 !
80  IMPLICIT NONE
81 !
82 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
83 !
84  INTEGER, INTENT(IN) :: NELEM,NPOIN,DIM1XA
85  INTEGER, INTENT(IN) :: IKLE1(*),IKLE2(*),IKLE3(*)
86  INTEGER, INTENT(IN) :: IKLE4(*),IKLE5(*),IKLE6(*)
87 !
88  DOUBLE PRECISION, INTENT(INOUT) :: W1(*),W2(*),W3(*)
89  DOUBLE PRECISION, INTENT(INOUT) :: W4(*),W5(*),W6(*)
90  DOUBLE PRECISION, INTENT(IN) :: Y(*),DA(*)
91  DOUBLE PRECISION, INTENT(INOUT) :: X(*)
92  DOUBLE PRECISION, INTENT(IN) :: XA(dim1xa,*)
93  DOUBLE PRECISION, INTENT(IN) :: C
94 !
95  CHARACTER(LEN=8), INTENT(IN) :: OP
96  CHARACTER(LEN=1), INTENT(IN) :: TYPDIA,TYPEXT
97 !
98 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
99 !
100  INTEGER IELEM,I1,I2,I3,I4,I5,I6
101  DOUBLE PRECISION Z(1)
102 !
103 !-----------------------------------------------------------------------
104 !
105  IF(op(1:8).EQ.'X=AY ') THEN
106 !
107 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
108 !
109  IF(typext(1:1).EQ.'S') THEN
110 !
111  DO ielem = 1 , nelem
112 !
113  i1 = ikle1(ielem)
114  i2 = ikle2(ielem)
115  i3 = ikle3(ielem)
116  i4 = ikle4(ielem)
117  i5 = ikle5(ielem)
118  i6 = ikle6(ielem)
119 !
120  w1(ielem) =
121  & + xa(1,ielem) * y(i2)
122  & + xa(2,ielem) * y(i3)
123  & + xa(3,ielem) * y(i4)
124  & + xa(4,ielem) * y(i5)
125  & + xa(5,ielem) * y(i6)
126 !
127  w2(ielem) =
128  & + xa(1,ielem) * y(i1)
129  & + xa(6,ielem) * y(i3)
130  & + xa(7,ielem) * y(i4)
131  & + xa(8,ielem) * y(i5)
132  & + xa(9,ielem) * y(i6)
133 !
134  w3(ielem) =
135  & + xa(2,ielem) * y(i1)
136  & + xa(6,ielem) * y(i2)
137  & + xa(10,ielem) * y(i4)
138  & + xa(11,ielem) * y(i5)
139  & + xa(12,ielem) * y(i6)
140 !
141  w4(ielem) =
142  & + xa(3,ielem) * y(i1)
143  & + xa(7,ielem) * y(i2)
144  & + xa(10,ielem) * y(i3)
145  & + xa(13,ielem) * y(i5)
146  & + xa(14,ielem) * y(i6)
147 !
148  w5(ielem) =
149  & + xa(4,ielem) * y(i1)
150  & + xa(8,ielem) * y(i2)
151  & + xa(11,ielem) * y(i3)
152  & + xa(13,ielem) * y(i4)
153  & + xa(15,ielem) * y(i6)
154 !
155  w6(ielem) =
156  & + xa(5,ielem) * y(i1)
157  & + xa(9,ielem) * y(i2)
158  & + xa(12,ielem) * y(i3)
159  & + xa(14,ielem) * y(i4)
160  & + xa(15,ielem) * y(i5)
161 !
162  ENDDO ! IELEM
163 !
164  ELSEIF(typext(1:1).EQ.'Q') THEN
165 !
166  DO ielem = 1 , nelem
167 !
168  i1 = ikle1(ielem)
169  i2 = ikle2(ielem)
170  i3 = ikle3(ielem)
171  i4 = ikle4(ielem)
172  i5 = ikle5(ielem)
173  i6 = ikle6(ielem)
174 !
175  w1(ielem) =
176  & + xa(1,ielem) * y(i2)
177  & + xa(2,ielem) * y(i3)
178  & + xa(3,ielem) * y(i4)
179  & + xa(4,ielem) * y(i5)
180  & + xa(5,ielem) * y(i6)
181 !
182  w2(ielem) =
183  & + xa(16,ielem) * y(i1)
184  & + xa(6,ielem) * y(i3)
185  & + xa(7,ielem) * y(i4)
186  & + xa(8,ielem) * y(i5)
187  & + xa(9,ielem) * y(i6)
188 !
189  w3(ielem) =
190  & + xa(17,ielem) * y(i1)
191  & + xa(21,ielem) * y(i2)
192  & + xa(10,ielem) * y(i4)
193  & + xa(11,ielem) * y(i5)
194  & + xa(12,ielem) * y(i6)
195 !
196  w4(ielem) =
197  & + xa(18,ielem) * y(i1)
198  & + xa(22,ielem) * y(i2)
199  & + xa(25,ielem) * y(i3)
200  & + xa(13,ielem) * y(i5)
201  & + xa(14,ielem) * y(i6)
202 !
203  w5(ielem) =
204  & + xa(19,ielem) * y(i1)
205  & + xa(23,ielem) * y(i2)
206  & + xa(26,ielem) * y(i3)
207  & + xa(28,ielem) * y(i4)
208  & + xa(15,ielem) * y(i6)
209 !
210  w6(ielem) =
211  & + xa(20,ielem) * y(i1)
212  & + xa(24,ielem) * y(i2)
213  & + xa(27,ielem) * y(i3)
214  & + xa(29,ielem) * y(i4)
215  & + xa(30,ielem) * y(i5)
216 !
217  ENDDO ! IELEM
218 !
219  ELSEIF(typext(1:1).EQ.'0') THEN
220 !
221  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
222  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
223  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
224  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
225  CALL ov ('X=C ', w5 , y , z , 0.d0 , nelem )
226  CALL ov ('X=C ', w6 , y , z , 0.d0 , nelem )
227 !
228  ELSE
229 !
230  WRITE(lu,1001) typext
231  CALL plante(1)
232  stop
233 !
234  ENDIF
235 !
236 ! CONTRIBUTION OF THE DIAGONAL:
237 !
238  IF(typdia(1:1).EQ.'Q') THEN
239  CALL ov ('X=YZ ', x , y , da , c , npoin )
240  ELSEIF(typdia(1:1).EQ.'I') THEN
241  CALL ov ('X=Y ', x , y , z , c , npoin )
242  ELSEIF(typdia(1:1).EQ.'0') THEN
243  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
244  ELSE
245  WRITE(lu,2001) typdia
246  CALL plante(1)
247  stop
248  ENDIF
249 !
250 !-----------------------------------------------------------------------
251 !
252  ELSEIF(op(1:8).EQ.'X=-AY ') THEN
253 !
254 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
255 !
256  IF(typext(1:1).EQ.'S') THEN
257 !
258  DO ielem = 1 , nelem
259 !
260  i1 = ikle1(ielem)
261  i2 = ikle2(ielem)
262  i3 = ikle3(ielem)
263  i4 = ikle4(ielem)
264  i5 = ikle5(ielem)
265  i6 = ikle6(ielem)
266 !
267  w1(ielem) =
268  & - xa(1,ielem) * y(i2)
269  & - xa(2,ielem) * y(i3)
270  & - xa(3,ielem) * y(i4)
271  & - xa(4,ielem) * y(i5)
272  & - xa(5,ielem) * y(i6)
273 !
274  w2(ielem) =
275  & - xa(1,ielem) * y(i1)
276  & - xa(6,ielem) * y(i3)
277  & - xa(7,ielem) * y(i4)
278  & - xa(8,ielem) * y(i5)
279  & - xa(9,ielem) * y(i6)
280 !
281  w3(ielem) =
282  & - xa(2,ielem) * y(i1)
283  & - xa(6,ielem) * y(i2)
284  & - xa(10,ielem) * y(i4)
285  & - xa(11,ielem) * y(i5)
286  & - xa(12,ielem) * y(i6)
287 !
288  w4(ielem) =
289  & - xa(3,ielem) * y(i1)
290  & - xa(7,ielem) * y(i2)
291  & - xa(10,ielem) * y(i3)
292  & - xa(13,ielem) * y(i5)
293  & - xa(14,ielem) * y(i6)
294 !
295  w5(ielem) =
296  & - xa(4,ielem) * y(i1)
297  & - xa(8,ielem) * y(i2)
298  & - xa(11,ielem) * y(i3)
299  & - xa(13,ielem) * y(i4)
300  & - xa(15,ielem) * y(i6)
301 !
302  w6(ielem) =
303  & - xa(5,ielem) * y(i1)
304  & - xa(9,ielem) * y(i2)
305  & - xa(12,ielem) * y(i3)
306  & - xa(14,ielem) * y(i4)
307  & - xa(15,ielem) * y(i5)
308 !
309  ENDDO ! IELEM
310 !
311  ELSEIF(typext(1:1).EQ.'Q') THEN
312 !
313  DO ielem = 1 , nelem
314 !
315  i1 = ikle1(ielem)
316  i2 = ikle2(ielem)
317  i3 = ikle3(ielem)
318  i4 = ikle4(ielem)
319  i5 = ikle5(ielem)
320  i6 = ikle6(ielem)
321 !
322  w1(ielem) =
323  & - xa(1,ielem) * y(i2)
324  & - xa(2,ielem) * y(i3)
325  & - xa(3,ielem) * y(i4)
326  & - xa(4,ielem) * y(i5)
327  & - xa(5,ielem) * y(i6)
328 !
329  w2(ielem) =
330  & - xa(16,ielem) * y(i1)
331  & - xa(6,ielem) * y(i3)
332  & - xa(7,ielem) * y(i4)
333  & - xa(8,ielem) * y(i5)
334  & - xa(9,ielem) * y(i6)
335 !
336  w3(ielem) =
337  & - xa(17,ielem) * y(i1)
338  & - xa(21,ielem) * y(i2)
339  & - xa(10,ielem) * y(i4)
340  & - xa(11,ielem) * y(i5)
341  & - xa(12,ielem) * y(i6)
342 !
343  w4(ielem) =
344  & - xa(18,ielem) * y(i1)
345  & - xa(22,ielem) * y(i2)
346  & - xa(25,ielem) * y(i3)
347  & - xa(13,ielem) * y(i5)
348  & - xa(14,ielem) * y(i6)
349 !
350  w5(ielem) =
351  & - xa(19,ielem) * y(i1)
352  & - xa(23,ielem) * y(i2)
353  & - xa(26,ielem) * y(i3)
354  & - xa(28,ielem) * y(i4)
355  & - xa(15,ielem) * y(i6)
356 !
357  w6(ielem) =
358  & - xa(20,ielem) * y(i1)
359  & - xa(24,ielem) * y(i2)
360  & - xa(27,ielem) * y(i3)
361  & - xa(29,ielem) * y(i4)
362  & - xa(30,ielem) * y(i5)
363 !
364  ENDDO ! IELEM
365 !
366  ELSEIF(typext(1:1).EQ.'0') THEN
367 !
368  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
369  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
370  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
371  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
372  CALL ov ('X=C ', w5 , y , z , 0.d0 , nelem )
373  CALL ov ('X=C ', w6 , y , z , 0.d0 , nelem )
374 !
375  ELSE
376 !
377  WRITE(lu,1001) typext
378  CALL plante(1)
379  stop
380 !
381  ENDIF
382 !
383 ! CONTRIBUTION OF THE DIAGONAL:
384 !
385  IF(typdia(1:1).EQ.'Q') THEN
386  CALL ov ('X=-YZ ', x , y , da , c , npoin )
387  ELSEIF(typdia(1:1).EQ.'I') THEN
388  CALL ov ('X=-Y ', x , y , z , c , npoin )
389  ELSEIF(typdia(1:1).EQ.'0') THEN
390  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
391  ELSE
392  WRITE(lu,2001) typdia
393  CALL plante(1)
394  stop
395  ENDIF
396 !
397 !-----------------------------------------------------------------------
398 !
399  ELSEIF(op(1:8).EQ.'X=X+AY ') THEN
400 !
401 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
402 !
403  IF(typext(1:1).EQ.'S') THEN
404 !
405  DO ielem = 1 , nelem
406 !
407  i1 = ikle1(ielem)
408  i2 = ikle2(ielem)
409  i3 = ikle3(ielem)
410  i4 = ikle4(ielem)
411  i5 = ikle5(ielem)
412  i6 = ikle6(ielem)
413 !
414  w1(ielem) = w1(ielem)
415  & + xa(1,ielem) * y(i2)
416  & + xa(2,ielem) * y(i3)
417  & + xa(3,ielem) * y(i4)
418  & + xa(4,ielem) * y(i5)
419  & + xa(5,ielem) * y(i6)
420 !
421  w2(ielem) = w2(ielem)
422  & + xa(1,ielem) * y(i1)
423  & + xa(6,ielem) * y(i3)
424  & + xa(7,ielem) * y(i4)
425  & + xa(8,ielem) * y(i5)
426  & + xa(9,ielem) * y(i6)
427 !
428  w3(ielem) = w3(ielem)
429  & + xa(2,ielem) * y(i1)
430  & + xa(6,ielem) * y(i2)
431  & + xa(10,ielem) * y(i4)
432  & + xa(11,ielem) * y(i5)
433  & + xa(12,ielem) * y(i6)
434 !
435  w4(ielem) = w4(ielem)
436  & + xa(3,ielem) * y(i1)
437  & + xa(7,ielem) * y(i2)
438  & + xa(10,ielem) * y(i3)
439  & + xa(13,ielem) * y(i5)
440  & + xa(14,ielem) * y(i6)
441 !
442  w5(ielem) = w5(ielem)
443  & + xa(4,ielem) * y(i1)
444  & + xa(8,ielem) * y(i2)
445  & + xa(11,ielem) * y(i3)
446  & + xa(13,ielem) * y(i4)
447  & + xa(15,ielem) * y(i6)
448 !
449  w6(ielem) = w6(ielem)
450  & + xa(5,ielem) * y(i1)
451  & + xa(9,ielem) * y(i2)
452  & + xa(12,ielem) * y(i3)
453  & + xa(14,ielem) * y(i4)
454  & + xa(15,ielem) * y(i5)
455 !
456  ENDDO ! IELEM
457 !
458  ELSEIF(typext(1:1).EQ.'Q') THEN
459 !
460  DO ielem = 1 , nelem
461 !
462  i1 = ikle1(ielem)
463  i2 = ikle2(ielem)
464  i3 = ikle3(ielem)
465  i4 = ikle4(ielem)
466  i5 = ikle5(ielem)
467  i6 = ikle6(ielem)
468 !
469  w1(ielem) = w1(ielem)
470  & + xa(1,ielem) * y(i2)
471  & + xa(2,ielem) * y(i3)
472  & + xa(3,ielem) * y(i4)
473  & + xa(4,ielem) * y(i5)
474  & + xa(5,ielem) * y(i6)
475 !
476  w2(ielem) = w2(ielem)
477  & + xa(16,ielem) * y(i1)
478  & + xa(6,ielem) * y(i3)
479  & + xa(7,ielem) * y(i4)
480  & + xa(8,ielem) * y(i5)
481  & + xa(9,ielem) * y(i6)
482 !
483  w3(ielem) = w3(ielem)
484  & + xa(17,ielem) * y(i1)
485  & + xa(21,ielem) * y(i2)
486  & + xa(10,ielem) * y(i4)
487  & + xa(11,ielem) * y(i5)
488  & + xa(12,ielem) * y(i6)
489 !
490  w4(ielem) = w4(ielem)
491  & + xa(18,ielem) * y(i1)
492  & + xa(22,ielem) * y(i2)
493  & + xa(25,ielem) * y(i3)
494  & + xa(13,ielem) * y(i5)
495  & + xa(14,ielem) * y(i6)
496 !
497  w5(ielem) = w5(ielem)
498  & + xa(19,ielem) * y(i1)
499  & + xa(23,ielem) * y(i2)
500  & + xa(26,ielem) * y(i3)
501  & + xa(28,ielem) * y(i4)
502  & + xa(15,ielem) * y(i6)
503 !
504  w6(ielem) = w6(ielem)
505  & + xa(20,ielem) * y(i1)
506  & + xa(24,ielem) * y(i2)
507  & + xa(27,ielem) * y(i3)
508  & + xa(29,ielem) * y(i4)
509  & + xa(30,ielem) * y(i5)
510 !
511  ENDDO ! IELEM
512 !
513  ELSEIF(typext(1:1).NE.'0') THEN
514 !
515  WRITE(lu,1001) typext
516  CALL plante(1)
517  stop
518 !
519  ENDIF
520 !
521 ! CONTRIBUTION OF THE DIAGONAL:
522 !
523  IF(typdia(1:1).EQ.'Q') THEN
524  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
525  ELSEIF(typdia(1:1).EQ.'I') THEN
526  CALL ov ('X=X+Y ', x , y , z , c , npoin )
527  ELSEIF(typdia(1:1).NE.'0') THEN
528  WRITE(lu,2001) typdia
529  CALL plante(1)
530  stop
531  ENDIF
532 !
533 !-----------------------------------------------------------------------
534 !
535  ELSEIF(op(1:8).EQ.'X=X-AY ') THEN
536 !
537 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
538 !
539  IF(typext(1:1).EQ.'S') THEN
540 !
541  DO ielem = 1 , nelem
542 !
543  i1 = ikle1(ielem)
544  i2 = ikle2(ielem)
545  i3 = ikle3(ielem)
546  i4 = ikle4(ielem)
547  i5 = ikle5(ielem)
548  i6 = ikle6(ielem)
549 !
550  w1(ielem) = w1(ielem)
551  & - xa(1,ielem) * y(i2)
552  & - xa(2,ielem) * y(i3)
553  & - xa(3,ielem) * y(i4)
554  & - xa(4,ielem) * y(i5)
555  & - xa(5,ielem) * y(i6)
556 !
557  w2(ielem) = w2(ielem)
558  & - xa(1,ielem) * y(i1)
559  & - xa(6,ielem) * y(i3)
560  & - xa(7,ielem) * y(i4)
561  & - xa(8,ielem) * y(i5)
562  & - xa(9,ielem) * y(i6)
563 !
564  w3(ielem) = w3(ielem)
565  & - xa(2,ielem) * y(i1)
566  & - xa(6,ielem) * y(i2)
567  & - xa(10,ielem) * y(i4)
568  & - xa(11,ielem) * y(i5)
569  & - xa(12,ielem) * y(i6)
570 !
571  w4(ielem) = w4(ielem)
572  & - xa(3,ielem) * y(i1)
573  & - xa(7,ielem) * y(i2)
574  & - xa(10,ielem) * y(i3)
575  & - xa(13,ielem) * y(i5)
576  & - xa(14,ielem) * y(i6)
577 !
578  w5(ielem) = w5(ielem)
579  & - xa(4,ielem) * y(i1)
580  & - xa(8,ielem) * y(i2)
581  & - xa(11,ielem) * y(i3)
582  & - xa(13,ielem) * y(i4)
583  & - xa(15,ielem) * y(i6)
584 !
585  w6(ielem) = w6(ielem)
586  & - xa(5,ielem) * y(i1)
587  & - xa(9,ielem) * y(i2)
588  & - xa(12,ielem) * y(i3)
589  & - xa(14,ielem) * y(i4)
590  & - xa(15,ielem) * y(i5)
591 !
592  ENDDO ! IELEM
593 !
594  ELSEIF(typext(1:1).EQ.'Q') THEN
595 !
596  DO ielem = 1 , nelem
597 !
598  i1 = ikle1(ielem)
599  i2 = ikle2(ielem)
600  i3 = ikle3(ielem)
601  i4 = ikle4(ielem)
602  i5 = ikle5(ielem)
603  i6 = ikle6(ielem)
604 !
605  w1(ielem) = w1(ielem)
606  & - xa(1,ielem) * y(i2)
607  & - xa(2,ielem) * y(i3)
608  & - xa(3,ielem) * y(i4)
609  & - xa(4,ielem) * y(i5)
610  & - xa(5,ielem) * y(i6)
611 !
612  w2(ielem) = w2(ielem)
613  & - xa(16,ielem) * y(i1)
614  & - xa(6,ielem) * y(i3)
615  & - xa(7,ielem) * y(i4)
616  & - xa(8,ielem) * y(i5)
617  & - xa(9,ielem) * y(i6)
618 !
619  w3(ielem) = w3(ielem)
620  & - xa(17,ielem) * y(i1)
621  & - xa(21,ielem) * y(i2)
622  & - xa(10,ielem) * y(i4)
623  & - xa(11,ielem) * y(i5)
624  & - xa(12,ielem) * y(i6)
625 !
626  w4(ielem) = w4(ielem)
627  & - xa(18,ielem) * y(i1)
628  & - xa(22,ielem) * y(i2)
629  & - xa(25,ielem) * y(i3)
630  & - xa(13,ielem) * y(i5)
631  & - xa(14,ielem) * y(i6)
632 !
633  w5(ielem) = w5(ielem)
634  & - xa(19,ielem) * y(i1)
635  & - xa(23,ielem) * y(i2)
636  & - xa(26,ielem) * y(i3)
637  & - xa(28,ielem) * y(i4)
638  & - xa(15,ielem) * y(i6)
639 !
640  w6(ielem) = w6(ielem)
641  & - xa(20,ielem) * y(i1)
642  & - xa(24,ielem) * y(i2)
643  & - xa(27,ielem) * y(i3)
644  & - xa(29,ielem) * y(i4)
645  & - xa(30,ielem) * y(i5)
646 !
647  ENDDO ! IELEM
648 !
649  ELSEIF(typext(1:1).NE.'0') THEN
650 !
651  WRITE(lu,1001) typext
652  CALL plante(1)
653  stop
654 !
655  ENDIF
656 !
657 ! CONTRIBUTION OF THE DIAGONAL:
658 !
659  IF(typdia(1:1).EQ.'Q') THEN
660  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
661  ELSEIF(typdia(1:1).EQ.'I') THEN
662  CALL ov ('X=X-Y ', x , y , z , c , npoin )
663  ELSEIF(typdia(1:1).NE.'0') THEN
664  WRITE(lu,2001) typdia
665  CALL plante(1)
666  stop
667  ENDIF
668 !
669 !-----------------------------------------------------------------------
670 !
671  ELSEIF(op(1:8).EQ.'X=X+CAY ') THEN
672 !
673 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
674 !
675  IF(typext(1:1).EQ.'S') THEN
676 !
677  DO ielem = 1 , nelem
678 !
679  i1 = ikle1(ielem)
680  i2 = ikle2(ielem)
681  i3 = ikle3(ielem)
682  i4 = ikle4(ielem)
683  i5 = ikle5(ielem)
684  i6 = ikle6(ielem)
685 !
686  w1(ielem) = w1(ielem) + c * (
687  & + xa(1,ielem) * y(i2)
688  & + xa(2,ielem) * y(i3)
689  & + xa(3,ielem) * y(i4)
690  & + xa(4,ielem) * y(i5)
691  & + xa(5,ielem) * y(i6) )
692 !
693  w2(ielem) = w2(ielem) + c * (
694  & + xa(1,ielem) * y(i1)
695  & + xa(6,ielem) * y(i3)
696  & + xa(7,ielem) * y(i4)
697  & + xa(8,ielem) * y(i5)
698  & + xa(9,ielem) * y(i6) )
699 !
700  w3(ielem) = w3(ielem) + c * (
701  & + xa(2,ielem) * y(i1)
702  & + xa(6,ielem) * y(i2)
703  & + xa(10,ielem) * y(i4)
704  & + xa(11,ielem) * y(i5)
705  & + xa(12,ielem)* y(i6) )
706 !
707  w4(ielem) = w4(ielem) + c * (
708  & + xa(3,ielem) * y(i1)
709  & + xa(7,ielem) * y(i2)
710  & + xa(10,ielem) * y(i3)
711  & + xa(13,ielem) * y(i5)
712  & + xa(14,ielem) * y(i6) )
713 !
714  w5(ielem) = w5(ielem) + c * (
715  & + xa(4,ielem) * y(i1)
716  & + xa(8,ielem) * y(i2)
717  & + xa(11,ielem) * y(i3)
718  & + xa(13,ielem) * y(i4)
719  & + xa(15,ielem) * y(i6) )
720 !
721  w6(ielem) = w6(ielem) + c * (
722  & + xa(5,ielem) * y(i1)
723  & + xa(9,ielem) * y(i2)
724  & + xa(12,ielem) * y(i3)
725  & + xa(14,ielem) * y(i4)
726  & + xa(15,ielem) * y(i5) )
727 !
728  ENDDO ! IELEM
729 !
730  ELSEIF(typext(1:1).EQ.'Q') THEN
731 !
732  DO ielem = 1 , nelem
733 !
734  i1 = ikle1(ielem)
735  i2 = ikle2(ielem)
736  i3 = ikle3(ielem)
737  i4 = ikle4(ielem)
738  i5 = ikle5(ielem)
739  i6 = ikle6(ielem)
740 !
741  w1(ielem) = w1(ielem) + c * (
742  & + xa(1,ielem) * y(i2)
743  & + xa(2,ielem) * y(i3)
744  & + xa(3,ielem) * y(i4)
745  & + xa(4,ielem) * y(i5)
746  & + xa(5,ielem) * y(i6) )
747 !
748  w2(ielem) = w2(ielem) + c * (
749  & + xa(16,ielem) * y(i1)
750  & + xa(6,ielem) * y(i3)
751  & + xa(7,ielem) * y(i4)
752  & + xa(8,ielem) * y(i5)
753  & + xa(9,ielem) * y(i6) )
754 !
755  w3(ielem) = w3(ielem) + c * (
756  & + xa(17,ielem) * y(i1)
757  & + xa(21,ielem) * y(i2)
758  & + xa(10,ielem) * y(i4)
759  & + xa(11,ielem) * y(i5)
760  & + xa(12,ielem) * y(i6) )
761 !
762  w4(ielem) = w4(ielem) + c * (
763  & + xa(18,ielem) * y(i1)
764  & + xa(22,ielem) * y(i2)
765  & + xa(25,ielem) * y(i3)
766  & + xa(13,ielem) * y(i5)
767  & + xa(14,ielem) * y(i6) )
768 !
769  w5(ielem) = w5(ielem) + c * (
770  & + xa(19,ielem) * y(i1)
771  & + xa(23,ielem) * y(i2)
772  & + xa(26,ielem) * y(i3)
773  & + xa(28,ielem) * y(i4)
774  & + xa(15,ielem) * y(i6) )
775 !
776  w6(ielem) = w6(ielem) + c * (
777  & + xa(20,ielem) * y(i1)
778  & + xa(24,ielem) * y(i2)
779  & + xa(27,ielem) * y(i3)
780  & + xa(29,ielem) * y(i4)
781  & + xa(30,ielem) * y(i5) )
782 !
783  ENDDO ! IELEM
784 !
785  ELSEIF(typext(1:1).NE.'0') THEN
786 !
787  WRITE(lu,1001) typext
788  CALL plante(0)
789  stop
790 !
791  ENDIF
792 !
793 ! CONTRIBUTION OF THE DIAGONAL:
794 !
795  IF(typdia(1:1).EQ.'Q') THEN
796  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
797  ELSEIF(typdia(1:1).EQ.'I') THEN
798  CALL ov ('X=X+CY ', x , y , z , c , npoin )
799  ELSEIF(typdia(1:1).NE.'0') THEN
800  WRITE(lu,2001) typdia
801  CALL plante(1)
802  stop
803  ENDIF
804 !
805 !-----------------------------------------------------------------------
806 !
807  ELSEIF(op(1:8).EQ.'X=TAY ') THEN
808 !
809 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
810 !
811  IF(typext(1:1).EQ.'S') THEN
812 !
813  DO ielem = 1 , nelem
814 !
815  i1 = ikle1(ielem)
816  i2 = ikle2(ielem)
817  i3 = ikle3(ielem)
818  i4 = ikle4(ielem)
819  i5 = ikle5(ielem)
820  i6 = ikle6(ielem)
821 !
822  w1(ielem) =
823  & + xa(1,ielem) * y(i2)
824  & + xa(2,ielem) * y(i3)
825  & + xa(3,ielem) * y(i4)
826  & + xa(4,ielem) * y(i5)
827  & + xa(5,ielem) * y(i6)
828 !
829  w2(ielem) =
830  & + xa(1,ielem) * y(i1)
831  & + xa(6,ielem) * y(i3)
832  & + xa(7,ielem) * y(i4)
833  & + xa(8,ielem) * y(i5)
834  & + xa(9,ielem) * y(i6)
835 !
836  w3(ielem) =
837  & + xa(2,ielem) * y(i1)
838  & + xa(6,ielem) * y(i2)
839  & + xa(10,ielem) * y(i4)
840  & + xa(11,ielem) * y(i5)
841  & + xa(12,ielem) * y(i6)
842 !
843  w4(ielem) =
844  & + xa(3,ielem) * y(i1)
845  & + xa(7,ielem) * y(i2)
846  & + xa(10,ielem) * y(i3)
847  & + xa(13,ielem) * y(i5)
848  & + xa(14,ielem) * y(i6)
849 !
850  w5(ielem) =
851  & + xa(4,ielem) * y(i1)
852  & + xa(8,ielem) * y(i2)
853  & + xa(11,ielem) * y(i3)
854  & + xa(13,ielem) * y(i4)
855  & + xa(15,ielem) * y(i6)
856 !
857  w6(ielem) =
858  & + xa(5,ielem) * y(i1)
859  & + xa(9,ielem) * y(i2)
860  & + xa(12,ielem) * y(i3)
861  & + xa(14,ielem) * y(i4)
862  & + xa(15,ielem) * y(i5)
863 !
864  ENDDO ! IELEM
865 !
866  ELSEIF(typext(1:1).EQ.'Q') THEN
867 !
868  DO ielem = 1 , nelem
869 !
870  i1 = ikle1(ielem)
871  i2 = ikle2(ielem)
872  i3 = ikle3(ielem)
873  i4 = ikle4(ielem)
874  i5 = ikle5(ielem)
875  i6 = ikle6(ielem)
876 !
877  w1(ielem) =
878  & + xa(16,ielem) * y(i2)
879  & + xa(17,ielem) * y(i3)
880  & + xa(18,ielem) * y(i4)
881  & + xa(19,ielem) * y(i5)
882  & + xa(20,ielem) * y(i6)
883 !
884  w2(ielem) =
885  & + xa(1,ielem) * y(i1)
886  & + xa(21,ielem) * y(i3)
887  & + xa(22,ielem) * y(i4)
888  & + xa(23,ielem) * y(i5)
889  & + xa(24,ielem) * y(i6)
890 !
891  w3(ielem) =
892  & + xa(2,ielem) * y(i1)
893  & + xa(6,ielem) * y(i2)
894  & + xa(25,ielem) * y(i4)
895  & + xa(26,ielem) * y(i5)
896  & + xa(27,ielem) * y(i6)
897 !
898  w4(ielem) =
899  & + xa(3,ielem) * y(i1)
900  & + xa(7,ielem) * y(i2)
901  & + xa(10,ielem) * y(i3)
902  & + xa(28,ielem) * y(i5)
903  & + xa(29,ielem) * y(i6)
904 !
905  w5(ielem) =
906  & + xa(4,ielem) * y(i1)
907  & + xa(8,ielem) * y(i2)
908  & + xa(11,ielem) * y(i3)
909  & + xa(13,ielem) * y(i4)
910  & + xa(30,ielem) * y(i6)
911 !
912  w6(ielem) =
913  & + xa(5,ielem) * y(i1)
914  & + xa(9,ielem) * y(i2)
915  & + xa(12,ielem) * y(i3)
916  & + xa(14,ielem) * y(i4)
917  & + xa(15,ielem) * y(i5)
918 !
919  ENDDO ! IELEM
920 !
921  ELSEIF(typext(1:1).EQ.'0') THEN
922 !
923  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
924  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
925  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
926  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
927  CALL ov ('X=C ', w5 , y , z , 0.d0 , nelem )
928  CALL ov ('X=C ', w6 , y , z , 0.d0 , nelem )
929 !
930  ELSE
931 !
932  WRITE(lu,1001) typext
933  CALL plante(0)
934  stop
935 !
936  ENDIF
937 !
938 ! CONTRIBUTION OF THE DIAGONAL
939 !
940  IF(typdia(1:1).EQ.'Q') THEN
941  CALL ov ('X=YZ ', x , y , da , c , npoin )
942  ELSEIF(typdia(1:1).EQ.'I') THEN
943  CALL ov ('X=Y ', x , y , z , c , npoin )
944  ELSEIF(typdia(1:1).EQ.'0') THEN
945  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
946  ELSE
947  WRITE(lu,2001) typdia
948  CALL plante(1)
949  stop
950  ENDIF
951 !
952 !-----------------------------------------------------------------------
953 !
954  ELSEIF(op(1:8).EQ.'X=-TAY ') THEN
955 !
956 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
957 !
958  IF(typext(1:1).EQ.'S') THEN
959 !
960  DO ielem = 1 , nelem
961 !
962  i1 = ikle1(ielem)
963  i2 = ikle2(ielem)
964  i3 = ikle3(ielem)
965  i4 = ikle4(ielem)
966  i5 = ikle5(ielem)
967  i6 = ikle6(ielem)
968 !
969  w1(ielem) =
970  & - xa(1,ielem) * y(i2)
971  & - xa(2,ielem) * y(i3)
972  & - xa(3,ielem) * y(i4)
973  & - xa(4,ielem) * y(i5)
974  & - xa(5,ielem) * y(i6)
975 !
976  w2(ielem) =
977  & - xa(1,ielem) * y(i1)
978  & - xa(6,ielem) * y(i3)
979  & - xa(7,ielem) * y(i4)
980  & - xa(8,ielem) * y(i5)
981  & - xa(9,ielem) * y(i6)
982 !
983  w3(ielem) =
984  & - xa(2,ielem) * y(i1)
985  & - xa(6,ielem) * y(i2)
986  & - xa(10,ielem) * y(i4)
987  & - xa(11,ielem) * y(i5)
988  & - xa(12,ielem) * y(i6)
989 !
990  w4(ielem) =
991  & - xa(3,ielem) * y(i1)
992  & - xa(7,ielem) * y(i2)
993  & - xa(10,ielem) * y(i3)
994  & - xa(13,ielem) * y(i5)
995  & - xa(14,ielem) * y(i6)
996 !
997  w5(ielem) =
998  & - xa(4,ielem) * y(i1)
999  & - xa(8,ielem) * y(i2)
1000  & - xa(11,ielem) * y(i3)
1001  & - xa(13,ielem) * y(i4)
1002  & - xa(15,ielem) * y(i6)
1003 !
1004  w6(ielem) =
1005  & - xa(5,ielem) * y(i1)
1006  & - xa(9,ielem) * y(i2)
1007  & - xa(12,ielem) * y(i3)
1008  & - xa(14,ielem) * y(i4)
1009  & - xa(15,ielem) * y(i5)
1010 !
1011  ENDDO ! IELEM
1012 !
1013  ELSEIF(typext(1:1).EQ.'Q') THEN
1014 !
1015  DO ielem = 1 , nelem
1016 !
1017  i1 = ikle1(ielem)
1018  i2 = ikle2(ielem)
1019  i3 = ikle3(ielem)
1020  i4 = ikle4(ielem)
1021  i5 = ikle5(ielem)
1022  i6 = ikle6(ielem)
1023 !
1024  w1(ielem) =
1025  & - xa(16,ielem) * y(i2)
1026  & - xa(17,ielem) * y(i3)
1027  & - xa(18,ielem) * y(i4)
1028  & - xa(19,ielem) * y(i5)
1029  & - xa(20,ielem) * y(i6)
1030 !
1031  w2(ielem) =
1032  & - xa(1,ielem) * y(i1)
1033  & - xa(21,ielem) * y(i3)
1034  & - xa(22,ielem) * y(i4)
1035  & - xa(23,ielem) * y(i5)
1036  & - xa(24,ielem) * y(i6)
1037 !
1038  w3(ielem) =
1039  & - xa(2,ielem) * y(i1)
1040  & - xa(6,ielem) * y(i2)
1041  & - xa(25,ielem) * y(i4)
1042  & - xa(26,ielem) * y(i5)
1043  & - xa(27,ielem) * y(i6)
1044 !
1045  w4(ielem) =
1046  & - xa(3,ielem) * y(i1)
1047  & - xa(7,ielem) * y(i2)
1048  & - xa(10,ielem) * y(i3)
1049  & - xa(28,ielem) * y(i5)
1050  & - xa(29,ielem) * y(i6)
1051 !
1052  w5(ielem) =
1053  & - xa(4,ielem) * y(i1)
1054  & - xa(8,ielem) * y(i2)
1055  & - xa(11,ielem) * y(i3)
1056  & - xa(13,ielem) * y(i4)
1057  & - xa(30,ielem) * y(i6)
1058 !
1059  w6(ielem) =
1060  & - xa(5,ielem) * y(i1)
1061  & - xa(9,ielem) * y(i2)
1062  & - xa(12,ielem) * y(i3)
1063  & - xa(14,ielem) * y(i4)
1064  & - xa(15,ielem) * y(i5)
1065 !
1066  ENDDO ! IELEM
1067 !
1068  ELSEIF(typext(1:1).EQ.'0') THEN
1069 !
1070  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
1071  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
1072  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
1073  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
1074  CALL ov ('X=C ', w5 , y , z , 0.d0 , nelem )
1075  CALL ov ('X=C ', w6 , y , z , 0.d0 , nelem )
1076 !
1077  ELSE
1078 !
1079  WRITE(lu,1001) typext
1080  CALL plante(1)
1081  stop
1082 !
1083  ENDIF
1084 !
1085 ! CONTRIBUTION OF THE DIAGONAL
1086 !
1087  IF(typdia(1:1).EQ.'Q') THEN
1088  CALL ov ('X=-YZ ', x , y , da , c , npoin )
1089  ELSEIF(typdia(1:1).EQ.'I') THEN
1090  CALL ov ('X=-Y ', x , y , z , c , npoin )
1091  ELSEIF(typdia(1:1).EQ.'0') THEN
1092  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
1093  ELSE
1094  WRITE(lu,2001) typdia
1095  CALL plante(1)
1096  stop
1097  ENDIF
1098 !
1099 !-----------------------------------------------------------------------
1100 !
1101  ELSEIF(op(1:8).EQ.'X=X+TAY ') THEN
1102 !
1103 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
1104 !
1105  IF(typext(1:1).EQ.'S') THEN
1106 !
1107  DO ielem = 1 , nelem
1108 !
1109  i1 = ikle1(ielem)
1110  i2 = ikle2(ielem)
1111  i3 = ikle3(ielem)
1112  i4 = ikle4(ielem)
1113  i5 = ikle5(ielem)
1114  i6 = ikle6(ielem)
1115 !
1116  w1(ielem) = w1(ielem)
1117  & + xa(1,ielem) * y(i2)
1118  & + xa(2,ielem) * y(i3)
1119  & + xa(3,ielem) * y(i4)
1120  & + xa(4,ielem) * y(i5)
1121  & + xa(5,ielem) * y(i6)
1122 !
1123  w2(ielem) = w2(ielem)
1124  & + xa(1,ielem) * y(i1)
1125  & + xa(6,ielem) * y(i3)
1126  & + xa(7,ielem) * y(i4)
1127  & + xa(8,ielem) * y(i5)
1128  & + xa(9,ielem) * y(i6)
1129 !
1130  w3(ielem) = w3(ielem)
1131  & + xa(2,ielem) * y(i1)
1132  & + xa(6,ielem) * y(i2)
1133  & + xa(10,ielem) * y(i4)
1134  & + xa(11,ielem) * y(i5)
1135  & + xa(12,ielem) * y(i6)
1136 !
1137  w4(ielem) = w4(ielem)
1138  & + xa(3,ielem) * y(i1)
1139  & + xa(7,ielem) * y(i2)
1140  & + xa(10,ielem) * y(i3)
1141  & + xa(13,ielem) * y(i5)
1142  & + xa(14,ielem) * y(i6)
1143 !
1144  w5(ielem) = w5(ielem)
1145  & + xa(4,ielem) * y(i1)
1146  & + xa(8,ielem) * y(i2)
1147  & + xa(11,ielem) * y(i3)
1148  & + xa(13,ielem) * y(i4)
1149  & + xa(15,ielem) * y(i6)
1150 !
1151  w6(ielem) = w6(ielem)
1152  & + xa(5,ielem) * y(i1)
1153  & + xa(9,ielem) * y(i2)
1154  & + xa(12,ielem) * y(i3)
1155  & + xa(14,ielem) * y(i4)
1156  & + xa(15,ielem) * y(i5)
1157 !
1158  ENDDO ! IELEM
1159 !
1160  ELSEIF(typext(1:1).EQ.'Q') THEN
1161 !
1162  DO ielem = 1 , nelem
1163 !
1164  i1 = ikle1(ielem)
1165  i2 = ikle2(ielem)
1166  i3 = ikle3(ielem)
1167  i4 = ikle4(ielem)
1168  i5 = ikle5(ielem)
1169  i6 = ikle6(ielem)
1170 !
1171  w1(ielem) = w1(ielem)
1172  & + xa(16,ielem) * y(i2)
1173  & + xa(17,ielem) * y(i3)
1174  & + xa(18,ielem) * y(i4)
1175  & + xa(19,ielem) * y(i5)
1176  & + xa(20,ielem) * y(i6)
1177 !
1178  w2(ielem) = w2(ielem)
1179  & + xa(1,ielem) * y(i1)
1180  & + xa(21,ielem) * y(i3)
1181  & + xa(22,ielem) * y(i4)
1182  & + xa(23,ielem) * y(i5)
1183  & + xa(24,ielem) * y(i6)
1184 !
1185  w3(ielem) = w3(ielem)
1186  & + xa(2,ielem) * y(i1)
1187  & + xa(6,ielem) * y(i2)
1188  & + xa(25,ielem) * y(i4)
1189  & + xa(26,ielem) * y(i5)
1190  & + xa(27,ielem) * y(i6)
1191 !
1192  w4(ielem) = w4(ielem)
1193  & + xa(3,ielem) * y(i1)
1194  & + xa(7,ielem) * y(i2)
1195  & + xa(10,ielem) * y(i3)
1196  & + xa(28,ielem) * y(i5)
1197  & + xa(29,ielem) * y(i6)
1198 !
1199  w5(ielem) = w5(ielem)
1200  & + xa(4,ielem) * y(i1)
1201  & + xa(8,ielem) * y(i2)
1202  & + xa(11,ielem) * y(i3)
1203  & + xa(13,ielem) * y(i4)
1204  & + xa(30,ielem) * y(i6)
1205 !
1206  w6(ielem) = w6(ielem)
1207  & + xa(5,ielem) * y(i1)
1208  & + xa(9,ielem) * y(i2)
1209  & + xa(12,ielem) * y(i3)
1210  & + xa(14,ielem) * y(i4)
1211  & + xa(15,ielem) * y(i5)
1212 !
1213  ENDDO ! IELEM
1214 !
1215  ELSEIF(typext(1:1).NE.'0') THEN
1216 !
1217  WRITE(lu,1001) typext
1218  CALL plante(1)
1219  stop
1220 !
1221  ENDIF
1222 !
1223 ! CONTRIBUTION OF THE DIAGONAL
1224 !
1225  IF(typdia(1:1).EQ.'Q') THEN
1226  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
1227  ELSEIF(typdia(1:1).EQ.'I') THEN
1228  CALL ov ('X=X+Y ', x , y , z , c , npoin )
1229  ELSEIF(typdia(1:1).NE.'0') THEN
1230  WRITE(lu,2001) typdia
1231  CALL plante(1)
1232  stop
1233  ENDIF
1234 !
1235 !-----------------------------------------------------------------------
1236 !
1237  ELSEIF(op(1:8).EQ.'X=X-TAY ') THEN
1238 !
1239 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
1240 !
1241  IF(typext(1:1).EQ.'S') THEN
1242 !
1243  DO ielem = 1 , nelem
1244 !
1245  i1 = ikle1(ielem)
1246  i2 = ikle2(ielem)
1247  i3 = ikle3(ielem)
1248  i4 = ikle4(ielem)
1249  i5 = ikle5(ielem)
1250  i6 = ikle6(ielem)
1251 !
1252  w1(ielem) = w1(ielem)
1253  & - xa(1,ielem) * y(i2)
1254  & - xa(2,ielem) * y(i3)
1255  & - xa(3,ielem) * y(i4)
1256  & - xa(4,ielem) * y(i5)
1257  & - xa(5,ielem) * y(i6)
1258 !
1259  w2(ielem) = w2(ielem)
1260  & - xa(1,ielem) * y(i1)
1261  & - xa(6,ielem) * y(i3)
1262  & - xa(7,ielem) * y(i4)
1263  & - xa(8,ielem) * y(i5)
1264  & - xa(9,ielem) * y(i6)
1265 !
1266  w3(ielem) = w3(ielem)
1267  & - xa(2,ielem) * y(i1)
1268  & - xa(6,ielem) * y(i2)
1269  & - xa(10,ielem) * y(i4)
1270  & - xa(11,ielem) * y(i5)
1271  & - xa(12,ielem) * y(i6)
1272 !
1273  w4(ielem) = w4(ielem)
1274  & - xa(3,ielem) * y(i1)
1275  & - xa(7,ielem) * y(i2)
1276  & - xa(10,ielem) * y(i3)
1277  & - xa(13,ielem) * y(i5)
1278  & - xa(14,ielem) * y(i6)
1279 !
1280  w5(ielem) = w5(ielem)
1281  & - xa(4,ielem) * y(i1)
1282  & - xa(8,ielem) * y(i2)
1283  & - xa(11,ielem) * y(i3)
1284  & - xa(13,ielem) * y(i4)
1285  & - xa(15,ielem) * y(i6)
1286 !
1287  w6(ielem) = w6(ielem)
1288  & - xa(5,ielem) * y(i1)
1289  & - xa(9,ielem) * y(i2)
1290  & - xa(12,ielem) * y(i3)
1291  & - xa(14,ielem) * y(i4)
1292  & - xa(15,ielem) * y(i5)
1293 !
1294  ENDDO ! IELEM
1295 !
1296  ELSEIF(typext(1:1).EQ.'Q') THEN
1297 !
1298  DO ielem = 1 , nelem
1299 !
1300  i1 = ikle1(ielem)
1301  i2 = ikle2(ielem)
1302  i3 = ikle3(ielem)
1303  i4 = ikle4(ielem)
1304  i5 = ikle5(ielem)
1305  i6 = ikle6(ielem)
1306 !
1307  w1(ielem) = w1(ielem)
1308  & - xa(16,ielem) * y(i2)
1309  & - xa(17,ielem) * y(i3)
1310  & - xa(18,ielem) * y(i4)
1311  & - xa(19,ielem) * y(i5)
1312  & - xa(20,ielem) * y(i6)
1313 !
1314  w2(ielem) = w2(ielem)
1315  & - xa(1,ielem) * y(i1)
1316  & - xa(21,ielem) * y(i3)
1317  & - xa(22,ielem) * y(i4)
1318  & - xa(23,ielem) * y(i5)
1319  & - xa(24,ielem) * y(i6)
1320 !
1321  w3(ielem) = w3(ielem)
1322  & - xa(2,ielem) * y(i1)
1323  & - xa(6,ielem) * y(i2)
1324  & - xa(25,ielem) * y(i4)
1325  & - xa(26,ielem) * y(i5)
1326  & - xa(27,ielem) * y(i6)
1327 !
1328  w4(ielem) = w4(ielem)
1329  & - xa(3,ielem) * y(i1)
1330  & - xa(7,ielem) * y(i2)
1331  & - xa(10,ielem) * y(i3)
1332  & - xa(28,ielem) * y(i5)
1333  & - xa(29,ielem) * y(i6)
1334 !
1335  w5(ielem) = w5(ielem)
1336  & - xa(4,ielem) * y(i1)
1337  & - xa(8,ielem) * y(i2)
1338  & - xa(11,ielem) * y(i3)
1339  & - xa(13,ielem) * y(i4)
1340  & - xa(30,ielem) * y(i6)
1341 !
1342  w6(ielem) = w6(ielem)
1343  & - xa(5,ielem) * y(i1)
1344  & - xa(9,ielem) * y(i2)
1345  & - xa(12,ielem) * y(i3)
1346  & - xa(14,ielem) * y(i4)
1347  & - xa(15,ielem) * y(i5)
1348 !
1349  ENDDO ! IELEM
1350 !
1351  ELSEIF(typext(1:1).NE.'0') THEN
1352 !
1353  WRITE(lu,1001) typext
1354  CALL plante(1)
1355  stop
1356 !
1357  ENDIF
1358 !
1359 ! CONTRIBUTION OF THE DIAGONAL
1360 !
1361  IF(typdia(1:1).EQ.'Q') THEN
1362  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
1363  ELSEIF(typdia(1:1).EQ.'I') THEN
1364  CALL ov ('X=X-Y ', x , y , z , c , npoin )
1365  ELSEIF(typdia(1:1).NE.'0') THEN
1366  WRITE(lu,2001) typdia
1367  CALL plante(1)
1368  stop
1369  ENDIF
1370 !
1371 !-----------------------------------------------------------------------
1372 !
1373  ELSEIF(op(1:8).EQ.'X=X+CTAY') THEN
1374 !
1375 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
1376 !
1377  IF(typext(1:1).EQ.'S') THEN
1378 !
1379  DO ielem = 1 , nelem
1380 !
1381  i1 = ikle1(ielem)
1382  i2 = ikle2(ielem)
1383  i3 = ikle3(ielem)
1384  i4 = ikle4(ielem)
1385  i5 = ikle5(ielem)
1386  i6 = ikle6(ielem)
1387 !
1388  w1(ielem) = w1(ielem) + c * (
1389  & + xa(1,ielem) * y(i2)
1390  & + xa(2,ielem) * y(i3)
1391  & + xa(3,ielem) * y(i4)
1392  & + xa(4,ielem) * y(i5)
1393  & + xa(5,ielem) * y(i6) )
1394 !
1395  w2(ielem) = w2(ielem) + c * (
1396  & + xa(1,ielem) * y(i1)
1397  & + xa(6,ielem) * y(i3)
1398  & + xa(7,ielem) * y(i4)
1399  & + xa(8,ielem) * y(i5)
1400  & + xa(9,ielem) * y(i6) )
1401 !
1402  w3(ielem) = w3(ielem) + c * (
1403  & + xa(2,ielem) * y(i1)
1404  & + xa(6,ielem) * y(i2)
1405  & + xa(10,ielem) * y(i4)
1406  & + xa(11,ielem) * y(i5)
1407  & + xa(12,ielem)* y(i6) )
1408 !
1409  w4(ielem) = w4(ielem) + c * (
1410  & + xa(3,ielem) * y(i1)
1411  & + xa(7,ielem) * y(i2)
1412  & + xa(10,ielem) * y(i3)
1413  & + xa(13,ielem) * y(i5)
1414  & + xa(14,ielem) * y(i6) )
1415 !
1416  w5(ielem) = w5(ielem) + c * (
1417  & + xa(4,ielem) * y(i1)
1418  & + xa(8,ielem) * y(i2)
1419  & + xa(11,ielem) * y(i3)
1420  & + xa(13,ielem) * y(i4)
1421  & + xa(15,ielem) * y(i6) )
1422 !
1423  w6(ielem) = w6(ielem) + c * (
1424  & + xa(5,ielem) * y(i1)
1425  & + xa(9,ielem) * y(i2)
1426  & + xa(12,ielem) * y(i3)
1427  & + xa(14,ielem) * y(i4)
1428  & + xa(15,ielem) * y(i5) )
1429 !
1430  ENDDO ! IELEM
1431 !
1432  ELSEIF(typext(1:1).EQ.'Q') THEN
1433 !
1434  DO ielem = 1 , nelem
1435 !
1436  i1 = ikle1(ielem)
1437  i2 = ikle2(ielem)
1438  i3 = ikle3(ielem)
1439  i4 = ikle4(ielem)
1440  i5 = ikle5(ielem)
1441  i6 = ikle6(ielem)
1442 !
1443  w1(ielem) = w1(ielem) + c * (
1444  & + xa(16,ielem) * y(i2)
1445  & + xa(17,ielem) * y(i3)
1446  & + xa(18,ielem) * y(i4)
1447  & + xa(19,ielem) * y(i5)
1448  & + xa(20,ielem) * y(i6) )
1449 !
1450  w2(ielem) = w2(ielem) + c * (
1451  & + xa(1,ielem) * y(i1)
1452  & + xa(21,ielem) * y(i3)
1453  & + xa(22,ielem) * y(i4)
1454  & + xa(23,ielem) * y(i5)
1455  & + xa(24,ielem) * y(i6) )
1456 !
1457  w3(ielem) = w3(ielem) + c * (
1458  & + xa(2,ielem) * y(i1)
1459  & + xa(6,ielem) * y(i2)
1460  & + xa(25,ielem) * y(i4)
1461  & + xa(26,ielem) * y(i5)
1462  & + xa(27,ielem) * y(i6) )
1463 !
1464  w4(ielem) = w4(ielem) + c * (
1465  & + xa(3,ielem) * y(i1)
1466  & + xa(7,ielem) * y(i2)
1467  & + xa(10,ielem) * y(i3)
1468  & + xa(28,ielem) * y(i5)
1469  & + xa(29,ielem) * y(i6) )
1470 !
1471  w5(ielem) = w5(ielem) + c * (
1472  & + xa(4,ielem) * y(i1)
1473  & + xa(8,ielem) * y(i2)
1474  & + xa(11,ielem) * y(i3)
1475  & + xa(13,ielem) * y(i4)
1476  & + xa(30,ielem) * y(i6) )
1477 !
1478  w6(ielem) = w6(ielem) + c * (
1479  & + xa(5,ielem) * y(i1)
1480  & + xa(9,ielem) * y(i2)
1481  & + xa(12,ielem) * y(i3)
1482  & + xa(14,ielem) * y(i4)
1483  & + xa(15,ielem) * y(i5) )
1484 !
1485  ENDDO ! IELEM
1486 !
1487  ELSEIF(typext(1:1).NE.'0') THEN
1488 !
1489  WRITE(lu,1001) typext
1490  CALL plante(1)
1491  stop
1492 !
1493  ENDIF
1494 !
1495 ! CONTRIBUTION OF THE DIAGONAL
1496 !
1497  IF(typdia(1:1).EQ.'Q') THEN
1498  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
1499  ELSEIF(typdia(1:1).EQ.'I') THEN
1500  CALL ov ('X=X+CY ', x , y , z , c , npoin )
1501  ELSEIF(typdia(1:1).NE.'0') THEN
1502  WRITE(lu,2001) typdia
1503  CALL plante(1)
1504  stop
1505  ENDIF
1506 !
1507 !-----------------------------------------------------------------------
1508 !
1509  ELSE
1510 !
1511  WRITE(lu,3001) op
1512  CALL plante(1)
1513  stop
1514 !
1515 !-----------------------------------------------------------------------
1516 !
1517  ENDIF
1518 !
1519 !-----------------------------------------------------------------------
1520 !
1521  RETURN
1522 !
1523 1001 FORMAT(1x,'MV0606_2 (BIEF) : EXTRADIAG. TERMS UNKNOWN TYPE: ',a1)
1524 2001 FORMAT(1x,'MV0606_2 (BIEF) : DIAGONAL : UNKNOWN TYPE : ',a1)
1525 3001 FORMAT(1x,'MV0606_2 (BIEF) : UNKNOWN OPERATION : ',a8)
1526 !
1527  END
1528 
ov
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
mv0606_2
subroutine mv0606_2(OP, X, DA, TYPDIA, XA, TYPEXT, Y, C, IKLE1, IKLE2, IKLE3, IKLE4, IKLE5, IKLE6, NPOIN, NELEM, W1, W2, W3, W4, W5, W6, DIM1XA)
Definition: mv0606_2.f:9
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:18 for The TELEMAC-MASCARET system by doxygen 1.8.13