The TELEMAC-MASCARET system  trunk
mv0404_2.f
Go to the documentation of this file.
1 ! *******************
2  SUBROUTINE mv0404_2
3 ! *******************
4 !
5  &(op, x , da,typdia,xa,typext, y,c,ikle1,ikle2,ikle3,ikle4,
6  & npoin,nelem,w1,w2,w3,w4,dim1xa)
7 !
8 !***********************************************************************
9 ! BIEF V7P2
10 !***********************************************************************
11 !
12 !brief MATRIX VECTOR OPERATIONS FOR Q1 QUADRILATERALS.
13 !
14 !warning This is inspired from MV0404, but the dimensions of XA are
15 ! swapped.
16 !
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=CAY ' : X = CAY
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 !| IKLE1 |-->| FIRST POINTS OF ELEMENTS
49 !| IKLE2 |-->| SECOND POINTS OF ELEMENTS
50 !| IKLE3 |-->| THIRD POINTS OF ELEMENTS
51 !| IKLE4 |-->| FOURTH POINTS OF ELEMENTS
52 !| NELEM |-->| NUMBER OF ELEMENTS
53 !| NPOIN |-->| NUMBER OF LINEAR POINTS
54 !| OP |-->| OPERATION TO BE DONE (SEE ABOVE)
55 !| TYPDIA |-->| TYPE OF DIAGONAL:
56 !| | | TYPDIA = 'Q' : ANY VALUE
57 !| | | TYPDIA = 'I' : IDENTITY
58 !| | | TYPDIA = '0' : ZERO
59 !| TYPEXT |-->| TYPE OF OFF-DIAGONAL TERMS
60 !| | | TYPEXT = 'Q' : ANY VALUE
61 !| | | TYPEXT = 'S' : SYMMETRIC
62 !| | | TYPEXT = '0' : ZERO
63 !| W1 |<->| RESULT IN NON ASSEMBLED FORM
64 !| W2 |<->| RESULT IN NON ASSEMBLED FORM
65 !| W3 |<->| RESULT IN NON ASSEMBLED FORM
66 !| W4 |<->| RESULT IN NON ASSEMBLED FORM
67 !| X |<->| RESULT IN ASSEMBLED FORM
68 !| XA13 |-->| OFF-DIAGONAL TERM OF MATRIX
69 !| XA14 |-->| OFF-DIAGONAL TERM OF MATRIX
70 !| XA21 |-->| OFF-DIAGONAL TERM OF MATRIX
71 !| XA23 |-->| OFF-DIAGONAL TERM OF MATRIX
72 !| XA24 |-->| OFF-DIAGONAL TERM OF MATRIX
73 !| XA31 |-->| OFF-DIAGONAL TERM OF MATRIX
74 !| XA32 |-->| OFF-DIAGONAL TERM OF MATRIX
75 !| XA34 |-->| OFF-DIAGONAL TERM OF MATRIX
76 !| XA41 |-->| OFF-DIAGONAL TERM OF MATRIX
77 !| XA42 |-->| OFF-DIAGONAL TERM OF MATRIX
78 !| XA43 |-->| OFF-DIAGONAL TERM OF MATRIX
79 !| Y |-->| VECTOR USED IN THE OPERATION
80 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
81 !
82  USE bief, ex_mv0404_2 => mv0404_2
83  USE declarations_special
84 !
85  IMPLICIT NONE
86 !
87 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
88 !
89  INTEGER, INTENT(IN) :: NELEM,NPOIN,DIM1XA
90 !
91  INTEGER, INTENT(IN) :: IKLE1(*),IKLE2(*),IKLE3(*),IKLE4(*)
92 !
93  DOUBLE PRECISION, INTENT(INOUT) :: W1(*),W2(*),W3(*),W4(*)
94  DOUBLE PRECISION, INTENT(IN) :: Y(*),DA(*)
95  DOUBLE PRECISION, INTENT(INOUT) :: X(*)
96  DOUBLE PRECISION, INTENT(IN) :: XA(dim1xa,*)
97  DOUBLE PRECISION, INTENT(IN) :: C
98 !
99  CHARACTER(LEN=8), INTENT(IN) :: OP
100  CHARACTER(LEN=1), INTENT(IN) :: TYPDIA,TYPEXT
101 !
102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
103 !
104  INTEGER IELEM
105  DOUBLE PRECISION Z(1)
106 !
107 !-----------------------------------------------------------------------
108 !
109  IF(op(1:8).EQ.'X=AY ') THEN
110 !
111 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
112 !
113  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
114 !
115  DO ielem = 1 , nelem
116  w1(ielem) = xa(1,ielem) * y(ikle2(ielem))
117  & + xa(2,ielem) * y(ikle3(ielem))
118  & + xa(3,ielem) * y(ikle4(ielem))
119  w2(ielem) = xa(7,ielem) * y(ikle1(ielem))
120  & + xa(4,ielem) * y(ikle3(ielem))
121  & + xa(5,ielem) * y(ikle4(ielem))
122  w3(ielem) = xa(8,ielem) * y(ikle1(ielem))
123  & + xa(10,ielem) * y(ikle2(ielem))
124  & + xa(6,ielem) * y(ikle4(ielem))
125  w4(ielem) = xa(9,ielem) * y(ikle1(ielem))
126  & + xa(11,ielem) * y(ikle2(ielem))
127  & + xa(12,ielem) * y(ikle3(ielem))
128  ENDDO
129 !
130  ELSEIF(typext(1:1).EQ.'0') THEN
131 !
132  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
133  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
134  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
135  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
136 !
137  ELSE
138 !
139  WRITE(lu,1001) typext
140  CALL plante(1)
141  stop
142 !
143  ENDIF
144 !
145 ! CONTRIBUTION OF THE DIAGONAL:
146 !
147  IF(typdia(1:1).EQ.'Q') THEN
148  CALL ov ('X=YZ ', x , y , da , c , npoin )
149  ELSEIF(typdia(1:1).EQ.'I') THEN
150  CALL ov ('X=Y ', x , y , z , c , npoin )
151  ELSEIF(typdia(1:1).EQ.'0') THEN
152  CALL ov ('X=C ', x , y , z , 0.d0 , npoin )
153  ELSE
154  WRITE(lu,2001) typdia
155  CALL plante(1)
156  stop
157  ENDIF
158 !
159 !-----------------------------------------------------------------------
160 !
161  ELSEIF(op(1:8).EQ.'X=CAY ') THEN
162 !
163 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
164 !
165  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
166 !
167  DO ielem = 1 , nelem
168  w1(ielem) = c * ( xa(1,ielem) * y(ikle2(ielem))
169  & + xa(2,ielem) * y(ikle3(ielem))
170  & + xa(3,ielem) * y(ikle4(ielem)) )
171  w2(ielem) = c * ( xa(7,ielem) * y(ikle1(ielem))
172  & + xa(4,ielem) * y(ikle3(ielem))
173  & + xa(5,ielem) * y(ikle4(ielem)) )
174  w3(ielem) = c * ( xa(8,ielem) * y(ikle1(ielem))
175  & + xa(10,ielem) * y(ikle2(ielem))
176  & + xa(6,ielem) * y(ikle4(ielem)) )
177  w4(ielem) = c * ( xa(9,ielem) * y(ikle1(ielem))
178  & + xa(11,ielem) * y(ikle2(ielem))
179  & + xa(12,ielem) * y(ikle3(ielem)) )
180  ENDDO ! IELEM
181 !
182  ELSEIF(typext(1:1).EQ.'0') THEN
183 !
184  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
185  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
186  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
187  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
188 !
189  ELSE
190 !
191  WRITE(lu,1001) typext
192  CALL plante(1)
193  stop
194 !
195  ENDIF
196 !
197 ! CONTRIBUTION OF THE DIAGONAL:
198 !
199  IF(typdia(1:1).EQ.'Q') THEN
200  CALL ov ('X=CYZ ', x , y , da , c , npoin )
201  ELSEIF(typdia(1:1).EQ.'I') THEN
202  CALL ov ('X=CY ', 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 !-----------------------------------------------------------------------
212 !
213  ELSEIF(op(1:8).EQ.'X=-AY ') THEN
214 !
215 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
216 !
217  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).NE.'S') THEN
218 !
219  DO ielem = 1 , nelem
220  w1(ielem) = - xa(1,ielem) * y(ikle2(ielem))
221  & - xa(2,ielem) * y(ikle3(ielem))
222  & - xa(3,ielem) * y(ikle4(ielem))
223  w2(ielem) = - xa(7,ielem) * y(ikle1(ielem))
224  & - xa(4,ielem) * y(ikle3(ielem))
225  & - xa(5,ielem) * y(ikle4(ielem))
226  w3(ielem) = - xa(8,ielem) * y(ikle1(ielem))
227  & - xa(10,ielem) * y(ikle2(ielem))
228  & - xa(6,ielem) * y(ikle4(ielem))
229  w4(ielem) = - xa(9,ielem) * y(ikle1(ielem))
230  & - xa(11,ielem) * y(ikle2(ielem))
231  & - xa(12,ielem) * y(ikle3(ielem))
232  ENDDO ! IELEM
233 !
234  ELSEIF(typext(1:1).EQ.'0') THEN
235 !
236  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
237  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
238  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
239  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
240 !
241  ELSE
242 !
243  WRITE(lu,1001) typext
244  CALL plante(1)
245  stop
246 !
247  ENDIF
248 !
249 ! CONTRIBUTION OF THE DIAGONAL:
250 !
251  IF(typdia(1:1).EQ.'Q') THEN
252  CALL ov ('X=-YZ ', x , y , da , c , npoin )
253  ELSEIF(typdia(1:1).EQ.'I') THEN
254  CALL ov ('X=-Y ', x , y , z , c , npoin )
255  ELSEIF(typdia(1:1).EQ.'0') THEN
256  CALL ov ('X=C ', x , y , z , 0.d0 , npoin )
257  ELSE
258  WRITE(lu,2001) typdia
259  CALL plante(1)
260  stop
261  ENDIF
262 !
263 !-----------------------------------------------------------------------
264 !
265  ELSEIF(op(1:8).EQ.'X=X+AY ') THEN
266 !
267 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
268 !
269  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
270 !
271  DO ielem = 1 , nelem
272  w1(ielem) = w1(ielem) + xa(1,ielem) * y(ikle2(ielem))
273  & + xa(2,ielem) * y(ikle3(ielem))
274  & + xa(3,ielem) * y(ikle4(ielem))
275  w2(ielem) = w2(ielem) + xa(7,ielem) * y(ikle1(ielem))
276  & + xa(4,ielem) * y(ikle3(ielem))
277  & + xa(5,ielem) * y(ikle4(ielem))
278  w3(ielem) = w3(ielem) + xa(8,ielem) * y(ikle1(ielem))
279  & + xa(10,ielem) * y(ikle2(ielem))
280  & + xa(6,ielem) * y(ikle4(ielem))
281  w4(ielem) = w4(ielem) + xa(9,ielem) * y(ikle1(ielem))
282  & + xa(11,ielem) * y(ikle2(ielem))
283  & + xa(12,ielem) * y(ikle3(ielem))
284  ENDDO ! IELEM
285 !
286  ELSEIF(typext(1:1).NE.'0') THEN
287 !
288  WRITE(lu,1001) typext
289  CALL plante(1)
290  stop
291 !
292  ENDIF
293 !
294 ! CONTRIBUTION OF THE DIAGONAL:
295 !
296  IF(typdia(1:1).EQ.'Q') THEN
297  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
298  ELSEIF(typdia(1:1).EQ.'I') THEN
299  CALL ov ('X=X+Y ', x , y , z , c , npoin )
300  ELSEIF(typdia(1:1).NE.'0') THEN
301  WRITE(lu,2001) typdia
302  CALL plante(1)
303  stop
304  ENDIF
305 !
306 !-----------------------------------------------------------------------
307 !
308  ELSEIF(op(1:8).EQ.'X=X-AY ') THEN
309 !
310 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
311 !
312  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
313 !
314  DO ielem = 1 , nelem
315  w1(ielem) = w1(ielem) - xa(1,ielem) * y(ikle2(ielem))
316  & - xa(2,ielem) * y(ikle3(ielem))
317  & - xa(3,ielem) * y(ikle4(ielem))
318  w2(ielem) = w2(ielem) - xa(7,ielem) * y(ikle1(ielem))
319  & - xa(4,ielem) * y(ikle3(ielem))
320  & - xa(5,ielem) * y(ikle4(ielem))
321  w3(ielem) = w3(ielem) - xa(8,ielem) * y(ikle1(ielem))
322  & - xa(10,ielem) * y(ikle2(ielem))
323  & - xa(6,ielem) * y(ikle4(ielem))
324  w4(ielem) = w4(ielem) - xa(9,ielem) * y(ikle1(ielem))
325  & - xa(11,ielem) * y(ikle2(ielem))
326  & - xa(12,ielem) * y(ikle3(ielem))
327  ENDDO ! IELEM
328 !
329  ELSEIF(typext(1:1).NE.'0') THEN
330 !
331  WRITE(lu,1001) typext
332  CALL plante(1)
333  stop
334 !
335  ENDIF
336 !
337 ! CONTRIBUTION OF THE DIAGONAL:
338 !
339  IF(typdia(1:1).EQ.'Q') THEN
340  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
341  ELSEIF(typdia(1:1).EQ.'I') THEN
342  CALL ov ('X=X-Y ', x , y , z , c , npoin )
343  ELSEIF(typdia(1:1).NE.'0') THEN
344  WRITE(lu,2001) typdia
345  CALL plante(1)
346  stop
347  ENDIF
348 !
349 !-----------------------------------------------------------------------
350 !
351  ELSEIF(op(1:8).EQ.'X=X+CAY ') THEN
352 !
353 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
354 !
355  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
356 !
357  DO ielem = 1 , nelem
358  w1(ielem) = w1(ielem)
359  & + c * ( xa(1,ielem) * y(ikle2(ielem))
360  & + xa(2,ielem) * y(ikle3(ielem))
361  & + xa(3,ielem) * y(ikle4(ielem)) )
362  w2(ielem) = w2(ielem)
363  & + c * ( xa(7,ielem) * y(ikle1(ielem))
364  & + xa(4,ielem) * y(ikle3(ielem))
365  & + xa(5,ielem) * y(ikle4(ielem)) )
366  w3(ielem) = w3(ielem)
367  & + c * ( xa(8,ielem) * y(ikle1(ielem))
368  & + xa(10,ielem) * y(ikle2(ielem))
369  & + xa(6,ielem) * y(ikle4(ielem)) )
370  w4(ielem) = w4(ielem)
371  & + c * ( xa(9,ielem) * y(ikle1(ielem))
372  & + xa(11,ielem) * y(ikle2(ielem))
373  & + xa(12,ielem) * y(ikle3(ielem)) )
374  ENDDO ! IELEM
375 !
376  ELSEIF(typext(1:1).NE.'0') THEN
377 !
378  WRITE(lu,1001) typext
379  CALL plante(1)
380  stop
381 !
382  ENDIF
383 !
384 ! CONTRIBUTION OF THE DIAGONAL:
385 !
386  IF(typdia(1:1).EQ.'Q') THEN
387  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
388  ELSEIF(typdia(1:1).EQ.'I') THEN
389  CALL ov ('X=X+CY ', x , y , z , c , npoin )
390  ELSEIF(typdia(1:1).NE.'0') THEN
391  WRITE(lu,2001) typdia
392  CALL plante(1)
393  stop
394  ENDIF
395 !
396 !-----------------------------------------------------------------------
397 !
398  ELSEIF(op(1:8).EQ.'X=TAY ') THEN
399 !
400 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
401 !
402  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
403 !
404  DO ielem = 1 , nelem
405  w1(ielem) = + xa(7,ielem) * y(ikle2(ielem))
406  & + xa(8,ielem) * y(ikle3(ielem))
407  & + xa(9,ielem) * y(ikle4(ielem))
408  w2(ielem) = + xa(1,ielem) * y(ikle1(ielem))
409  & + xa(10,ielem) * y(ikle3(ielem))
410  & + xa(11,ielem) * y(ikle4(ielem))
411  w3(ielem) = + xa(2,ielem) * y(ikle1(ielem))
412  & + xa(4,ielem) * y(ikle2(ielem))
413  & + xa(12,ielem) * y(ikle4(ielem))
414  w4(ielem) = + xa(3,ielem) * y(ikle1(ielem))
415  & + xa(5,ielem) * y(ikle2(ielem))
416  & + xa(6,ielem) * y(ikle3(ielem))
417  ENDDO ! IELEM
418 !
419  ELSEIF(typext(1:1).EQ.'0') THEN
420 !
421  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
422  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
423  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
424  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
425 !
426  ELSE
427 !
428  WRITE(lu,1001) typext
429  CALL plante(1)
430  stop
431 !
432  ENDIF
433 !
434 ! CONTRIBUTION OF THE DIAGONAL
435 !
436  IF(typdia(1:1).EQ.'Q') THEN
437  CALL ov ('X=YZ ', x , y , da , c , npoin )
438  ELSEIF(typdia(1:1).EQ.'I') THEN
439  CALL ov ('X=Y ', x , y , z , c , npoin )
440  ELSEIF(typdia(1:1).EQ.'0') THEN
441  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
442  ELSE
443  WRITE(lu,2001) typdia
444  CALL plante(1)
445  stop
446  ENDIF
447 !
448 !-----------------------------------------------------------------------
449 !
450  ELSEIF(op(1:8).EQ.'X=-TAY ') THEN
451 !
452 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
453 !
454  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
455 !
456  DO ielem = 1 , nelem
457  w1(ielem) = - xa(7,ielem) * y(ikle2(ielem))
458  & - xa(8,ielem) * y(ikle3(ielem))
459  & - xa(9,ielem) * y(ikle4(ielem))
460  w2(ielem) = - xa(1,ielem) * y(ikle1(ielem))
461  & - xa(10,ielem) * y(ikle3(ielem))
462  & - xa(11,ielem) * y(ikle4(ielem))
463  w3(ielem) = - xa(2,ielem) * y(ikle1(ielem))
464  & - xa(4,ielem) * y(ikle2(ielem))
465  & - xa(12,ielem) * y(ikle4(ielem))
466  w4(ielem) = - xa(3,ielem) * y(ikle1(ielem))
467  & - xa(5,ielem) * y(ikle2(ielem))
468  & - xa(6,ielem) * y(ikle3(ielem))
469  ENDDO ! IELEM
470 !
471  ELSEIF(typext(1:1).EQ.'0') THEN
472 !
473  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
474  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
475  CALL ov ('X=C ', w3 , y , z , 0.d0 , nelem )
476  CALL ov ('X=C ', w4 , y , z , 0.d0 , nelem )
477 !
478  ELSE
479 !
480  WRITE(lu,1001) typext
481  CALL plante(1)
482  stop
483 !
484  ENDIF
485 !
486 ! CONTRIBUTION OF THE DIAGONAL
487 !
488  IF(typdia(1:1).EQ.'Q') THEN
489  CALL ov ('X=-YZ ', x , y , da , c , npoin )
490  ELSEIF(typdia(1:1).EQ.'I') THEN
491  CALL ov ('X=-Y ', x , y , z , c , npoin )
492  ELSEIF(typdia(1:1).EQ.'0') THEN
493  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
494  ELSE
495  WRITE(lu,2001) typdia
496  CALL plante(1)
497  stop
498  ENDIF
499 !
500 !-----------------------------------------------------------------------
501 !
502  ELSEIF(op(1:8).EQ.'X=X+TAY ') THEN
503 !
504 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
505 !
506  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
507 !
508  DO ielem = 1 , nelem
509  w1(ielem) = w1(ielem) + xa(7,ielem) * y(ikle2(ielem))
510  & + xa(8,ielem) * y(ikle3(ielem))
511  & + xa(9,ielem) * y(ikle4(ielem))
512  w2(ielem) = w2(ielem) + xa(1,ielem) * y(ikle1(ielem))
513  & + xa(10,ielem) * y(ikle3(ielem))
514  & + xa(11,ielem) * y(ikle4(ielem))
515  w3(ielem) = w3(ielem) + xa(2,ielem) * y(ikle1(ielem))
516  & + xa(4,ielem) * y(ikle2(ielem))
517  & + xa(12,ielem) * y(ikle4(ielem))
518  w4(ielem) = w4(ielem) + xa(3,ielem) * y(ikle1(ielem))
519  & + xa(5,ielem) * y(ikle2(ielem))
520  & + xa(6,ielem) * y(ikle3(ielem))
521  ENDDO ! IELEM
522 !
523  ELSEIF(typext(1:1).NE.'0') THEN
524 !
525  WRITE(lu,1001) typext
526  CALL plante(1)
527  stop
528 !
529  ENDIF
530 !
531 ! CONTRIBUTION OF THE DIAGONAL
532 !
533  IF(typdia(1:1).EQ.'Q') THEN
534  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
535  ELSEIF(typdia(1:1).EQ.'I') THEN
536  CALL ov ('X=X+Y ', x , y , z , c , npoin )
537  ELSEIF(typdia(1:1).NE.'0') THEN
538  WRITE(lu,2001) typdia
539  CALL plante(1)
540  stop
541  ENDIF
542 !
543 !-----------------------------------------------------------------------
544 !
545  ELSEIF(op(1:8).EQ.'X=X-TAY ') THEN
546 !
547 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
548 !
549  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
550 !
551  DO ielem = 1 , nelem
552  w1(ielem) = w1(ielem) - xa(7,ielem) * y(ikle2(ielem))
553  & - xa(8,ielem) * y(ikle3(ielem))
554  & - xa(9,ielem) * y(ikle4(ielem))
555  w2(ielem) = w2(ielem) - xa(1,ielem) * y(ikle1(ielem))
556  & - xa(10,ielem) * y(ikle3(ielem))
557  & - xa(11,ielem) * y(ikle4(ielem))
558  w3(ielem) = w3(ielem) - xa(2,ielem) * y(ikle1(ielem))
559  & - xa(4,ielem) * y(ikle2(ielem))
560  & - xa(12,ielem) * y(ikle4(ielem))
561  w4(ielem) = w4(ielem) - xa(3,ielem) * y(ikle1(ielem))
562  & - xa(5,ielem) * y(ikle2(ielem))
563  & - xa(6,ielem) * y(ikle3(ielem))
564  ENDDO ! IELEM
565 !
566  ELSEIF(typext(1:1).NE.'0') THEN
567 !
568  WRITE(lu,1001) typext
569  CALL plante(1)
570  stop
571 !
572  ENDIF
573 !
574 ! CONTRIBUTION OF THE DIAGONAL
575 !
576  IF(typdia(1:1).EQ.'Q') THEN
577  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
578  ELSEIF(typdia(1:1).EQ.'I') THEN
579  CALL ov ('X=X-Y ', x , y , z , c , npoin )
580  ELSEIF(typdia(1:1).NE.'0') THEN
581  WRITE(lu,2001) typdia
582  CALL plante(1)
583  stop
584  ENDIF
585 !
586 !-----------------------------------------------------------------------
587 !
588  ELSEIF(op(1:8).EQ.'X=X+CTAY') THEN
589 !
590 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
591 !
592  IF(typext(1:1).EQ.'Q'.OR.typext(1:1).EQ.'S') THEN
593 !
594  DO ielem = 1 , nelem
595  w1(ielem) = w1(ielem)
596  & + c * ( + xa(7,ielem) * y(ikle2(ielem))
597  & + xa(8,ielem) * y(ikle3(ielem))
598  & + xa(9,ielem) * y(ikle4(ielem)) )
599  w2(ielem) = w2(ielem)
600  & + c * ( + xa(1,ielem) * y(ikle1(ielem))
601  & + xa(10,ielem) * y(ikle3(ielem))
602  & + xa(11,ielem) * y(ikle4(ielem)) )
603  w3(ielem) = w3(ielem)
604  & + c * ( + xa(2,ielem) * y(ikle1(ielem))
605  & + xa(4,ielem) * y(ikle2(ielem))
606  & + xa(12,ielem) * y(ikle4(ielem)) )
607  w4(ielem) = w4(ielem)
608  & + c * ( + xa(3,ielem) * y(ikle1(ielem))
609  & + xa(5,ielem) * y(ikle2(ielem))
610  & + xa(6,ielem) * y(ikle3(ielem)) )
611  ENDDO ! IELEM
612 !
613  ELSEIF(typext(1:1).NE.'0') THEN
614 !
615  WRITE(lu,1001) typext
616  CALL plante(1)
617  stop
618 !
619  ENDIF
620 !
621 ! CONTRIBUTION OF THE DIAGONAL
622 !
623  IF(typdia(1:1).EQ.'Q') THEN
624  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
625  ELSEIF(typdia(1:1).EQ.'I') THEN
626  CALL ov ('X=X+CY ', x , y , z , c , npoin )
627  ELSEIF(typdia(1:1).NE.'0') THEN
628  WRITE(lu,2001) typdia
629  CALL plante(1)
630  stop
631  ENDIF
632 !
633 !-----------------------------------------------------------------------
634 !
635  ELSE
636 !
637  WRITE(lu,3001) op
638  CALL plante(1)
639  stop
640 !
641 !-----------------------------------------------------------------------
642 !
643  ENDIF
644 !
645 !-----------------------------------------------------------------------
646 !
647  RETURN
648 !
649 1001 FORMAT(1x,'MV0404_2 (BIEF) : EXTRADIAG. TERMS UNKNOWN TYPE: ',a1)
650 2001 FORMAT(1x,'MV0404_2 (BIEF) : DIAGONAL : UNKNOWN TYPE : ',a1)
651 3001 FORMAT(1x,'MV0404_2 (BIEF) : UNKNOWN OPERATION : ',a8)
652 !
653 !-----------------------------------------------------------------------
654 !
655  END
656 
ov
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
declarations_special
Definition: declarations_special.F:3
mv0404_2
subroutine mv0404_2(OP, X, DA, TYPDIA, XA, TYPEXT, Y, C, IKLE1, IKLE2, IKLE3, IKLE4, NPOIN, NELEM, W1, W2, W3, W4, DIM1XA)
Definition: mv0404_2.f:8
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