Download copmat.eso
Back to the list
1 : C COPMAT SOURCE BP208322 12/10/03 21:15:05 7517
2 : SUBROUTINE COPMAT(MELEME,X1,RI1,DELTI,DELTJ,XMATRI)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8 (A-H,O-Z)
5 : *
6 : *****************************************************************************
7 : * POSITIONNEMENT D'UNE MATRICE NxN DANS UN ANGLE *
8 : * D'UNE MATRICE 2Nx2N POUR LE QZ *
9 : * _________________________________________________________________________ *
10 : * *
11 : * DATE : le 24 Fevrier 1995 *
12 : * AUTEUR : Nicolas BENECH *
13 : * _________________________________________________________________________ *
14 : * *
15 : * MODULE(S) APPELANT(S) : ASSMAT *
16 : * *
17 : * MODULE(S) APPELE(S) : POSPT *
18 : * *
19 : * _________________________________________________________________________ *
20 : * *
21 : * EN ENTREE : *
22 : * MELEME : maillage permettant d'ordonner les valeurs *
23 : * X1, RI1 : coefficient et matrice a inserer *
24 : * DELTI, DELTJ : decalage ligne/colonne pour l'insertion *
25 : * _________________________________________________________________________ *
26 : * *
27 : * EN SORTIE : *
28 : * XMATRI : matrice 2nx2n subissant l'insertion *
29 : * (actif et modifiable en entree/sortie) *
30 : * *
31 : *****************************************************************************
32 : *
33 : *
34 : -INC CCOPTIO
35 : -INC SMELEME
36 : -INC SMRIGID
37 : *
38 : INTEGER DELTI,DELTJ,I,J
39 : REAL*8 X1,X1P
40 : LOGICAL EXISTE
41 : *
42 : cbp EXISTE = (RI1*X1.NE.0)
43 : EXISTE = (RI1.NE.0.and.X1.ne.0.)
44 : c SEGACT, XMATRI*MOD
45 : N1=INT(XMATRI.RE(/1)/2)
46 : N2=INT(XMATRI.RE(/2)/2)
47 : IF (EXISTE) THEN
48 : *
49 : * Tester DELTI / N1 (DELTIERREUR(47)
53 : RETURN
54 : ENDIF
55 : *
56 : SEGACT,RI1
57 : X1P = X1*RI1.COERIG(1)
58 : IPT1 = RI1.IRIGEL(1,1)
59 : XMATR1 = RI1.IRIGEL(4,1)
60 : SEGDES,RI1
61 : SEGACT,IPT1,XMATR1
62 : * XMATR1 = IMATR1.IMATTT(1)
63 : * SEGDES, IMATR1
64 : *
65 : * SEGACT, XMATR1
66 : DO 10, I=DELTI+1,DELTI+N1
66 : CALL POSPT (MELEME,I-DELTI,IPT1,IP)
67 : IF (IP .EQ. 0) THEN
67 : CALL ERREUR(47)
68 : RETURN
69 : ENDIF
70 : DO 10, J=DELTJ+1,DELTJ+N2
70 : CALL POSPT (MELEME,J-DELTJ,IPT1,JP)
71 : IF (JP .EQ. 0) THEN
71 : CALL ERREUR(47)
72 : RETURN
73 : ENDIF
74 : XMATRI.RE(I,J,1)=X1P*XMATR1.RE(IP,JP,1)
75 : 10 CONTINUE
76 : SEGDES,IPT1,XMATR1
77 : *
78 : ELSE
79 : DO 20, I=DELTI+1,DELTI+N1
80 : DO 20, J=DELTJ+1,DELTJ+N2
81 : XMATRI.RE(I,J,1)=0.d0
82 : 20 CONTINUE
83 : ENDIF
84 : *
85 : c SEGDES, XMATRI
86 : *
87 : RETURN
88 : END
89 :
90 :
91 :
92 :
93 :
94 :
95 :
96 :
97 :
98 :
99 :
100 :
101 :