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