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