The TELEMAC-MASCARET system  trunk
mv0202.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE mv0202
3 ! *****************
4 !
5  &(op, x , da,typdia,xa12,xa21,typext, y,c,
6  & ikle1,ikle2,npoin,nelem,w1,w2)
7 !
8 !***********************************************************************
9 ! BIEF V6P1 21/08/2010
10 !***********************************************************************
11 !
12 !brief MATRIX VECTOR OPERATIONS FOR P1 SEGMENTS.
13 !code
14 !+ OP IS A STRING OF 8 CHARACTERS, WHICH INDICATES THE OPERATION TO BE
15 !+ PERFORMED ON VECTORS X,Y AND MATRIX M.
16 !+
17 !+ THE RESULT IS VECTOR X.
18 !+
19 !+ THESE OPERATIONS ARE DIFFERENT DEPENDING ON THE DIAGONAL TYPE
20 !+ AND THE TYPE OF EXTRADIAGONAL TERMS.
21 !+
22 !+ IMPLEMENTED OPERATIONS:
23 !+
24 !+ OP = 'X=AY ' : X = AY
25 !+ OP = 'X=-AY ' : X = -AY
26 !+ OP = 'X=X+AY ' : X = X + AY
27 !+ OP = 'X=X-AY ' : X = X - AY
28 !+ OP = 'X=X+CAY ' : X = X + C AY
29 !+ OP = 'X=TAY ' : X = TA Y (TRANSPOSE OF A)
30 !+ OP = 'X=-TAY ' : X = - TA Y (- TRANSPOSE OF A)
31 !+ OP = 'X=X+TAY ' : X = X + TA Y
32 !+ OP = 'X=X-TAY ' : X = X - TA Y
33 !+ OP = 'X=X+CTAY' : X = X + C TA Y
34 !
35 !history J-M HERVOUET (LNH) ; F LEPEINTRE (LNH)
36 !+ 05/02/91
37 !+ V5P1
38 !+
39 !
40 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
41 !+ 13/07/2010
42 !+ V6P0
43 !+ Translation of French comments within the FORTRAN sources into
44 !+ English comments
45 !
46 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
47 !+ 21/08/2010
48 !+ V6P0
49 !+ Creation of DOXYGEN tags for automated documentation and
50 !+ cross-referencing of the FORTRAN sources
51 !
52 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
53 !| C |-->| A GIVEN CONSTANT
54 !| DA |-->| MATRIX DIAGONAL
55 !| IKLE1 |-->| FIRST POINT OF SEGMENT
56 !| IKLE2 |-->| SECOND POINT OF SEGMENT
57 !| NELEM |-->| NUMBER OF ELEMENTS
58 !| NPOIN |-->| NUMBER OF POINTS
59 !| OP |-->| OPERATION TO BE DONE (SEE ABOVE)
60 !| TYPDIA |-->| TYPE OF DIAGONAL:
61 !| | | TYPDIA = 'Q' : ANY VALUE
62 !| | | TYPDIA = 'I' : IDENTITY
63 !| | | TYPDIA = '0' : ZERO
64 !| TYPEXT |-->| TYPE OF OFF-DIAGONAL TERMS
65 !| | | TYPEXT = 'Q' : ANY VALUE
66 !| | | TYPEXT = 'S' : SYMMETRIC
67 !| | | TYPEXT = '0' : ZERO
68 !| W1 |<->| RESULT IN NON ASSEMBLED FORM
69 !| W2 |<->| RESULT IN NON ASSEMBLED FORM
70 !| X |<->| RESULT IN ASSEMBLED FORM
71 !| XA12 |-->| OFF-DIAGONAL TERM OF MATRIX
72 !| XA21 |-->| OFF-DIAGONAL TERM OF MATRIX
73 !| Y |-->| VECTOR USED IN THE OPERATION
74 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
75 !
76  USE bief, ex_mv0202 => mv0202
77 !
78  USE declarations_special
79  IMPLICIT NONE
80 !
81 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
82 !
83  INTEGER, INTENT(IN) :: NELEM,NPOIN
84  INTEGER, INTENT(IN) :: IKLE1(*),IKLE2(*)
85 !
86  DOUBLE PRECISION, INTENT(INOUT) :: W1(*),W2(*)
87  DOUBLE PRECISION, INTENT(INOUT) :: X(*)
88  DOUBLE PRECISION, INTENT(IN) :: Y(*),DA(*)
89  DOUBLE PRECISION, INTENT(IN) :: XA12(*),XA21(*)
90  DOUBLE PRECISION, INTENT(IN) :: C
91 !
92  CHARACTER(LEN=*), INTENT(IN) :: OP,TYPDIA,TYPEXT
93 !
94 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
95 !
96  INTEGER IELEM
97  DOUBLE PRECISION Z(1)
98 !
99 !-----------------------------------------------------------------------
100 !
101  IF(op(1:8).EQ.'X=AY ') THEN
102 !
103 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
104 !
105  IF(typext(1:1).EQ.'S') THEN
106 !
107  DO ielem = 1 , nelem
108  w1(ielem) = xa12(ielem) * y(ikle2(ielem))
109  w2(ielem) = xa12(ielem) * y(ikle1(ielem))
110  ENDDO ! IELEM
111 !
112  ELSEIF(typext(1:1).EQ.'Q') THEN
113 !
114  DO ielem = 1 , nelem
115  w1(ielem) = xa12(ielem) * y(ikle2(ielem))
116  w2(ielem) = xa21(ielem) * y(ikle1(ielem))
117  ENDDO ! IELEM
118 !
119  ELSEIF(typext(1:1).EQ.'0') THEN
120 !
121  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
122  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
123 !
124  ELSE
125 !
126  WRITE(lu,1001) typext
127  CALL plante(1)
128  stop
129 !
130  ENDIF
131 !
132 ! CONTRIBUTION OF THE DIAGONAL:
133 !
134  IF(typdia(1:1).EQ.'Q') THEN
135  CALL ov ('X=YZ ', x , y , da , c , npoin )
136  ELSEIF(typdia(1:1).EQ.'I') THEN
137  CALL ov ('X=Y ', x , y , z , c , npoin )
138  ELSEIF(typdia(1:1).EQ.'0') THEN
139  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
140  ELSE
141  WRITE(lu,2001) typdia
142  CALL plante(1)
143  stop
144  ENDIF
145 !
146 !-----------------------------------------------------------------------
147 !
148  ELSEIF(op(1:8).EQ.'X=-AY ') THEN
149 !
150 ! CONTRIBUTION OF EXTRADIAGONAL TERMS:
151 !
152  IF(typext(1:1).EQ.'S') THEN
153 !
154  DO ielem = 1 , nelem
155  w1(ielem) = - xa12(ielem) * y(ikle2(ielem))
156  w2(ielem) = - xa12(ielem) * y(ikle1(ielem))
157  ENDDO ! IELEM
158 !
159  ELSEIF(typext(1:1).EQ.'Q') THEN
160 !
161  DO ielem = 1 , nelem
162  w1(ielem) = - xa12(ielem) * y(ikle2(ielem))
163  w2(ielem) = - xa21(ielem) * y(ikle1(ielem))
164  ENDDO ! IELEM
165 !
166  ELSEIF(typext(1:1).EQ.'0') THEN
167 !
168  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
169  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
170 !
171  ELSE
172 !
173  WRITE(lu,1001) typext
174  CALL plante(1)
175  stop
176 !
177  ENDIF
178 !
179 ! CONTRIBUTION OF THE DIAGONAL:
180 !
181  IF(typdia(1:1).EQ.'Q') THEN
182  CALL ov ('X=-YZ ', x , y , da , c , npoin )
183  ELSEIF(typdia(1:1).EQ.'I') THEN
184  CALL ov ('X=-Y ', x , y , z , c , npoin )
185  ELSEIF(typdia(1:1).EQ.'0') THEN
186  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
187  ELSE
188  WRITE(lu,2001) typdia
189  CALL plante(1)
190  stop
191  ENDIF
192 !
193 !-----------------------------------------------------------------------
194 !
195  ELSEIF(op(1:8).EQ.'X=X+AY ') THEN
196 !
197 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
198 !
199  IF(typext(1:1).EQ.'S') THEN
200 !
201  DO ielem = 1 , nelem
202  w1(ielem) = w1(ielem) + xa12(ielem) * y(ikle2(ielem))
203  w2(ielem) = w2(ielem) + xa12(ielem) * y(ikle1(ielem))
204  ENDDO ! IELEM
205 !
206  ELSEIF(typext(1:1).EQ.'Q') THEN
207 !
208  DO ielem = 1 , nelem
209  w1(ielem) = w1(ielem) + xa12(ielem) * y(ikle2(ielem))
210  w2(ielem) = w2(ielem) + xa21(ielem) * y(ikle1(ielem))
211  ENDDO ! IELEM
212 !
213  ELSEIF(typext(1:1).NE.'0') THEN
214 !
215  WRITE(lu,1001) typext
216  CALL plante(1)
217  stop
218 !
219  ENDIF
220 !
221 ! CONTRIBUTION OF THE DIAGONAL:
222 !
223  IF(typdia(1:1).EQ.'Q') THEN
224  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
225  ELSEIF(typdia(1:1).EQ.'I') THEN
226  CALL ov ('X=X+Y ', x , y , z , c , npoin )
227  ELSEIF(typdia(1:1).NE.'0') THEN
228  WRITE(lu,2001) typdia
229  CALL plante(1)
230  stop
231  ENDIF
232 !
233 !-----------------------------------------------------------------------
234 !
235  ELSEIF(op(1:8).EQ.'X=X-AY ') THEN
236 !
237 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
238 !
239  IF(typext(1:1).EQ.'S') THEN
240 !
241  DO ielem = 1 , nelem
242  w1(ielem) = w1(ielem) - xa12(ielem) * y(ikle2(ielem))
243  w2(ielem) = w2(ielem) - xa12(ielem) * y(ikle1(ielem))
244  ENDDO ! IELEM
245 !
246  ELSEIF(typext(1:1).EQ.'Q') THEN
247 !
248  DO ielem = 1 , nelem
249  w1(ielem) = w1(ielem) - xa12(ielem) * y(ikle2(ielem))
250  w2(ielem) = w2(ielem) - xa21(ielem) * y(ikle1(ielem))
251  ENDDO ! IELEM
252 !
253  ELSEIF(typext(1:1).NE.'0') THEN
254 !
255  WRITE(lu,1001) typext
256  CALL plante(1)
257  stop
258 !
259  ENDIF
260 !
261 ! CONTRIBUTION OF THE DIAGONAL:
262 !
263  IF(typdia(1:1).EQ.'Q') THEN
264  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
265  ELSEIF(typdia(1:1).EQ.'I') THEN
266  CALL ov ('X=X-Y ', x , y , z , c , npoin )
267  ELSEIF(typdia(1:1).NE.'0') THEN
268  WRITE(lu,2001) typdia
269  CALL plante(1)
270  stop
271  ENDIF
272 !
273 !-----------------------------------------------------------------------
274 !
275  ELSEIF(op(1:8).EQ.'X=X+CAY ') THEN
276 !
277 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
278 !
279  IF(typext(1:1).EQ.'S') THEN
280 !
281  DO ielem = 1 , nelem
282  w1(ielem)=w1(ielem) + c * (xa12(ielem) * y(ikle2(ielem)))
283  w2(ielem)=w2(ielem) + c * (xa12(ielem) * y(ikle1(ielem)))
284  ENDDO ! IELEM
285 !
286  ELSEIF(typext(1:1).EQ.'Q') THEN
287 !
288  DO ielem = 1 , nelem
289  w1(ielem)=w1(ielem) + c * (xa12(ielem) * y(ikle2(ielem)))
290  w2(ielem)=w2(ielem) + c * (xa21(ielem) * y(ikle1(ielem)))
291  ENDDO ! IELEM
292 !
293  ELSEIF(typext(1:1).NE.'0') THEN
294 !
295  WRITE(lu,1001) typext
296  CALL plante(1)
297  stop
298 !
299  ENDIF
300 !
301 ! CONTRIBUTION OF THE DIAGONAL:
302 !
303  IF(typdia(1:1).EQ.'Q') THEN
304  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
305  ELSEIF(typdia(1:1).EQ.'I') THEN
306  CALL ov ('X=X+CY ', x , y , z , c , npoin )
307  ELSEIF(typdia(1:1).NE.'0') THEN
308  WRITE(lu,2001) typdia
309  CALL plante(1)
310  stop
311  ENDIF
312 !
313 !-----------------------------------------------------------------------
314 !
315  ELSEIF(op(1:8).EQ.'X=TAY ') THEN
316 !
317 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
318 !
319  IF(typext(1:1).EQ.'S') THEN
320 !
321  DO ielem = 1 , nelem
322  w1(ielem) = xa12(ielem) * y(ikle2(ielem))
323  w2(ielem) = xa12(ielem) * y(ikle1(ielem))
324  ENDDO ! IELEM
325 !
326  ELSEIF(typext(1:1).EQ.'Q') THEN
327 !
328  DO ielem = 1 , nelem
329  w1(ielem) = + xa21(ielem) * y(ikle2(ielem))
330  w2(ielem) = + xa12(ielem) * y(ikle1(ielem))
331  ENDDO ! IELEM
332 !
333  ELSEIF(typext(1:1).EQ.'0') THEN
334 !
335  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
336  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
337 !
338  ELSE
339 !
340  WRITE(lu,1001) typext
341  CALL plante(1)
342  stop
343 !
344  ENDIF
345 !
346 ! CONTRIBUTION OF THE DIAGONAL
347 !
348  IF(typdia(1:1).EQ.'Q') THEN
349  CALL ov ('X=YZ ', x , y , da , c , npoin )
350  ELSEIF(typdia(1:1).EQ.'I') THEN
351  CALL ov ('X=Y ', x , y , z , c , npoin )
352  ELSEIF(typdia(1:1).EQ.'0') THEN
353  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
354  ELSE
355  WRITE(lu,2001) typdia
356  CALL plante(1)
357  stop
358  ENDIF
359 !
360 !-----------------------------------------------------------------------
361 !
362  ELSEIF(op(1:8).EQ.'X=-TAY ') THEN
363 !
364 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
365 !
366  IF(typext(1:1).EQ.'S') THEN
367 !
368  DO ielem = 1 , nelem
369  w1(ielem) = - xa12(ielem) * y(ikle2(ielem))
370  w2(ielem) = - xa12(ielem) * y(ikle1(ielem))
371  ENDDO ! IELEM
372 !
373  ELSEIF(typext(1:1).EQ.'Q') THEN
374 !
375  DO ielem = 1 , nelem
376  w1(ielem) = - xa21(ielem) * y(ikle2(ielem))
377  w2(ielem) = - xa12(ielem) * y(ikle1(ielem))
378  ENDDO ! IELEM
379 !
380  ELSEIF(typext(1:1).EQ.'0') THEN
381 !
382  CALL ov ('X=C ', w1 , y , z , 0.d0 , nelem )
383  CALL ov ('X=C ', w2 , y , z , 0.d0 , nelem )
384 !
385  ELSE
386 !
387  WRITE(lu,1001) typext
388  CALL plante(1)
389  stop
390 !
391  ENDIF
392 !
393 ! CONTRIBUTION OF THE DIAGONAL
394 !
395  IF(typdia(1:1).EQ.'Q') THEN
396  CALL ov ('X=-YZ ', x , y , da , c , npoin )
397  ELSEIF(typdia(1:1).EQ.'I') THEN
398  CALL ov ('X=-Y ', x , y , z , c , npoin )
399  ELSEIF(typdia(1:1).EQ.'0') THEN
400  CALL ov ('X=C ', x , y , da , 0.d0 , npoin )
401  ELSE
402  WRITE(lu,2001) typdia
403  CALL plante(1)
404  stop
405  ENDIF
406 !
407 !-----------------------------------------------------------------------
408 !
409  ELSEIF(op(1:8).EQ.'X=X+TAY ') THEN
410 !
411 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
412 !
413  IF(typext(1:1).EQ.'S') THEN
414 !
415  DO ielem = 1 , nelem
416  w1(ielem) = w1(ielem) + xa12(ielem) * y(ikle2(ielem))
417  w2(ielem) = w2(ielem) + xa12(ielem) * y(ikle1(ielem))
418  ENDDO ! IELEM
419 !
420  ELSEIF(typext(1:1).EQ.'Q') THEN
421 !
422  DO ielem = 1 , nelem
423  w1(ielem) = w1(ielem) + xa21(ielem) * y(ikle2(ielem))
424  w2(ielem) = w2(ielem) + xa12(ielem) * y(ikle1(ielem))
425  ENDDO ! IELEM
426 !
427  ELSEIF(typext(1:1).NE.'0') THEN
428 !
429  WRITE(lu,1001) typext
430  CALL plante(1)
431  stop
432 !
433  ENDIF
434 !
435 ! CONTRIBUTION OF THE DIAGONAL
436 !
437  IF(typdia(1:1).EQ.'Q') THEN
438  CALL ov ('X=X+YZ ', x , y , da , c , npoin )
439  ELSEIF(typdia(1:1).EQ.'I') THEN
440  CALL ov ('X=X+Y ', x , y , z , c , npoin )
441  ELSEIF(typdia(1:1).NE.'0') THEN
442  WRITE(lu,2001) typdia
443  CALL plante(1)
444  stop
445  ENDIF
446 !
447 !-----------------------------------------------------------------------
448 !
449  ELSEIF(op(1:8).EQ.'X=X-TAY ') THEN
450 !
451 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
452 !
453  IF(typext(1:1).EQ.'S') THEN
454 !
455  DO ielem = 1 , nelem
456  w1(ielem) = w1(ielem) - xa12(ielem) * y(ikle2(ielem))
457  w2(ielem) = w2(ielem) - xa12(ielem) * y(ikle1(ielem))
458  ENDDO ! IELEM
459 !
460  ELSEIF(typext(1:1).EQ.'Q') THEN
461 !
462  DO ielem = 1 , nelem
463  w1(ielem) = w1(ielem) - xa21(ielem) * y(ikle2(ielem))
464  w2(ielem) = w2(ielem) - xa12(ielem) * y(ikle1(ielem))
465  ENDDO ! IELEM
466 !
467  ELSEIF(typext(1:1).NE.'0') THEN
468 !
469  WRITE(lu,1001) typext
470  CALL plante(1)
471  stop
472 !
473  ENDIF
474 !
475 ! CONTRIBUTION OF THE DIAGONAL
476 !
477  IF(typdia(1:1).EQ.'Q') THEN
478  CALL ov ('X=X-YZ ', x , y , da , c , npoin )
479  ELSEIF(typdia(1:1).EQ.'I') THEN
480  CALL ov ('X=X-Y ', x , y , z , c , npoin )
481  ELSEIF(typdia(1:1).NE.'0') THEN
482  WRITE(lu,2001) typdia
483  CALL plante(1)
484  stop
485  ENDIF
486 !
487 !-----------------------------------------------------------------------
488 !
489  ELSEIF(op(1:8).EQ.'X=X+CTAY') THEN
490 !
491 ! CONTRIBUTION OF EXTRADIAGONAL TERMS
492 !
493  IF(typext(1:1).EQ.'S') THEN
494 !
495  DO ielem = 1 , nelem
496  w1(ielem) = w1(ielem) + c*(xa12(ielem) * y(ikle2(ielem)))
497  w2(ielem) = w2(ielem) + c*(xa12(ielem) * y(ikle1(ielem)))
498  ENDDO ! IELEM
499 !
500  ELSEIF(typext(1:1).EQ.'Q') THEN
501 !
502  DO ielem = 1 , nelem
503  w1(ielem) = w1(ielem) + c*(xa21(ielem) * y(ikle2(ielem)))
504  w2(ielem) = w2(ielem) + c*(xa12(ielem) * y(ikle1(ielem)))
505  ENDDO ! IELEM
506 !
507  ELSEIF(typext(1:1).NE.'0') THEN
508 !
509  WRITE(lu,1001) typext
510  CALL plante(1)
511  stop
512 !
513  ENDIF
514 !
515 ! CONTRIBUTION OF THE DIAGONAL
516 !
517  IF(typdia(1:1).EQ.'Q') THEN
518  CALL ov ('X=X+CYZ ', x , y , da , c , npoin )
519  ELSEIF(typdia(1:1).EQ.'I') THEN
520  CALL ov ('X=X+CY ', x , y , z , c , npoin )
521  ELSEIF(typdia(1:1).NE.'0') THEN
522  WRITE(lu,2001) typdia
523  CALL plante(1)
524  stop
525  ENDIF
526 !
527 !-----------------------------------------------------------------------
528 !
529  ELSE
530 !
531  WRITE(lu,3001) op
532  CALL plante(1)
533  stop
534 !
535 !-----------------------------------------------------------------------
536 !
537  ENDIF
538 !
539 !-----------------------------------------------------------------------
540 !
541  RETURN
542 !
543 1001 FORMAT(1x,'MV0202 (BIEF) : EXTRADIAG. TERMS UNKNOWN TYPE : ',a1)
544 2001 FORMAT(1x,'MV0202 (BIEF) : DIAGONAL : UNKNOWN TYPE : ',a1)
545 3001 FORMAT(1x,'MV0202 (BIEF) : UNKNOWN OPERATION : ',a8)
546 !
547  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
mv0202
subroutine mv0202(OP, X, DA, TYPDIA, XA12, XA21, TYPEXT, Y, C, IKLE1, IKLE2, NPOIN, NELEM, W1, W2)
Definition: mv0202.f:8
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:16 for The TELEMAC-MASCARET system by doxygen 1.8.13