The TELEMAC-MASCARET system  trunk
omseg.f
Go to the documentation of this file.
1 ! ****************
2  SUBROUTINE omseg
3 ! ****************
4 !
5  &(op , dm,typdim,xm,typexm, dn,typdin,xn,typexn, d,c,
6  & ndiag,nseg1,nseg2,gloseg,sizglo)
7 !
8 !***********************************************************************
9 ! BIEF V6P1 21/08/2010
10 !***********************************************************************
11 !
12 !brief OPERATIONS ON MATRICES WITH AN EDGE-BASED STORAGE.
13 !code
14 !+ D: DIAGONAL MATRIX
15 !+ C: CONSTANT
16 !+
17 !+ OP IS A STRING OF 8 CHARACTERS, WHICH INDICATES THE OPERATION TO BE
18 !+ PERFORMED ON MATRICES M AND N, D AND C.
19 !+
20 !+ THE RESULT IS MATRIX M.
21 !+
22 !+ OP = 'M=N ' : COPIES N IN M
23 !+ OP = 'M=CN ' : MULTIPLIES N BY C
24 !+ OP = 'M=CM ' : MULTIPLIES M BY C
25 !+ OP = 'M=M+CN ' : ADDS CN TO M
26 !+ OP = 'M=TN ' : COPIES TRANSPOSE OF N IN M
27 !+ OP = 'M=M+TN ' : ADDS TRANSPOSE(N) TO M
28 !+ OP = 'M=M+CTN ' : ADDS C TRANSPOSE(N) TO M
29 !+ OP = 'M=M+N ' : ADDS N TO M
30 !+ OP = 'M=MD ' : M X D
31 !+ OP = 'M=DM ' : D X M
32 !+ OP = 'M=M-ND ' : SUBTRACTS ND FROM M
33 !+ OP = 'M=M-DN ' : SUBTRACTS DN FROM M
34 !+ OP = 'M=DMD ' : D X M X D
35 !+ OP = 'M=0 ' : SETS M TO 0
36 !+ OP = 'M=X(M) ' : NOT SYMMETRICAL FORM OF M
37 !+ (OLD MATSNS)
38 !+ OP = 'M=MSK(M)' : MASKS M EXTRADIAGONAL TERMS
39 !+ (OLD MASKEX)
40 !+ THE MASK IS TAKEN FROM D
41 !+ OP = 'M=M+D ' : ADDS D TO M
42 !
43 !history J-M HERVOUET (LNHE)
44 !+ 29/12/05
45 !+ V5P6
46 !+
47 !
48 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
49 !+ 13/07/2010
50 !+ V6P0
51 !+ Translation of French comments within the FORTRAN sources into
52 !+ English comments
53 !
54 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
55 !+ 21/08/2010
56 !+ V6P0
57 !+ Creation of DOXYGEN tags for automated documentation and
58 !+ cross-referencing of the FORTRAN sources
59 !
60 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
61 !| C |-->| A GIVEN CONSTANT USED IN OPERATION OP
62 !| D |-->| A DIAGONAL MATRIX
63 !| DM |<->| DIAGONAL OF M
64 !| DN |-->| DIAGONAL OF N
65 !| NDIAG |-->| NUMBER OF TERMS IN THE DIAGONAL
66 !| NSEG1 |-->| NUMBER OF SEGMENTS OF LINE ELEMENT
67 !| NSEG2 |-->| NUMBER OF SEGMENTS OF COLUMN ELEMENT
68 !| OP |-->| OPERATION TO BE DONE (SEE ABOVE)
69 !| TYPDIM |<->| TYPE OF DIAGONAL OF M:
70 !| | | TYPDIM = 'Q' : ANY VALUE
71 !| | | TYPDIM = 'I' : IDENTITY
72 !| | | TYPDIM = '0' : ZERO
73 !| TYPDIN |<->| TYPE OF DIAGONAL OF N:
74 !| | | TYPDIN = 'Q' : ANY VALUE
75 !| | | TYPDIN = 'I' : IDENTITY
76 !| | | TYPDIN = '0' : ZERO
77 !| TYPEXM |-->| TYPE OF OFF-DIAGONAL TERMS OF M:
78 !| | | TYPEXM = 'Q' : ANY VALUE
79 !| | | TYPEXM = 'S' : SYMMETRIC
80 !| | | TYPEXM = '0' : ZERO
81 !| TYPEXN |-->| TYPE OF OFF-DIAGONAL TERMS OF N:
82 !| | | TYPEXN = 'Q' : ANY VALUE
83 !| | | TYPEXN = 'S' : SYMMETRIC
84 !| | | TYPEXN = '0' : ZERO
85 !| XM |-->| OFF-DIAGONAL TERMS OF M
86 !| XN |-->| OFF-DIAGONAL TERMS OF N
87 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
88 !
89  USE bief, ex_omseg => omseg
90 !
91  USE declarations_special
92  IMPLICIT NONE
93 !
94 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
95 !
96  INTEGER, INTENT(IN) :: NDIAG,NSEG1,NSEG2,SIZGLO
97  INTEGER, INTENT(IN) :: GLOSEG(sizglo,2)
98  CHARACTER(LEN=8), INTENT(IN) :: OP
99  DOUBLE PRECISION, INTENT(IN) :: DN(*),D(*)
100  DOUBLE PRECISION, INTENT(INOUT) :: XM(*)
101  DOUBLE PRECISION, INTENT(IN) :: XN(*)
102  CHARACTER(LEN=1), INTENT(INOUT) :: TYPDIM,TYPEXM,TYPDIN,TYPEXN
103  DOUBLE PRECISION, INTENT(INOUT) :: DM(*)
104  DOUBLE PRECISION, INTENT(IN) :: C
105 !
106 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
107 !
108  INTRINSIC min
109 !
110  INTEGER ISEG,DIMX
111 !
112 !-----------------------------------------------------------------------
113 !
114 ! ARRAYS XM AND XN ARE BASICALLY OF SIZE XM(DIMX,1 OR 2)
115 ! BUT IN THE CASE OF RECTANGULAR MATRICES OTHER DATA ARE STORED
116 ! BEYOND XM(2*DIMX)
117 !
118  dimx=min(nseg1,nseg2)
119 !
120  IF(op(3:8).EQ.'N ') THEN
121 !
122  IF(typdin(1:1).EQ.'Q') THEN
123  CALL ov('X=Y ', x=dm, y=dn, dim1=ndiag)
124  ELSEIF(typdin(1:1).EQ.'I'.OR.typdin(1:1).EQ.'0') THEN
125 ! NOTHING TO DO, ONLY NEEDS TO COPY TYPDIN
126  ELSE
127  WRITE(lu,6) typdin(1:1)
128 6 FORMAT(1x,'OMSEG (BIEF) : TYPDIN UNKNOWN :',a1)
129  CALL plante(1)
130  stop
131  ENDIF
132  typdim(1:1)=typdin(1:1)
133 !
134  IF(typexn(1:1).EQ.'S') THEN
135  CALL ov('X=Y ', x=xm, y=xn, dim1=nseg1)
136  ELSEIF(typexn(1:1).EQ.'Q') THEN
137  CALL ov('X=Y ', x=xm, y=xn, dim1=nseg1+nseg2)
138  ELSEIF(typexn(1:1).NE.'0') THEN
139  WRITE(lu,11) typexn(1:1)
140 11 FORMAT(1x,'OMSEG (BIEF) : TYPEXN UNKNOWN :',a1)
141  CALL plante(1)
142  stop
143  ENDIF
144  typexm(1:1)=typexn(1:1)
145 !
146 !-----------------------------------------------------------------------
147 !
148  ELSEIF(op(3:8).EQ.'CN ') THEN
149 !
150  CALL ov('X=CY ', x=dm, y=dn, c=c, dim1=ndiag)
151 !
152  IF(typexn(1:1).EQ.'S') THEN
153  CALL ov('X=CY ', x=xm, y=xn, c=c, dim1=nseg1)
154  ELSEIF(typexn(1:1).EQ.'Q') THEN
155  CALL ov('X=CY ', x=xm, y=xn, c=c, dim1=nseg1+nseg2)
156  ELSEIF(typexn(1:1).NE.'0') THEN
157  WRITE(lu,11) typexn(1:1)
158  CALL plante(1)
159  stop
160  ENDIF
161 !
162  typdim(1:1)=typdin(1:1)
163  typexm(1:1)=typexn(1:1)
164 !
165 !-----------------------------------------------------------------------
166 !
167  ELSEIF(op(3:8).EQ.'CM ') THEN
168 !
169  CALL ov('X=CX ', x=dm, c=c, dim1=ndiag)
170 !
171  IF(typexm(1:1).EQ.'S') THEN
172  CALL ov('X=CX ', x=xm, c=c, dim1=nseg1)
173  ELSEIF(typexm(1:1).EQ.'Q') THEN
174  CALL ov('X=CX ', x=xm, c=c, dim1=nseg1+nseg2)
175  ELSEIF(typexm(1:1).NE.'0') THEN
176  WRITE(lu,11) typexm(1:1)
177  CALL plante(1)
178  stop
179  ENDIF
180 !
181 !-----------------------------------------------------------------------
182 !
183  ELSEIF(op(3:8).EQ.'M+CN ' .OR.
184  & (op(3:8).EQ.'M+CTN ').AND.typexn(1:1).NE.'Q') THEN
185 !
186  IF(typdin(1:1).EQ.'I') THEN
187  CALL ov('X=X+C ', x=dm, c=c, dim1=ndiag)
188  ELSEIF(typdin(1:1).NE.'0') THEN
189  CALL ov('X=X+CY ', x=dm, y=dn, c=c, dim1=ndiag)
190  ENDIF
191 !
192  IF(typexn(1:1).EQ.'S') THEN
193  CALL ov('X=X+CY ', x=xm, y=xn, c=c, dim1=nseg1)
194  IF(typexm(1:1).EQ.'Q') THEN
195  CALL ov('X=X+CY ', x=xm(dimx+1:dimx+nseg1), y=xn, c=c,
196  & dim1=nseg1)
197  ENDIF
198  ELSEIF(typexn(1:1).EQ.'Q') THEN
199  IF(typexm(1:1).NE.'Q') THEN
200  WRITE(lu,98) typexm(1:1),op(1:8),typexn(1:1)
201 98 FORMAT(1x,'OMSEG (BIEF) : TYPEXM = ',a1,' DOES NOT GO',
202  & /,1x,'FOR THE OPERATION : ',a8,' WITH TYPEXN = ',a1)
203  CALL plante(1)
204  stop
205  ENDIF
206  CALL ov('X=X+CY ', x=xm, y=xn, c=c, dim1=nseg1+nseg2)
207  ELSEIF(typexn(1:1).NE.'0') THEN
208  WRITE(lu,11) typexn(1:1)
209  CALL plante(1)
210  stop
211  ENDIF
212 !
213 !-----------------------------------------------------------------------
214 !
215  ELSEIF(op(3:8).EQ.'M+CTN ') THEN
216 !
217 ! THE CASES WHERE N IS SYMMETRICAL ARE TREATED WITH M=M+CN
218 !
219  CALL ov('X=X+CY ', x=dm, y=dn, c=c, dim1=ndiag)
220 !
221  IF(nseg1.NE.nseg2) THEN
222  WRITE(lu,*) 'M+CTN : RECTANGULAR MATRIX
223  & NOT IMPLEMENTED'
224  CALL plante(1)
225  stop
226  ENDIF
227  IF(typexn(1:1).EQ.'Q') THEN
228  IF(typexm(1:1).NE.'Q') THEN
229  WRITE(lu,98) typexm(1:1),op(1:8),typexn(1:1)
230  CALL plante(1)
231  stop
232  ENDIF
233  CALL ov('X=X+CY ', x=xm, y=xn(dimx+1:dimx+nseg1), c=c,
234  & dim1=nseg1)
235  CALL ov('X=X+CY ', x=xm(dimx+1:dimx+nseg1), y=xn, c=c,
236  & dim1=nseg1)
237  ELSE
238  WRITE(lu,11) typexn(1:1)
239  CALL plante(1)
240  stop
241  ENDIF
242 !
243 !-----------------------------------------------------------------------
244 !
245  ELSEIF(op(3:8).EQ.'TN ') THEN
246 !
247  CALL ov('X=Y ', x=dm, y=dn, dim1=ndiag)
248 !
249  IF(typexn(1:1).EQ.'S') THEN
250  CALL ov('X=Y ', x=xm, y=xn, dim1=nseg1)
251  ELSEIF(typexn(1:1).EQ.'Q') THEN
252  IF(typexm(1:1).NE.'S'.AND.nseg1.NE.nseg2) THEN
253  WRITE(lu,*) 'TN : RECTANGULAR MATRIX
254  & NOT IMPLEMENTED'
255  CALL plante(1)
256  stop
257  ENDIF
258  CALL ov('X=Y ', x=xm, y=xn(dimx+1:dimx+nseg1), dim1=nseg1)
259  CALL ov('X=Y ', x=xm(dimx+1:dimx+nseg1), y=xn, dim1=nseg1)
260  ELSEIF(typexn(1:1).NE.'0') THEN
261  WRITE(lu,11) typexn(1:1)
262  CALL plante(1)
263  stop
264  ENDIF
265  typdim(1:1)=typdin(1:1)
266  typexm(1:1)=typexn(1:1)
267 !
268 !-----------------------------------------------------------------------
269 !
270  ELSEIF(op(3:8).EQ.'M+N '.OR.
271  & (op(3:8).EQ.'M+TN ').AND.typexn(1:1).NE.'Q') THEN
272 !
273  CALL ov('X=X+Y ', x=dm, y=dn, dim1=ndiag)
274 !
275  IF(typexn(1:1).EQ.'S') THEN
276  CALL ov('X=X+Y ', x=xm, y=xn, dim1=nseg1)
277  IF(typexm(1:1).EQ.'Q') THEN
278  CALL ov('X=X+Y ', x=xm(dimx+1:dimx+nseg1), y=xn, dim1=nseg1)
279  ENDIF
280  ELSEIF(typexn(1:1).EQ.'Q') THEN
281  IF(typexm(1:1).NE.'Q') THEN
282  WRITE(lu,98) typexm(1:1),op(1:8),typexn(1:1)
283  CALL plante(1)
284  stop
285  ENDIF
286  CALL ov('X=X+Y ', x=xm, y=xn, dim1=nseg1+nseg2)
287  ELSEIF(typexn(1:1).NE.'0') THEN
288  WRITE(lu,11) typexn(1:1)
289  CALL plante(1)
290  stop
291  ENDIF
292 !
293 !-----------------------------------------------------------------------
294 !
295  ELSEIF(op(3:8).EQ.'M+TN ') THEN
296 !
297 ! THE CASE WHERE N IS SYMMETRICAL HAS ALREADY BEEN TREATED
298 !
299  CALL ov('X=X+Y ', x=dm, y=dn, dim1=ndiag)
300 !
301  IF(nseg1.NE.nseg2) THEN
302  WRITE(lu,*) 'M+TN : RECTANGULAR MATRIX
303  & NOT IMPLEMENTED'
304  CALL plante(1)
305  stop
306  ENDIF
307  IF(typexm(1:1).EQ.'Q') THEN
308  CALL ov('X=X+Y ', x=xm, y=xn(dimx+1:dimx+nseg1), dim1=nseg1)
309  CALL ov('X=X+Y ', x=xm(dimx+1:dimx+nseg1), y=xn, dim1=nseg1)
310  ELSEIF(typexn(1:1).NE.'0') THEN
311  WRITE(lu,11) typexn(1:1)
312  CALL plante(1)
313  stop
314  ENDIF
315  typdim(1:1)=typdin(1:1)
316  typexm(1:1)=typexn(1:1)
317 !
318 !-----------------------------------------------------------------------
319 !
320  ELSEIF(op(3:8).EQ.'MD ') THEN
321 !
322 ! DIAGONAL TERMS
323 !
324  IF(typdim(1:1).EQ.'Q') THEN
325  CALL ov('X=XY ', x=dm, y=d, dim1=ndiag)
326  ELSEIF(typdim(1:1).EQ.'I') THEN
327  CALL ov('X=Y ', x=dm, y=d, dim1=ndiag)
328  typdim(1:1)='Q'
329  ELSEIF(typdim(1:1).NE.'0') THEN
330  WRITE(lu,13) typdim(1:1)
331  CALL plante(1)
332  stop
333  ENDIF
334 !
335 ! EXTRADIAGONAL TERMS
336 !
337  IF(typexm(1:1).EQ.'Q') THEN
338 !
339  DO iseg = 1 , min(nseg1,nseg2)
340  xm(iseg) = xm(iseg) * d(gloseg(iseg,2))
341  xm(iseg+dimx) = xm(iseg+dimx) * d(gloseg(iseg,1))
342  ENDDO
343  IF(nseg1.GT.nseg2) THEN
344  DO iseg = min(nseg1,nseg2)+1,max(nseg1,nseg2)
345  xm(iseg+dimx)=xm(iseg+dimx)*d(gloseg(iseg,1))
346  ENDDO
347  ELSEIF(nseg2.GT.nseg1) THEN
348  DO iseg = min(nseg1,nseg2)+1,max(nseg1,nseg2)
349  xm(iseg+dimx)=xm(iseg+dimx)*d(gloseg(iseg,2))
350  ENDDO
351  ENDIF
352 !
353  ELSEIF(typexm(1:1).EQ.'S') THEN
354  WRITE(lu,171)
355 171 FORMAT(1x,'OMSEG (BIEF) : M=MD , M MUST BE NON-SYMMETRIC')
356  CALL plante(1)
357  stop
358  ELSEIF(typexm(1:1).NE.'0') THEN
359 173 FORMAT(1x,'OMSEG (BIEF) : TYPEXM NOT AVAILABLE : ',a1)
360  CALL plante(1)
361  stop
362  ENDIF
363 !
364 !-----------------------------------------------------------------------
365 !
366  ELSEIF(op(3:8).EQ.'DM ') THEN
367 !
368 ! DIAGONAL TERMS
369 !
370  IF(typdim(1:1).EQ.'Q') THEN
371  CALL ov('X=XY ', x=dm, y=d, dim1=ndiag)
372  ELSEIF(typdim(1:1).EQ.'I') THEN
373  CALL ov('X=Y ', x=dm, y=d, dim1=ndiag)
374  typdim(1:1)='Q'
375  ELSEIF(typdim(1:1).NE.'0') THEN
376  WRITE(lu,13) typdim(1:1)
377  CALL plante(1)
378  stop
379  ENDIF
380 !
381 ! EXTRADIAGONAL TERMS
382 !
383  IF(typexm(1:1).EQ.'Q') THEN
384 !
385  DO iseg = 1 , min(nseg1,nseg2)
386  xm(iseg) = xm(iseg) * d(gloseg(iseg,1))
387  xm(iseg+dimx) = xm(iseg+dimx) * d(gloseg(iseg,2))
388  ENDDO
389  IF(nseg1.GT.nseg2) THEN
390  DO iseg = min(nseg1,nseg2)+1,max(nseg1,nseg2)
391  xm(iseg+dimx)=xm(iseg+dimx)*d(gloseg(iseg,2))
392  ENDDO
393  ELSEIF(nseg2.GT.nseg1) THEN
394  DO iseg = min(nseg1,nseg2)+1,max(nseg1,nseg2)
395  xm(iseg+dimx)=xm(iseg+dimx)*d(gloseg(iseg,1))
396  ENDDO
397  ENDIF
398 !
399  ELSEIF(typexm(1:1).EQ.'S') THEN
400  WRITE(lu,181)
401 181 FORMAT(1x,'OMSEG (BIEF) : M=MD IS NOT SYMMETRIC')
402  CALL plante(1)
403  stop
404  ELSEIF(typexm(1:1).NE.'0') THEN
405  WRITE(lu,173) typexm(1:1)
406  CALL plante(1)
407  stop
408  ENDIF
409 !
410 !-----------------------------------------------------------------------
411 !
412  ELSEIF(op(3:8).EQ.'M-DN ') THEN
413 !
414 ! DIAGONAL TERMS
415 !
416  IF(typdim(1:1).EQ.'Q') THEN
417  CALL ov('X=X-YZ ', x=dm, y=dn, z=d, dim1=ndiag)
418  ELSEIF(typdim(1:1).NE.'0') THEN
419  WRITE(lu,13) typdim(1:1)
420  CALL plante(1)
421  stop
422  ENDIF
423 !
424 ! EXTRADIAGONAL TERMS
425 !
426  IF(typexm(1:1).EQ.'Q') THEN
427  IF(typexn(1:1).EQ.'Q') THEN
428  DO iseg = 1 , nseg1
429  xm(iseg )=xm(iseg )-xn(iseg )*d(gloseg(iseg,1))
430  xm(iseg+dimx)=xm(iseg+dimx)-xn(iseg+dimx)*d(gloseg(iseg,2))
431  ENDDO
432  ELSEIF(typexn(1:1).EQ.'S') THEN
433  DO iseg = 1 , nseg1
434  xm(iseg ) = xm(iseg ) - xn(iseg) * d(gloseg(iseg,1))
435  xm(iseg+dimx) = xm(iseg+dimx) - xn(iseg) * d(gloseg(iseg,2))
436  ENDDO
437  ELSEIF(typexn(1:1).NE.'0') THEN
438  WRITE(lu,11) typexn(1:1)
439  CALL plante(1)
440  stop
441  ENDIF
442  ELSE
443  WRITE(lu,173) typexm(1:1)
444  CALL plante(1)
445  stop
446  ENDIF
447 !
448 !-----------------------------------------------------------------------
449 !
450  ELSEIF(op(3:8).EQ.'M-ND ') THEN
451 !
452 ! DIAGONAL TERMS
453 !
454  IF(typdim(1:1).EQ.'Q') THEN
455  CALL ov('X=X-YZ ', x=dm, y=dn, z=d, dim1=ndiag)
456  ELSEIF(typdim(1:1).NE.'0') THEN
457  WRITE(lu,13) typdim(1:1)
458  CALL plante(1)
459  stop
460  ENDIF
461 !
462 ! EXTRADIAGONAL TERMS
463 !
464  IF(typexm(1:1).EQ.'Q') THEN
465  IF(typexn(1:1).EQ.'Q') THEN
466  DO iseg = 1 , nseg1
467  xm(iseg )=xm(iseg )-xn(iseg )*d(gloseg(iseg,2))
468  xm(iseg+dimx)=xm(iseg+dimx)-xn(iseg+dimx)*d(gloseg(iseg,1))
469  ENDDO
470  ELSEIF(typexn(1:1).EQ.'S') THEN
471  DO iseg = 1 , nseg1
472  xm(iseg ) = xm(iseg ) - xn(iseg) * d(gloseg(iseg,2))
473  xm(iseg+dimx) = xm(iseg+dimx) - xn(iseg) * d(gloseg(iseg,1))
474  ENDDO
475  ELSEIF(typexn(1:1).NE.'0') THEN
476  WRITE(lu,11) typexn(1:1)
477  CALL plante(1)
478  stop
479  ENDIF
480  ELSE
481  WRITE(lu,173) typexm(1:1)
482  CALL plante(1)
483  stop
484  ENDIF
485 !
486 !----------------------------------------------------------------------
487 !
488  ELSEIF(op(3:8).EQ.'DMD ') THEN
489 !
490 ! DIAGONAL TERMS
491 !
492  IF(typdim(1:1).EQ.'Q') THEN
493  CALL ov('X=XY ', x=dm, y=d, dim1=ndiag)
494  CALL ov('X=XY ', x=dm, y=d, dim1=ndiag)
495  ELSEIF(typdim(1:1).EQ.'I') THEN
496  CALL ov('X=YZ ', x=dm, y=d, z=d, dim1=ndiag)
497  typdim(1:1)='Q'
498  ELSEIF(typdim(1:1).NE.'0') THEN
499  WRITE(lu,13) typdim(1:1)
500 13 FORMAT(1x,'OMSEG (BIEF) : TYPDIM UNKNOWN :',a1)
501  CALL plante(1)
502  stop
503  ENDIF
504 !
505 ! EXTRADIAGONAL TERMS
506 !
507  IF(typexm(1:1).EQ.'S') THEN
508 !
509  DO iseg = 1 , nseg1
510  xm(iseg)=xm(iseg)*d(gloseg(iseg,1))*d(gloseg(iseg,2))
511  ENDDO
512 !
513  ELSEIF(typexm(1:1).EQ.'Q') THEN
514 !
515  DO iseg = 1 , nseg1
516  xm(iseg )=xm(iseg )
517  & *d(gloseg(iseg,1))*d(gloseg(iseg,2))
518  xm(iseg+dimx)=xm(iseg+dimx)
519  & *d(gloseg(iseg,1))*d(gloseg(iseg,2))
520  ENDDO
521 !
522  ELSEIF(typexm(1:1).NE.'0') THEN
523  WRITE(lu,21) typexm(1:1)
524 21 FORMAT(1x,'OMSEG (BIEF) : TYPEXM UNKNOWN :',a1)
525  CALL plante(1)
526  stop
527  ENDIF
528 !
529 !-----------------------------------------------------------------------
530 !
531  ELSEIF(op(3:8).EQ.'M+D ') THEN
532 !
533  CALL ov('X=X+Y ', x=dm, y=d, dim1=ndiag)
534 ! HERE THERE IS A DOUBT ABOUT TYPDIM
535  typdim(1:1)='Q'
536 !
537 !-----------------------------------------------------------------------
538 !
539  ELSEIF(op(3:8).EQ.'0 ') THEN
540 !
541  CALL ov('X=C ', x=dm, c=0.d0, dim1=ndiag)
542 !
543  IF(typexm(1:1).EQ.'S') THEN
544  CALL ov('X=C ', x=xm, c=0.d0, dim1=nseg1)
545  ELSEIF(typexm(1:1).EQ.'Q') THEN
546  CALL ov('X=C ', x=xm, c=0.d0, dim1=nseg1+nseg2)
547  ELSEIF(typexm(1:1).NE.'0') THEN
548  WRITE(lu,711) typexm(1:1)
549 711 FORMAT(1x,'OMSEG (BIEF) : TYPEXM UNKNOWN :',a1)
550  CALL plante(1)
551  stop
552  ENDIF
553 ! TYPDIM IS NOT CHANGED
554 ! TYPDIM(1:1)='0'
555 ! TYPEXM IS NOT CHANGED
556 ! TYPEXM(1:1)='0'
557 !-----------------------------------------------------------------------
558 !
559  ELSEIF(op(3:8).EQ.'X(M) ') THEN
560 !
561  IF(typexm(1:1).EQ.'S') THEN
562  CALL ov('X=Y ',x=xm(dimx+1:dimx+nseg1),
563  & y=xm( 1: nseg1), dim1=nseg1)
564  ELSEIF(typexm(1:1).NE.'0') THEN
565  WRITE(lu,811) typexm(1:1)
566 811 FORMAT(1x,'OMSEG (BIEF): MATRIX ALREADY NON SYMMETRICAL: ',a1)
567  CALL plante(1)
568  stop
569  ENDIF
570  typexm(1:1)='Q'
571 !
572 !-----------------------------------------------------------------------
573 !
574 ! ELSEIF(OP(3:8).EQ.'MSK(M)') THEN
575 !
576 ! IF(TYPEXM(1:1).EQ.'S') THEN
577 ! J = 3
578 ! ELSEIF(TYPEXM(1:1).EQ.'Q') THEN
579 ! J = 6
580 ! ELSEIF(TYPEXM(1:1).EQ.'0') THEN
581 ! J = 0
582 ! ELSE
583 ! WRITE(LU,711) TYPEXM
584 ! J=0
585 ! CALL PLANTE(1)
586 ! STOP
587 ! ENDIF
588 !
589 ! IF(J.GT.0) THEN
590 ! DO I = 1,J
591 ! CALL OV('X=XY ', X=XM(1,I), Y=D, DIM1=NELEM)
592 ! ENDDO
593 ! ENDIF
594 !
595 !-----------------------------------------------------------------------
596 !
597  ELSE
598 !
599  WRITE(lu,41) op
600 41 FORMAT(1x,'OMSEG (BIEF) : UNKNOWN OPERATION : ',a8)
601  CALL plante(1)
602  stop
603 !
604  ENDIF
605 !
606 !-----------------------------------------------------------------------
607 !
608  RETURN
609  END
omseg
subroutine omseg(OP, DM, TYPDIM, XM, TYPEXM, DN, TYPDIN, XN, TYPEXN, D, C, NDIAG, NSEG1, NSEG2, GLOSEG, SIZGLO)
Definition: omseg.f:8
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
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:21 for The TELEMAC-MASCARET system by doxygen 1.8.13