1 : C CQ2KSG SOURCE CHAT 05/01/12 22:26:43 5004 2 : SUBROUTINE CQ2KSG(COO,EP,DIM3,IFOU,AN,NBPGAU,XSTRS,RAYON, 3 : . RAY,TGAUS,CGAUS,ALF11,ALF12,ALF21,ALF22,A4,S3,AM,A1,A,LRE,REL 4 : $ ) 5 : *----------------------------------------------------------------------- 6 : C CALCUL DE LA MATRICE KSIGMA POUR UNE COQUE A 2 NOEUDS 7 : C FEVRIER 86 ; X. DE MAZANCOURT 8 : C PROGRAMME REPRIS A 90% SUR LE COQFLA DE INCA 9 : *----------------------------------------------------------------------- 10 : C ENTREES: 11 : C COO:COORDONNEES DE L'ELEMENT 12 : C EP:EPAISSEUR DE LA COQUE 13 : C IFOU = VALEUR DE IFOUR DE CCOPTIO 14 : C AN:NUMERO DE L'HARMONIQUE DE FOURIER 15 : C XSTRS:CONTRAINTES 16 : C NBPGAU:NOMBRE DE POINTS DE GAUSS 17 : C TGAUS:POSITION DES POINTS DE GAUSS 18 : C CGAUS:POIDS DES POINTS DE GAUSS 19 : C RAYON,RAY,ALF:TABLEAUX DE TRAVAIL 20 : C LRE = TAILLE DE LA MATRICE KSIGMA 21 : C SORTIES: 22 : C REL:MATRICE KSIGMA 23 : *----------------------------------------------------------------------- 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8 (A-H,O-Z) 26 : C Include contenant quelques constantes dont XPI : 27 : -INC CCREEL 28 : PARAMETER(UN=1.D0,UNDEMI=.5D0,UNQUAR=.25D0) 29 : DIMENSION A4(8,*),S3(8,*),AM(8,*),A1(8,*) 30 : DIMENSION COO(3,*),A(8,*),TGAUS(*),CGAUS(*) 31 : DIMENSION ALF11(*),ALF12(*),ALF21(*),ALF22(*),RAYON(*),REL(LRE,*) 32 : DIMENSION RAY(*),XSTRS(*),II(6) 33 : DATA II/1,2,4,5,6,8/ 34 : C --------------------------------PRELIMINAIRES 34 : CALL ZERO(REL,LRE,LRE) 35 : RAYON(1)=COO(1,1) 36 : RAYON(3)=COO(1,2) 37 : RAYON(2)=(RAYON(1)+RAYON(3))*UNDEMI 38 : DR=RAYON(3)-RAYON(1) 39 : DZ=COO(2,2)-COO(2,1) 40 : DS=SQRT(DR*DR+DZ*DZ) 41 : COSP=DR/DS 42 : SINP=DZ/DS 43 : XS2=UNDEMI*DS 44 : XS4=UNQUAR*DS 45 : C -------------------------------- 45 : CALL RESO1K(A4,DS,COSP,SINP,S3,A) 45 : CALL ZERO(ALF12,5,1) 45 : CALL ZERO(ALF22,7,1) 46 : C --------------------------------BOUCLE SUR LES POINTS DE GAUSS 47 : DO 9 IN=1,NBPGAU 48 : C ID1=1+(IN-1)*6 49 : C ID2=2+(IN-1)*6 50 : RAY(IN)=RAYON(2)+XS2*COSP*TGAUS(IN) 51 : X=TGAUS(IN)*XS2 52 : X2=X*X 53 : X3=X2*X 54 : X4=X3*X 55 : C ANS=EP*XSTRS(ID1) 56 : C ANT=EP*XSTRS(ID2) 57 : C 58 : C ON PEUT FAIRE VARIER LES CONTRAINTES AVEC LE POINT DE GAUSS 59 : C MAIS ON A CHOISI DE PRENDRE CELLES DU 2} POINT DE GAUSS... 60 : C 61 : IF (IFOU.EQ.1) THEN 62 : ANS=EP*XSTRS(7) 63 : ANT=EP*XSTRS(8) 64 : ELSE 65 : ANS=EP*XSTRS(5) 66 : ANT=EP*XSTRS(6) 67 : ENDIF 68 : ALF11(1)=UN 69 : ALF11(2)=X 70 : ALF11(3)=X2 71 : ALF11(4)=X3 72 : ALF11(5)=X4 73 : DO 12 NC=1,5 74 : ALF21(NC)=ALF11(NC) 75 : 12 CONTINUE 76 : ALF21(6)=X4*X 77 : ALF21(7)=X4*X2 78 : RRRR=RAY(IN) 79 : IF(IFOU.EQ.-3) RRRR=UN 80 : * 81 : * LE CAS DES DEF. PLANES GENERALISEES SERA A TESTER |||| 82 : * 83 : IF(IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN 84 : ANS=ANS*XS4*CGAUS(IN) 85 : ANT=0.D0 86 : ELSE 87 : ANS=ANS*RRRR*XS4*CGAUS(IN) 88 : ANT=(ANT*XS4*CGAUS(IN))/RRRR 89 : ENDIF 90 : IF (IFOU.EQ.0.OR.(IFOU.EQ.1.AND.AN.EQ.0)) THEN 91 : ANS=ANS*2*XPI 92 : ANT=ANT*2*XPI 93 : ELSEIF (IFOU.EQ.1.AND.AN.NE.0) THEN 94 : ANS=ANS*XPI 95 : ANT=ANT*XPI 96 : ENDIF 97 : ANS=ANS*DIM3 98 : ANT=ANT*DIM3 98 : CALL AMUL1K(ALF11,5,ANS,ALF12) 98 : CALL AMUL1K(ALF21,7,ANT,ALF22) 99 : C --------------------------------------- 100 : 9 CONTINUE 101 : C 102 : C TRANSFERT DE ALF12 (RESP.ALF22) DANS ALF11 (RESP.ALF21) 103 : C 103 : CALL SHIF1K(ALF12,ALF11,5) 103 : CALL SHIF1K(ALF22,ALF21,7) 104 : C 105 : C CALCUL DE A1,TRANSPOSEE DE A4 106 : C 107 : DO 15 NC=1,8 108 : DO 13 NCC=1,8 109 : A1(NCC,NC)=A4(NC,NCC) 110 : 13 CONTINUE 111 : 15 CONTINUE 111 : CALL ZERO(A,8,8) 112 : PROD1=COSP*COSP 113 : PROD2=SINP*SINP 114 : PROD3=SINP*COSP 115 : A(1,1)=PROD1*ALF21(1) 116 : A(1,2)=PROD1*ALF21(2) 117 : A(1,5)=PROD3*ALF21(1) 118 : A(1,6)=PROD3*ALF21(2) 119 : A(1,7)=PROD3*ALF21(3) 120 : A(1,8)=PROD3*ALF21(4) 121 : A(2,1)=A(1,2) 122 : A(2,2)=ALF11(1)+PROD1*ALF21(3) 123 : A(2,5)=PROD3*ALF21(2) 124 : A(2,6)=PROD3*ALF21(3) 125 : A(2,7)=PROD3*ALF21(4) 126 : A(2,8)=PROD3*ALF21(5) 127 : A(3,3)=ALF21(1) 128 : A(3,4)=ALF21(2) 129 : A(4,3)=A(3,4) 130 : A(4,4)=ALF11(1)+ALF21(3) 131 : A(5,1)=A(1,5) 132 : A(5,2)=A(2,5) 133 : A(5,5)=PROD2*ALF21(1) 134 : A(5,6)=PROD2*ALF21(2) 135 : A(5,7)=PROD2*ALF21(3) 136 : A(5,8)=PROD2*ALF21(4) 137 : A(6,1)=A(1,6) 138 : A(6,2)=A(2,6) 139 : A(6,5)=A(5,6) 140 : A(6,6)=ALF11(1)+A(5,7) 141 : A(6,7)=ALF11(2)*2.D0+A(5,8) 142 : A(6,8)=ALF11(3)*3.D0+PROD2*ALF21(5) 143 : A(7,1)=A(1,7) 144 : A(7,2)=A(2,7) 145 : A(7,5)=A(5,7) 146 : A(7,6)=A(6,7) 147 : A(7,7)=ALF11(3)*4.D0+PROD2*ALF21(5) 148 : A(7,8)=ALF11(4)*6.D0+PROD2*ALF21(6) 149 : A(8,1)=A(1,8) 150 : A(8,2)=A(2,8) 151 : A(8,5)=A(5,8) 152 : A(8,6)=A(6,8) 153 : A(8,7)=A(7,8) 154 : A(8,8)=ALF11(5)*9.D0+PROD2*ALF21(7) 155 : 20 CONTINUE 155 : CALL MULMAT (S3,A,A4,8,8,8) 155 : CALL MULMAT (A,A1,S3,8,8,8) 155 : CALL ZERO(AM,8,8) 156 : AM(1,1)=ALF21(1) 157 : AM(3,3)=ALF21(1) 158 : AM(5,5)=ALF21(1) 159 : AM(1,2)=ALF21(2) 160 : AM(2,1)=ALF21(2) 161 : AM(3,4)=ALF21(2) 162 : AM(4,3)=ALF21(2) 163 : AM(5,6)=ALF21(2) 164 : AM(6,5)=ALF21(2) 165 : AM(2,2)=ALF21(3) 166 : AM(4,4)=ALF21(3) 167 : AM(6,6)=ALF21(3) 168 : AM(5,7)=ALF21(3) 169 : AM(7,5)=ALF21(3) 170 : AM(5,8)=ALF21(4) 171 : AM(8,5)=ALF21(4) 172 : AM(6,7)=ALF21(4) 173 : AM(7,6)=ALF21(4) 174 : AM(7,7)=ALF21(5) 175 : AM(6,8)=ALF21(5) 176 : AM(8,6)=ALF21(5) 177 : AM(7,8)=ALF21(6) 178 : AM(8,7)=ALF21(6) 179 : AM(8,8)=ALF21(7) 179 : CALL MULMAT (S3,AM,A4,8,8,8) 179 : CALL MULMAT (AM,A1,S3,8,8,8) 180 : AN2=AN*AN 181 : DO 30 NC=1,8 182 : DO 31 NCC=1,8 183 : A(NCC,NC)=A(NCC,NC)+AN2*AM(NCC,NC) 184 : 31 CONTINUE 185 : 30 CONTINUE 186 : PROD1=2.D0*COSP 187 : PROD2=2.D0*SINP 187 : CALL ZERO(AM,8,8) 188 : AM(1,3)=PROD1*ALF21(1) 189 : AM(1,4)=PROD1*ALF21(2) 190 : AM(2,3)=AM(1,4) 191 : AM(2,4)=PROD1*ALF21(3) 192 : AM(3,1)=AM(1,3) 193 : AM(3,2)=AM(2,3) 194 : AM(3,5)=PROD2*ALF21(1) 195 : AM(3,6)=PROD2*ALF21(2) 196 : AM(3,7)=PROD2*ALF21(3) 197 : AM(3,8)=PROD2*ALF21(4) 198 : AM(4,1)=AM(1,4) 199 : AM(4,2)=AM(2,4) 200 : AM(4,5)=AM(3,6) 201 : AM(4,6)=AM(3,7) 202 : AM(4,7)=AM(3,8) 203 : AM(7,4)=AM(4,7) 204 : AM(4,8)=PROD2*ALF21(5) 205 : AM(5,3)=AM(3,5) 206 : AM(5,4)=AM(4,5) 207 : AM(6,3)=AM(3,6) 208 : AM(6,4)=AM(4,6) 209 : AM(7,3)=AM(3,7) 210 : AM(8,3)=AM(3,8) 211 : AM(8,4)=AM(4,8) 212 : 19 CONTINUE 212 : CALL MULMAT (S3,AM,A4,8,8,8) 212 : CALL MULMAT (AM,A1,S3,8,8,8) 213 : C 214 : C CALCUL FINAL DE LA MATRICE KSIGMA 215 : C 216 : IF(IFOU.EQ.1) THEN 217 : DO 32 NC=1,8 218 : DO 33 NCC=1,8 219 : REL(NCC,NC) =(A(NCC,NC)+AN*AM(NCC,NC))*2.D0 220 : 33 CONTINUE 221 : 32 CONTINUE 222 : ELSE IF(IFOU.EQ.0.OR.IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN 223 : DO 82 NC=1,6 224 : IC=II(NC) 225 : DO 83 NCC=1,6 226 : ICC=II(NCC) 227 : REL(NCC,NC) =(A(ICC,IC)+AN*AM(ICC,IC))*2.D0 228 : 83 CONTINUE 229 : 82 CONTINUE 230 : ENDIF 231 : RETURN 232 : END 233 : 234 : 235 : 236 : 237 : 238 : 239 :
© Cast3M 2003 - All rights reserved.
Disclaimer