1 : C PIOCAF SOURCE PV 12/03/21 21:15:03 7323 2 : SUBROUTINE PIOCAF(NBNN,nbsh,IDIM,TAB1,NCOELE,NBPTEL,SHP,XE1, 3 : 1 XE2,SH1,TAB,IFOU,KCAS,KERRE) 4 : C======================================================================= 5 : C 6 : C TRANSFORME LES CONTRAINTES DE PIOLA KIRCHHOFF EN CONTRAINTES DE 7 : C CAUCHY 8 : C ENTREE 9 : C ------- 10 : C NBNN = NOMBRE DE POINTS PAR ELEMENTS 11 : C NBSH = NOMBRE DE fonctions de forme 12 : C IDIM = DIMENSION DE L ESPACE SUPPORT 13 : C 14 : C TAB1(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE PIOLA KIRCHHOFF 15 : C 16 : C NCOELE = NOMBRE DE COMPOSTS TABLEAU DES CONTRAINTES 17 : C 18 : C NBPTEL = NOMBRE DE POINTS DE GAUSS 19 : C SHP(6,NBNN,NBPTEL)= FONCTIONS DE FORME 20 : C 21 : C KCAS = 1 SI CONTRAINTES, 2 SI DEFORMATIONS 22 : C 23 : C TABLEAUX DE TRAVAIL 24 : C-------------------- 25 : C XE1(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION DEPART 26 : C 27 : C XE2(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION ACTUEL 28 : C 29 : C SH1(6,NBNN) = FONCTIONS DE FORME EN UN POINT DE GAUSS 30 : C 31 : C SORTIES 32 : C--------- 33 : C TAB(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE CAUCHY 34 : C 35 : C 36 : C AOUT 85 37 : C MODIF PEGON FEV 90 CAS BIDIM 38 : C PASSAGE AUX NOUVEAUX CHAMELEMS PAR P.DOWLATYARI 12/4/91 39 : C 40 : C======================================================================= 41 : IMPLICIT INTEGER(I-N) 42 : IMPLICIT REAL*8(A-H,O-Z) 43 : C 44 : DIMENSION TAB1(NBPTEL,*) 45 : DIMENSION TAB(NBPTEL,*) 46 : *as xfem 2010_01_13 47 : DIMENSION SHP(6,NBSH,*) 48 : * DIMENSION SHP(6,NBNN,*) 49 : *fin as xfem 2010_01_13 50 : DIMENSION XE1(3,*),XE2(3,*),SH1(6,*) 51 : C 52 : C TABLEAUX DE TRAVAIL DIMENSIONNES ICI 53 : C 54 : DIMENSION XJAC(3,3),FAC(6) 55 : C 56 : C TABLEAUX INDIQUANT LA CORRESPONDANCE ENTRE INDICES I,J ET NUMERO 57 : C DE LA COMPOSANTE DE CONTRAINTES OU DE DEFORMATIONS 58 : C 59 : DIMENSION IN(6),JN(6),ITAB(3,3) 60 : C 61 : DATA FAC/1.D0,1.D0,1.D0,0.5D0,0.5D0,0.5D0/ 62 : DATA IN/1,2,3,1,1,2/ 63 : DATA JN/1,2,3,2,3,3/ 64 : C 65 : DATA ITAB(1,1),ITAB(1,2),ITAB(1,3)/1,4,5/ 66 : DATA ITAB(2,1),ITAB(2,2),ITAB(2,3)/4,2,6/ 67 : DATA ITAB(3,1),ITAB(3,2),ITAB(3,3)/5,6,3/ 68 : C 69 : C 70 : KERRE=0 71 : C 72 : C MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS 73 : C 74 : DO 50 IA=1,NBPTEL 75 : DO 50 IB=1,NCOELE 76 : TAB(IA,IB)=0.D0 77 : 50 CONTINUE 78 : C 79 : C BOUCLE SUR LES POINTS DE GAUSS 80 : C 81 : DO 130 IC=1,NBPTEL 81 : CALL ZERO(XJAC,3,3) 82 : if (nbsh.ne.nbnn) then 82 : CALL HPRIMEX(XE1,NBNN,IDIM,NBSH,SHP,IC,SH1,DJAC) 83 : else 83 : CALL HPRIME(XE1,NBNN,IDIM,SHP,IC,SH1,DJAC) 84 : endif 85 : C 86 : C CALCUL DE LA MATRICE F 87 : C 88 : DO 140 ID=1,NBNN 89 : DO 140 IE=1,IDIM 90 : DO 140 IF=1,IDIM 91 : XJAC(IE,IF)=SH1(IF+1,ID)*XE2(IE,ID)+XJAC(IE,IF) 92 : 140 CONTINUE 93 : IF(IDIM.EQ.2) THEN 94 : XJAC(3,3)=1.D0 95 : IF(IFOU.EQ.0) THEN 96 : C 97 : CCCCCCCCCCCCC CAS AXISYMETRIQUE 98 : C 99 : R1=0. 100 : R2=0. 101 : DO 150 ID=1,NBNN 102 : R1=R1+SH1(1,ID)*XE1(1,ID) 103 : R2=R2+SH1(1,ID)*XE2(1,ID) 104 : 150 CONTINUE 105 : XJAC(3,3)=R2/(R1+1.E-20) 106 : ENDIF 107 : ENDIF 108 : C 109 : C 110 : GO TO (500,600),KCAS 111 : C 112 : C KCAS=1 CAS DES CONTRAINTES 113 : C ---------------------------- 114 : C 115 : 500 CONTINUE 116 : C 117 : C 118 : CCCCCCCCCCCC CALCUL DE DETERMINANT DE F 119 : C 120 : IF(IDIM.EQ.2) THEN 121 : DETF=XJAC(1,1)*XJAC(2,2)-XJAC(1,2)*XJAC(2,1) 122 : DETF = DETF * XJAC (3,3) 123 : ENDIF 124 : IF(IDIM.EQ.3) THEN 125 : DETF=XJAC(1,1)*(XJAC(2,2)*XJAC(3,3)-XJAC(3,2)*XJAC(2,3)) 126 : DETF=DETF-XJAC(2,1)*(XJAC(1,2)*XJAC(3,3)-XJAC(3,2)*XJAC(1,3)) 127 : DETF=DETF+XJAC(3,1)*(XJAC(1,2)*XJAC(2,3)-XJAC(1,3)*XJAC(2,2)) 128 : ENDIF 129 : DETF=1./(DETF+1.E-20) 130 : C 131 : C CALCUL DES CONTRAINTES DE CAUCHY 132 : C 133 : DO 160 ID=1,NCOELE 134 : IND=IN(ID) 135 : JND=JN(ID) 136 : DO 170 IE=1,IDIM 137 : DO 170 IF=1,IDIM 138 : ICO=ITAB(IE,IF) 139 : TAB(IC,ID)=TAB1(IC,ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF 140 : 1 +TAB(IC,ID) 141 : 170 CONTINUE 142 : 160 CONTINUE 143 : C 144 : C PEGON : ON NE FAIT PAS LA TRANSFORMATION SUR LA 3-EME COMPOSANTE 145 : C 146 : IF(IDIM.EQ.2) THEN 147 : TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3)*DETF 148 : ENDIF 149 : GO TO 130 150 : C 151 : C KCAS=2 CAS DES DEFORMATIONS 152 : C ----------------------------- 153 : C 154 : 600 CONTINUE 155 : C 156 : C 157 : CCCCCCCCCCCC CALCUL DE L'INVERSE DE F 158 : C 158 : CALL INVALM(XJAC,3,3,KERRE,1.D-14) 159 : IF(KERRE.NE.0) THEN 160 : WRITE(6,77881) ((XJAC(MI,MJ),MJ=1,3),MI=1,3) 161 : 77881 FORMAT(2X,' MATRICE SINGULIERE' /(3(1X,1PE12.5)/)) 162 : RETURN 163 : ENDIF 164 : C 165 : C CALCUL DES DEFORMATIONS 166 : C 167 : DO 260 ID=1,NCOELE 168 : IND=IN(ID) 169 : JND=JN(ID) 170 : DO 270 IE=1,IDIM 171 : DO 270 IF=1,IDIM 172 : ICO=ITAB(IE,IF) 173 : TAB(IC,ID)=TAB(IC,ID) + 174 : 1 FAC(ICO)*TAB1(IC,ICO)*XJAC(IE,IND)*XJAC(IF,JND)/FAC(ID) 175 : 270 CONTINUE 176 : 260 CONTINUE 177 : C 178 : C PEGON : ON NE FAIT PAS LA TRANSFORMATION SUR LA 3-EME COMPOSANTE 179 : C 180 : IF(IDIM.EQ.2) THEN 181 : TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3) 182 : ENDIF 183 : C 184 : 130 CONTINUE 185 : C 186 : RETURN 187 : END 188 : 189 : 190 : 191 : 192 :
© Cast3M 2003 - All rights reserved.
Disclaimer