The TELEMAC-MASCARET system  trunk
om4111.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE om4111
3 ! *****************
4 !
5  &(op , dm,typdim,xm,typexm, dn,typdin,xn,typexn,
6  & sizdn,szmdn,sizxn,netage, nelmax3d)
7 !
8 !***********************************************************************
9 ! BIEF V6P1 21/08/2010
10 !***********************************************************************
11 !
12 !brief OPERATIONS ON MATRICES.
13 !code
14 !+ M: P1 TRIANGLE
15 !+ N: BOUNDARY MATRIX
16 !+ D: DIAGONAL MATRIX
17 !+ C: CONSTANT
18 !+
19 !+ OP IS A STRING OF 8 CHARACTERS, WHICH INDICATES THE OPERATION TO BE
20 !+ PERFORMED ON MATRICES M AND N, D AND C.
21 !+
22 !+ THE RESULT IS MATRIX M.
23 !+
24 !+ OP = 'M=M+N ' : ADDS N TO M
25 !+ OP = 'M=M+TN ' : ADDS TRANSPOSE(N) TO M
26 !
27 !code
28 !+ CONVENTION FOR THE STORAGE OF EXTRA-DIAGONAL TERMS:
29 !+
30 !+ XM( ,1) ----> M(1,2)
31 !+ XM( ,2) ----> M(1,3)
32 !+ XM( ,3) ----> M(2,3)
33 !+ XM( ,4) ----> M(2,1)
34 !+ XM( ,5) ----> M(3,1)
35 !+ XM( ,6) ----> M(3,2)
36 !
37 !history J-M HERVOUET (LNHE)
38 !+ 06/12/94
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 !| DM |<->| DIAGONAL OF M
56 !| DN |-->| DIAGONAL OF N
57 !| NELMAX3D |-->| MAXIMUM NUMBER OF 3D ELEMENTS
58 !| NETAGE |-->| NUMBER OF PLANES - 1
59 !| OP |-->| OPERATION TO BE DONE (SEE ABOVE)
60 !| SIZDN |-->| SIZE OF DIAGONAL DN
61 !| SIZXN |-->| SIZE OF OFF-DIAGONAL TERMS XN
62 !| SZMDN |-->| MAXIMUM SIZE OF DIAGONAL DN
63 !| TYPDIM |<->| TYPE OF DIAGONAL OF M:
64 !| | | TYPDIM = 'Q' : ANY VALUE
65 !| | | TYPDIM = 'I' : IDENTITY
66 !| | | TYPDIM = '0' : ZERO
67 !| TYPDIN |<->| TYPE OF DIAGONAL OF N:
68 !| | | TYPDIN = 'Q' : ANY VALUE
69 !| | | TYPDIN = 'I' : IDENTITY
70 !| | | TYPDIN = '0' : ZERO
71 !| TYPEXM |-->| TYPE OF OFF-DIAGONAL TERMS OF M:
72 !| | | TYPEXM = 'Q' : ANY VALUE
73 !| | | TYPEXM = 'S' : SYMMETRIC
74 !| | | TYPEXM = '0' : ZERO
75 !| TYPEXN |-->| TYPE OF OFF-DIAGONAL TERMS OF N:
76 !| | | TYPEXN = 'Q' : ANY VALUE
77 !| | | TYPEXN = 'S' : SYMMETRIC
78 !| | | TYPEXN = '0' : ZERO
79 !| XM |-->| OFF-DIAGONAL TERMS OF M
80 !| XN |-->| OFF-DIAGONAL TERMS OF N
81 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
82 !
83  USE bief, ex_om4111 => om4111
84 !
85  USE declarations_special
86  IMPLICIT NONE
87 !
88 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
89 !
90  INTEGER, INTENT(IN) :: NETAGE,SIZDN,SZMDN,SIZXN
91  INTEGER, INTENT(IN) :: NELMAX3D
92  CHARACTER(LEN=8), INTENT(IN) :: OP
93  DOUBLE PRECISION, INTENT(IN) :: DN(*),XN(nelmax3d/netage,*)
94  DOUBLE PRECISION, INTENT(INOUT) :: DM(szmdn,*)
95  DOUBLE PRECISION, INTENT(INOUT) :: XM(nelmax3d/netage,netage,*)
96  CHARACTER(LEN=1), INTENT(INOUT) :: TYPDIM,TYPEXM,TYPDIN,TYPEXN
97 !
98 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
99 !
100  INTEGER K
101 !
102 !-----------------------------------------------------------------------
103 !
104  IF(op(1:8).EQ.'M=M+NF ') THEN
105 !
106  IF(typdim.EQ.'Q'.AND.typdin.EQ.'Q') THEN
107  CALL ov('X=X+Y ', x=dm, y=dn, dim1=sizdn)
108  ELSE
109  WRITE(lu,199) typdim(1:1),op(1:8),typdin(1:1)
110 199 FORMAT(1x,'OM4111 (BIEF) : TYPDIM = ',a1,' NOT IMPLEMENTED',
111  & /,1x,'FOR THE OPERATION : ',a8,' WITH TYPDIN = ',a1)
112  CALL plante(1)
113  stop
114  ENDIF
115 !
116  IF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'Q') THEN
117 !
118 ! CASE WHERE BOTH MATRICES ARE NONSYMMETRICAL
119 !
120  DO k = 1 , sizxn
121  xm(k,1, 1) = xm(k,1, 1) + xn(k,1)
122  xm(k,1, 2) = xm(k,1, 2) + xn(k,2)
123  xm(k,1, 6) = xm(k,1, 6) + xn(k,3)
124  xm(k,1,16) = xm(k,1,16) + xn(k,4)
125  xm(k,1,17) = xm(k,1,17) + xn(k,5)
126  xm(k,1,21) = xm(k,1,21) + xn(k,6)
127  ENDDO ! K
128 !
129  ELSEIF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'S') THEN
130 !
131 ! CASE WHERE M CAN BE ANYTHING AND N IS SYMMETRICAL
132 !
133  DO k = 1 , sizxn
134  xm(k,1, 1) = xm(k,1, 1) + xn(k,1)
135  xm(k,1, 2) = xm(k,1, 2) + xn(k,2)
136  xm(k,1, 6) = xm(k,1, 6) + xn(k,3)
137  xm(k,1,16) = xm(k,1,16) + xn(k,1)
138  xm(k,1,17) = xm(k,1,17) + xn(k,2)
139  xm(k,1,21) = xm(k,1,21) + xn(k,3)
140  ENDDO ! K
141 !
142  ELSEIF(typexm(1:1).EQ.'S'.AND.typexn(1:1).EQ.'S') THEN
143 !
144 ! CASE WHERE BOTH MATRICES ARE SYMMETRICAL
145 !
146  DO k = 1 , sizxn
147  xm(k,1, 1) = xm(k,1, 1) + xn(k,1)
148  xm(k,1, 2) = xm(k,1, 2) + xn(k,2)
149  xm(k,1, 6) = xm(k,1, 6) + xn(k,3)
150  ENDDO ! K
151 !
152  ELSE
153  WRITE(lu,99) typexm(1:1),op(1:8),typexn(1:1)
154 99 FORMAT(1x,'OM4111 (BIEF) : TYPEXM = ',a1,' DOES NOT GO',
155  & /,1x,'FOR THE OPERATION : ',a8,' WITH TYPEXN = ',a1)
156  CALL plante(1)
157  stop
158  ENDIF
159 !
160 !-----------------------------------------------------------------------
161 !
162  ELSEIF(op(1:8).EQ.'M=M+TNF ') THEN
163 !
164  CALL ov('X=X+Y ', x=dm, y=dn, dim1=sizdn)
165 !
166  IF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'Q') THEN
167 !
168 ! CASE WHERE BOTH MATRICES ARE NONSYMMETRICAL
169 !
170  DO k = 1 , sizxn
171  xm(k,1, 1) = xm(k,1, 1) + xn(k,4)
172  xm(k,1, 2) = xm(k,1, 2) + xn(k,5)
173  xm(k,1, 6) = xm(k,1, 6) + xn(k,6)
174  xm(k,1,16) = xm(k,1,16) + xn(k,1)
175  xm(k,1,17) = xm(k,1,17) + xn(k,2)
176  xm(k,1,21) = xm(k,1,21) + xn(k,3)
177  ENDDO ! K
178 !
179  ELSEIF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'S') THEN
180 !
181 ! CASE WHERE M CAN BE ANYTHING AND N IS SYMMETRICAL
182 !
183  DO k = 1 , sizxn
184  xm(k,1, 1) = xm(k,1, 1) + xn(k,1)
185  xm(k,1, 2) = xm(k,1, 2) + xn(k,2)
186  xm(k,1, 6) = xm(k,1, 6) + xn(k,3)
187  xm(k,1,16) = xm(k,1,16) + xn(k,1)
188  xm(k,1,17) = xm(k,1,17) + xn(k,2)
189  xm(k,1,21) = xm(k,1,21) + xn(k,3)
190  ENDDO ! K
191 !
192  ELSEIF(typexm(1:1).EQ.'S'.AND.typexn(1:1).EQ.'S') THEN
193 !
194 ! CASE WHERE BOTH MATRICES ARE SYMMETRICAL
195 !
196  DO k = 1 , sizxn
197  xm(k,1, 1) = xm(k,1, 1) + xn(k,1)
198  xm(k,1, 2) = xm(k,1, 2) + xn(k,2)
199  xm(k,1, 6) = xm(k,1, 6) + xn(k,3)
200  ENDDO ! K
201 !
202  ELSE
203  WRITE(lu,99) typexm(1:1),op(1:8),typexn(1:1)
204  CALL plante(1)
205  stop
206  ENDIF
207 !
208 !-----------------------------------------------------------------------
209 !
210  ELSEIF(op(1:8).EQ.'M=M+NS ') THEN
211 !
212  CALL ov('X=X+Y ', x=dm(1,netage+1), y=dn, dim1=sizdn)
213 !
214  IF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'Q') THEN
215 !
216 ! CASE WHERE BOTH MATRICES ARE NONSYMMETRICAL
217 !
218  DO k = 1 , sizxn
219  xm(k,netage,13) = xm(k,netage,13) + xn(k,1)
220  xm(k,netage,14) = xm(k,netage,14) + xn(k,2)
221  xm(k,netage,15) = xm(k,netage,15) + xn(k,3)
222  xm(k,netage,28) = xm(k,netage,28) + xn(k,4)
223  xm(k,netage,29) = xm(k,netage,29) + xn(k,5)
224  xm(k,netage,30) = xm(k,netage,30) + xn(k,6)
225  ENDDO ! K
226 !
227  ELSEIF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'S') THEN
228 !
229 ! CASE WHERE M CAN BE ANYTHING AND N IS SYMMETRICAL
230 !
231  DO k = 1 , sizxn
232  xm(k,netage,13) = xm(k,netage,13) + xn(k,1)
233  xm(k,netage,14) = xm(k,netage,14) + xn(k,2)
234  xm(k,netage,15) = xm(k,netage,15) + xn(k,3)
235  xm(k,netage,28) = xm(k,netage,28) + xn(k,1)
236  xm(k,netage,29) = xm(k,netage,29) + xn(k,2)
237  xm(k,netage,30) = xm(k,netage,30) + xn(k,3)
238  ENDDO ! K
239 !
240  ELSEIF(typexm(1:1).EQ.'S'.AND.typexn(1:1).EQ.'S') THEN
241 !
242 ! CASE WHERE BOTH MATRICES ARE SYMMETRICAL
243 !
244  DO k = 1 , sizxn
245  xm(k,netage,13) = xm(k,netage,13) + xn(k,1)
246  xm(k,netage,14) = xm(k,netage,14) + xn(k,2)
247  xm(k,netage,15) = xm(k,netage,15) + xn(k,3)
248  ENDDO ! K
249 !
250  ELSE
251  WRITE(lu,99) typexm(1:1),op(1:8),typexn(1:1)
252  CALL plante(1)
253  stop
254  ENDIF
255 !
256 !-----------------------------------------------------------------------
257 !
258  ELSEIF(op(1:8).EQ.'M=M+TNS ') THEN
259 !
260  CALL ov('X=X+Y ', x=dm(1,netage+1), y=dn, dim1=sizdn)
261 !
262  IF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'Q') THEN
263 !
264 ! CASE WHERE BOTH MATRICES ARE NONSYMMETRICAL
265 !
266  DO k = 1 , sizxn
267  xm(k,netage,13) = xm(k,netage,13) + xn(k,4)
268  xm(k,netage,14) = xm(k,netage,14) + xn(k,5)
269  xm(k,netage,15) = xm(k,netage,15) + xn(k,6)
270  xm(k,netage,28) = xm(k,netage,28) + xn(k,1)
271  xm(k,netage,29) = xm(k,netage,29) + xn(k,2)
272  xm(k,netage,30) = xm(k,netage,30) + xn(k,3)
273  ENDDO ! K
274 !
275  ELSEIF(typexm(1:1).EQ.'Q'.AND.typexn(1:1).EQ.'S') THEN
276 !
277 ! CASE WHERE M CAN BE ANYTHING AND N IS SYMMETRICAL
278 !
279  DO k = 1 , sizxn
280  xm(k,netage,13) = xm(k,netage,13) + xn(k,1)
281  xm(k,netage,14) = xm(k,netage,14) + xn(k,2)
282  xm(k,netage,15) = xm(k,netage,15) + xn(k,3)
283  xm(k,netage,28) = xm(k,netage,28) + xn(k,1)
284  xm(k,netage,29) = xm(k,netage,29) + xn(k,2)
285  xm(k,netage,30) = xm(k,netage,30) + xn(k,3)
286  ENDDO ! K
287 !
288  ELSEIF(typexm(1:1).EQ.'S'.AND.typexn(1:1).EQ.'S') THEN
289 !
290 ! CASE WHERE BOTH MATRICES ARE SYMMETRICAL
291 !
292  DO k = 1 , sizxn
293  xm(k,netage,13) = xm(k,netage,13) + xn(k,1)
294  xm(k,netage,14) = xm(k,netage,14) + xn(k,2)
295  xm(k,netage,15) = xm(k,netage,15) + xn(k,3)
296  ENDDO ! K
297 !
298  ELSE
299  WRITE(lu,99) typexm(1:1),op(1:8),typexn(1:1)
300  CALL plante(1)
301  stop
302  ENDIF
303 !
304 !-----------------------------------------------------------------------
305 !
306  ELSE
307 !
308  WRITE(lu,71) op
309 71 FORMAT(1x,'OM4111 (BIEF) : UNKNOWN OPERATION : ',a8)
310  CALL plante(1)
311  stop
312 !
313  ENDIF
314 !
315 !-----------------------------------------------------------------------
316 !
317  RETURN
318  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
om4111
subroutine om4111(OP, DM, TYPDIM, XM, TYPEXM, DN, TYPDIN, XN, TYPEXN, SIZDN, SZMDN, SIZXN, NETAGE, NELMAX3D)
Definition: om4111.f:8
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:20 for The TELEMAC-MASCARET system by doxygen 1.8.13