1 : C PICAF2 SOURCE CHAT 05/02/25 21:16:16 5035 2 : SUBROUTINE PICAF2(NBNN,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 IDIM = DIMENSION DE L ESPACE SUPPORT 12 : C 13 : C TAB1(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE PIOLA KIRCHHOFF 14 : C 15 : C NCOELE = NOMBRE DE COMPOSTS TABLEAU DES CONTRAINTES 16 : C 17 : C NBPTEL = NOMBRE DE POINTS DE GAUSS 18 : C SHP(6,NBNN,NBPTEL)= FONCTIONS DE FORME 19 : C 20 : C KCAS = 1 SI CONTRAINTES, 2 SI DEFORMATIONS 21 : C 22 : C TABLEAUX DE TRAVAIL 23 : C-------------------- 24 : C XE1(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION DEPART 25 : C 26 : C XE2(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION ACTUEL 27 : C 28 : C SH1(6,NBNN) = FONCTIONS DE FORME EN UN POINT DE GAUSS 29 : C 30 : C SORTIES 31 : C--------- 32 : C TAB(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE CAUCHY 33 : C 34 : C 35 : C AOUT 85 36 : C MODIF PEGON FEV 90 CAS BIDIM 37 : C PASSAGE AUX NOUVEAUX CHAMELEMS PAR P.DOWLATYARI 12/4/91 38 : C 39 : C======================================================================= 40 : IMPLICIT REAL*8(A-H,O-Z) 41 : C 42 : DIMENSION TAB1(NBPTEL,*) 43 : DIMENSION TAB(NBPTEL,*) 44 : DIMENSION SHP(6,NBNN,*) 45 : DIMENSION XE1(3,*),XE2(3,*),SH1(6,*) 46 : C 47 : C TABLEAUX DE TRAVAIL DIMENSIONNES ICI 48 : C 49 : DIMENSION XJAC(3,3),FAC(6) 50 : C 51 : C TABLEAUX INDIQUANT LA CORRESPONDANCE ENTRE INDICES I,J ET NUMERO 52 : C DE LA COMPOSANTE DE CONTRAINTES OU DE DEFORMATIONS 53 : C 54 : DIMENSION IN(3),JN(3),ITAB(2,2) 55 : C 56 : DATA IN/1,2,1/ 57 : DATA JN/1,2,2/ 58 : C 59 : DATA ITAB(1,1),ITAB(1,2)/1,3/ 60 : DATA ITAB(2,1),ITAB(2,2)/3,2/ 61 : C 62 : C 63 : KERRE=0 64 : C 65 : C MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS 66 : C 67 : DO 50 IA=1,NBPTEL 68 : DO 50 IB=1,NCOELE 69 : TAB(IA,IB)=0.D0 70 : 50 CONTINUE 71 : C 72 : C BOUCLE SUR LES POINTS DE GAUSS 73 : C 74 : DO 130 IC=1,NBPTEL 74 : CALL ZERO(XJAC,3,3) 74 : CALL HPRIME(XE1,NBNN,2,SHP,IC,SH1,DJAC) 75 : C 76 : C CALCUL DE LA MATRICE F 77 : C 78 : DO 140 ID=1,NBNN 79 : DO 140 IE=1,2 80 : DO 140 IF=1,2 81 : XJAC(IE,IF)=SH1(IF+1,ID)*XE2(IE,ID)+XJAC(IE,IF) 82 : 140 CONTINUE 83 : XJAC(3,3)=1.D0 84 : 85 : C CALCUL DE DETERMINANT DE F 86 : C 87 : DETF=XJAC(1,1)*XJAC(2,2)-XJAC(1,2)*XJAC(2,1) 88 : DETF = DETF * XJAC (3,3) 89 : DETF=1./(DETF+1.E-20) 90 : C 91 : C CALCUL DES CONTRAINTES DE CAUCHY 92 : C 93 : DO 160 ID=1,3 94 : IND=IN(ID) 95 : JND=JN(ID) 96 : DO 170 IE=1,2 97 : DO 170 IF=1,2 98 : ICO=ITAB(IE,IF) 99 : TAB(IC,ID)=TAB1(IC,ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF 100 : 1 +TAB(IC,ID) 101 : 170 CONTINUE 102 : 160 CONTINUE 103 : 104 : DO 180 ID=1,3 105 : IND=IN(ID) 106 : JND=JN(ID) 107 : DO 190 IE=1,2 108 : DO 190 IF=1,2 109 : ICO=ITAB(IE,IF) 110 : TAB(IC,3+ID)=TAB1(IC,3+ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF 111 : 1 +TAB(IC,3+ID) 112 : 190 CONTINUE 113 : 180 CONTINUE 114 : 130 CONTINUE 115 : C 116 : RETURN 117 : END 118 : 119 :
© Cast3M 2003 - All rights reserved.
Disclaimer