1 : C CQTGR2 SOURCE CHAT 05/01/12 22:27:38 5004 2 : SUBROUTINE CQTGR2(XE,NBNN,NBPGAU,LRE,EPAIST,DZEGAU,SHPCOQ, 3 : 1 SHPELE,XDDL,XDDL1,GRADI) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : C |===================================================================== 7 : C | SOUS-PROGRAMME DE L'OPERATEUR GRADIENT (APPELE PAR GRAD1) 8 : C | CALCUL DU GRADIENT DE TEMPERATURE POUR LES ELEMENT COQ4,COQ6,COQ8 9 : C |== ENTREES 10 : C | XX(3,NBNN): TABLEAU DES COORDONNEES DES NOEUDS 11 : C | NBNN : NOMBRE DE NOUDS 12 : C | NBPGAU : NOMBRE DE POINTS DE GAUSS 13 : C | LRE : NOMBRE DE DDL 14 : C | EPAIST : EPAISSEUR DE LA COQUE 15 : C | DZEGAU(NBPGAU): COORDONNEES REDUITES DES POIN 16 : C | DE GAUSS DANS L EPAISSEUR 17 : C | SHPCOQ(6,NBNN,NBPGAU) :FONCTIONS DE FORME ET DERIVEES 18 : C | AUX POINTS DE GAUSS 19 : C | SHPELE(6,NBNN,NBNN) :FONCTIONS DE FORME ET DERIVEES AUX NOEUDS 20 : C | XDDL(LRE): TEMPERATURES AU NOEUDS 21 : C | XDDL1(LRE): TABLEAU DE TRAVAIL 22 : C |== SORTIES 23 : C | GRADI(2*NBPGAU):2 TERMS DE GRADIANT AUX NBPGAU POINTS DE GAUSS 24 : C | AUTEUR : P. DOWLATYARI 30/5/91 25 : C |===================================================================== 26 : -INC CCOPTIO 27 : DIMENSION DZEGAU(*),SHPCOQ(6,NBNN,*),SHPELE(6,NBNN,*) 28 : DIMENSION XE(3,*),GRADI(*),XDDL(*),XDDL1(*) 29 : DIMENSION TXR(3,3,8),BGR(2,24),TH(8),TT(9),EXC(8) 30 : DIMENSION XJ(3,3),XJI(3,3) 31 : PARAMETER (XZERO=0.D0,UN=1.D0,DEUX=2.D0) 32 : C 33 : C CALCUL DES AXES LOCAUX A TOUS LES NOEUDS 34 : C 34 : CALL CQ8LOC(XE,NBNN,SHPELE,TXR,IRR) 35 : IF(IRR.EQ.0)THEN 35 : CALL ERREUR(515) 36 : RETURN 37 : ENDIF 38 : C 39 : DO 10 I=1,NBNN 40 : TH(I)=EPAIST 41 : EXC(I)=0.D0 42 : 10 CONTINUE 43 : C 44 : C ON REORDONNE LES COMPOSANTES DE TEMPERATURES ET ON 45 : C LES MET DANS XDDL1 46 : C 47 : DO 11 I=1,LRE 48 : JJ=(I-1)/NBNN 49 : KK=I-JJ*NBNN 50 : II=(KK-1)*3+JJ+1 51 : XDDL1(I)=XDDL(II) 52 : 11 CONTINUE 53 : C 54 : C BOUCLE SUR LES POINTS DE GAUSS 55 : C 56 : C 57 : DO 100 IGAU=1,NBPGAU 57 : CALL ZERO(BGR,2,LRE) 58 : C 59 : C CALCUL DU JACOBIEN ET DE SON DETERMINENT EN CE POINT DE GAUSS 60 : C 61 : E3=DZEGAU(IGAU) 61 : CALL CQ8JCE(IGAU,NBNN,E3,XE,TH,EXC,TXR,SHPCOQ,XJ,DJAC,IRR) 62 : IF (IRR.LT.0)THEN 63 : * JACOBIEN NUL DANS L'ELEMENT IEL 64 : INTERR(1)=0 64 : CALL ERREUR (405) 65 : RETURN 66 : ENDIF 67 : * 68 : * INVERSION DU JACOBIEN 69 : * 70 : DUM =UN/DJAC 71 : XJI(1,1) = DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2)) 72 : XJI(2,1) = DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1)) 73 : XJI(3,1) = DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1)) 74 : XJI(1,2) = DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2)) 75 : XJI(2,2) = DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1)) 76 : XJI(3,2) = DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1)) 77 : XJI(1,3) = DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2)) 78 : XJI(2,3) = DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1)) 79 : XJI(3,3) = DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1)) 80 : * 81 : * DETERMINATION DES COSINUS DIRECTEURS DES AXES LOCAUX EN CE POINT 82 : * 83 : * COQ8 COQ6 84 : IF(NBNN.EQ.8.OR.NBNN.EQ.6)THEN 85 : * 86 : DO 20 I=1,3 87 : DO 20 J=1,2 88 : K=3*(J-1)+I 89 : TT(K) = XJ(J,I) 90 : 20 CONTINUE 91 : * 92 : * PRODUITS VECTORIELS ET NORMALISATIONS 93 : * 93 : CALL CROSS2(TT(1),TT(4),TT(7),IRR) 93 : CALL CROSS2(TT(7),TT(1),TT(4),IRR) 93 : CALL CROSS2(TT(4),TT(7),TT(1),IRR) 94 : * 95 : ELSE 96 : IF(IGAU.EQ.1)THEN 97 : * 98 : * CALCUL DES AXES LOCAUX DE L 'ELEMENT COQ4 99 : * 100 : * DIAGONALE 1 101 : * 102 : TT(1)=XE(1,3)-XE(1,1) 103 : TT(2)=XE(2,3)-XE(2,1) 104 : TT(3)=XE(3,3)-XE(3,1) 105 : * 106 : * DIAGONALE 2 107 : * 108 : TT(4)=XE(1,4)-XE(1,2) 109 : TT(5)=XE(2,4)-XE(2,2) 110 : TT(6)=XE(3,4)-XE(3,2) 111 : * 112 : * NORMALE AUX 2 DIAGONALES 113 : * 113 : CALL CROSS2(TT(1),TT(4),TT(7),IRR) 114 : * 115 : TT(1)=XE(1,2)-XE(1,1) 116 : TT(2)=XE(2,2)-XE(2,1) 117 : TT(3)=XE(3,2)-XE(3,1) 118 : * 118 : CALL CROSS2(TT(7),TT(1),TT(4),IRR) 118 : CALL CROSS2(TT(4),TT(7),TT(1),IRR) 119 : * 120 : ENDIF 121 : ENDIF 122 : IF(IRR.EQ.0) THEN 123 : * ECHEC DANS LE CALCUL DES AXES LOCAUX 123 : CALL ERREUR(515) 124 : RETURN 125 : ENDIF 126 : * 127 : * 128 : * PRODUIT MATRICIEL TT TRANSPOSE * XJI 129 : * 130 : DO 30 I=1,3 131 : DO 30 J=1,3 132 : XJ(I,J)=XZERO 133 : DO 30 K=1,3 134 : K1=3*(I-1)+K 135 : XJ(I,J) = XJ(I,J)+TT(K1)*XJI(K,J) 136 : 30 CONTINUE 137 : * 138 : * CALCUL DE LA MATRICE DE GRADIENT DES FONCTIONS DE FORME 139 : * DANS LE REPERE LOCAL 140 : * 141 : NBNN2=2*NBNN 142 : DO 40 K = 1,LRE 143 : DO 40 I = 1,2 144 : DO 40 J = 1,3 145 : JJ=J+1 146 : IF(JJ.EQ.4)JJ=1 147 : IF(K.LE.NBNN)THEN 148 : KK=K 149 : IF(J.LE.2)THEN 150 : COEF=(E3/DEUX)*(E3-UN) 151 : ELSE 152 : COEF=E3-UN/DEUX 153 : ENDIF 154 : ELSEIF(K.GT.NBNN.AND.K.LE.NBNN2)THEN 155 : KK=K-NBNN 156 : IF(J.LE.2)THEN 157 : COEF=UN-E3*E3 158 : ELSE 159 : COEF=-DEUX*E3 160 : ENDIF 161 : ELSE 162 : KK=K-NBNN2 163 : IF(J.LE.2)THEN 164 : COEF=(E3/DEUX)*(E3+UN) 165 : ELSE 166 : COEF=E3+UN/DEUX 167 : ENDIF 168 : ENDIF 169 : BGR(I,K)=BGR(I,K)+COEF*SHPCOQ(JJ,KK,IGAU)*XJ(I,J) 170 : 40 CONTINUE 171 : C 172 : C CALCUL DE BGR*XDDL 173 : C 174 : IG=(IGAU-1)*2+1 174 : CALL BGRDEP(BGR,2,XDDL1,LRE,GRADI(IG)) 175 : C 176 : 100 CONTINUE 177 : C 178 : RETURN 179 : END 180 :
© Cast3M 2003 - All rights reserved.
Disclaimer