C PIOCAF SOURCE PV 12/03/21 21:15:03 7323 SUBROUTINE PIOCAF(NBNN,nbsh,IDIM,TAB1,NCOELE,NBPTEL,SHP,XE1, 1 XE2,SH1,TAB,IFOU,KCAS,KERRE) C======================================================================= C C TRANSFORME LES CONTRAINTES DE PIOLA KIRCHHOFF EN CONTRAINTES DE C CAUCHY C ENTREE C ------- C NBNN = NOMBRE DE POINTS PAR ELEMENTS C NBSH = NOMBRE DE fonctions de forme C IDIM = DIMENSION DE L ESPACE SUPPORT C C TAB1(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE PIOLA KIRCHHOFF C C NCOELE = NOMBRE DE COMPOSTS TABLEAU DES CONTRAINTES C C NBPTEL = NOMBRE DE POINTS DE GAUSS C SHP(6,NBNN,NBPTEL)= FONCTIONS DE FORME C C KCAS = 1 SI CONTRAINTES, 2 SI DEFORMATIONS C C TABLEAUX DE TRAVAIL C-------------------- C XE1(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION DEPART C C XE2(3,NBNN) = COORDONNEES CORRESPONDANT A LA CONFIGURATION ACTUEL C C SH1(6,NBNN) = FONCTIONS DE FORME EN UN POINT DE GAUSS C C SORTIES C--------- C TAB(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE CAUCHY C C C AOUT 85 C MODIF PEGON FEV 90 CAS BIDIM C PASSAGE AUX NOUVEAUX CHAMELEMS PAR P.DOWLATYARI 12/4/91 C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C DIMENSION TAB1(NBPTEL,*) DIMENSION TAB(NBPTEL,*) *as xfem 2010_01_13 DIMENSION SHP(6,NBSH,*) * DIMENSION SHP(6,NBNN,*) *fin as xfem 2010_01_13 DIMENSION XE1(3,*),XE2(3,*),SH1(6,*) C C TABLEAUX DE TRAVAIL DIMENSIONNES ICI C DIMENSION XJAC(3,3),FAC(6) C C TABLEAUX INDIQUANT LA CORRESPONDANCE ENTRE INDICES I,J ET NUMERO C DE LA COMPOSANTE DE CONTRAINTES OU DE DEFORMATIONS C DIMENSION IN(6),JN(6),ITAB(3,3) C DATA FAC/1.D0,1.D0,1.D0,0.5D0,0.5D0,0.5D0/ DATA IN/1,2,3,1,1,2/ DATA JN/1,2,3,2,3,3/ C DATA ITAB(1,1),ITAB(1,2),ITAB(1,3)/1,4,5/ DATA ITAB(2,1),ITAB(2,2),ITAB(2,3)/4,2,6/ DATA ITAB(3,1),ITAB(3,2),ITAB(3,3)/5,6,3/ C C KERRE=0 C C MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS C DO 50 IA=1,NBPTEL DO 50 IB=1,NCOELE TAB(IA,IB)=0.D0 50 CONTINUE C C BOUCLE SUR LES POINTS DE GAUSS C DO 130 IC=1,NBPTEL CALL ZERO(XJAC,3,3) if (nbsh.ne.nbnn) then CALL HPRIMEX(XE1,NBNN,IDIM,NBSH,SHP,IC,SH1,DJAC) else CALL HPRIME(XE1,NBNN,IDIM,SHP,IC,SH1,DJAC) endif C C CALCUL DE LA MATRICE F C DO 140 ID=1,NBNN DO 140 IE=1,IDIM DO 140 IF=1,IDIM XJAC(IE,IF)=SH1(IF+1,ID)*XE2(IE,ID)+XJAC(IE,IF) 140 CONTINUE IF(IDIM.EQ.2) THEN XJAC(3,3)=1.D0 IF(IFOU.EQ.0) THEN C CCCCCCCCCCCCC CAS AXISYMETRIQUE C R1=0. R2=0. DO 150 ID=1,NBNN R1=R1+SH1(1,ID)*XE1(1,ID) R2=R2+SH1(1,ID)*XE2(1,ID) 150 CONTINUE XJAC(3,3)=R2/(R1+1.E-20) ENDIF ENDIF C C GO TO (500,600),KCAS C C KCAS=1 CAS DES CONTRAINTES C ---------------------------- C 500 CONTINUE C C CCCCCCCCCCCC CALCUL DE DETERMINANT DE F C IF(IDIM.EQ.2) THEN DETF=XJAC(1,1)*XJAC(2,2)-XJAC(1,2)*XJAC(2,1) DETF = DETF * XJAC (3,3) ENDIF IF(IDIM.EQ.3) THEN DETF=XJAC(1,1)*(XJAC(2,2)*XJAC(3,3)-XJAC(3,2)*XJAC(2,3)) DETF=DETF-XJAC(2,1)*(XJAC(1,2)*XJAC(3,3)-XJAC(3,2)*XJAC(1,3)) DETF=DETF+XJAC(3,1)*(XJAC(1,2)*XJAC(2,3)-XJAC(1,3)*XJAC(2,2)) ENDIF DETF=1./(DETF+1.E-20) C C CALCUL DES CONTRAINTES DE CAUCHY C DO 160 ID=1,NCOELE IND=IN(ID) JND=JN(ID) DO 170 IE=1,IDIM DO 170 IF=1,IDIM ICO=ITAB(IE,IF) TAB(IC,ID)=TAB1(IC,ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF 1 +TAB(IC,ID) 170 CONTINUE 160 CONTINUE C C PEGON : ON NE FAIT PAS LA TRANSFORMATION SUR LA 3-EME COMPOSANTE C IF(IDIM.EQ.2) THEN TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3)*DETF ENDIF GO TO 130 C C KCAS=2 CAS DES DEFORMATIONS C ----------------------------- C 600 CONTINUE C C CCCCCCCCCCCC CALCUL DE L'INVERSE DE F C CALL INVALM(XJAC,3,3,KERRE,1.D-14) IF(KERRE.NE.0) THEN WRITE(6,77881) ((XJAC(MI,MJ),MJ=1,3),MI=1,3) 77881 FORMAT(2X,' MATRICE SINGULIERE' /(3(1X,1PE12.5)/)) RETURN ENDIF C C CALCUL DES DEFORMATIONS C DO 260 ID=1,NCOELE IND=IN(ID) JND=JN(ID) DO 270 IE=1,IDIM DO 270 IF=1,IDIM ICO=ITAB(IE,IF) TAB(IC,ID)=TAB(IC,ID) + 1 FAC(ICO)*TAB1(IC,ICO)*XJAC(IE,IND)*XJAC(IF,JND)/FAC(ID) 270 CONTINUE 260 CONTINUE C C PEGON : ON NE FAIT PAS LA TRANSFORMATION SUR LA 3-EME COMPOSANTE C IF(IDIM.EQ.2) THEN TAB(IC,3)=TAB1(IC,3)*XJAC(3,3)*XJAC(3,3) ENDIF C 130 CONTINUE C RETURN END