1 : C TRIHR1 SOURCE CHAT 05/01/13 03:47:22 5004 2 : SUBROUTINE TRIHR1(IGAU,ITEL,MFR,NBNO,IFOU,NIFOU,XEL, 3 : # SHPTOT,SHP,NST,ISDJC,XGENE,DJAC,IRET) 4 : C======================================================================= 5 : C 6 : C CALCULE LA MATRICE XGENE (NECESSAIRE POUR LE CALCUL DE LA MATRICE 7 : C DE RIGIDITE DANS LE CAS DE LA FORMULATION (37) HOMOGENE ) 8 : C ROUTINE FORTRAN PUR 9 : C======================================================================= 10 : C INPUT 11 : C IGAU=NUMERO DU POINT DE GAUSS 12 : C ITEL=NUMERO DE L ELEMENT DANS NOMTP 13 : C MFR =NUMERO DE LA FORMULATION 14 : C NBNO=NOMBRE DE NOEUDS 15 : C LRE =NOMBRE DE COLONNES DE LA MATRICE B 16 : C IFOU=IFOUR DE CCOPTIO 17 : C NIFOU=NIFOUR DE CCOPTIO 18 : C XEL =COORDONNEES DE L ELEMENT 19 : C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES 20 : C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN 21 : C ZONE DE TRAVAIL 22 : C SHP(6,NBNO)=TABLEAU DE TRAVAIL 23 : C OUTPUT 24 : C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN 25 : C NST =NBRE DE COLONNES DE LA MATRICE XGENE 26 : C DJAC=JACOBIEN 27 : C XGENE(NBNO,NST)=MATRICE (DE FONCTION DE FORME ) 28 : C IRET= INDICATEUR = 1 : SUCCES 29 : C = 0 : ECHEC (ELEMENT INCOMPATIBLE ) 30 : C = 2 : ECHEC (JACOBIEN NUL ) 31 : C======================================================================= 32 : IMPLICIT INTEGER(I-N) 33 : IMPLICIT REAL*8(A-H,O-Z) 34 : DIMENSION XEL(3,*),XGENE(NBNO,3),SHP(6,*),SHPTOT(6,NBNO,*) 35 : IF (ITEL.EQ.92.OR.ITEL.EQ.157) GOTO 10 36 : C 37 : C ERREUR : TYPE D' ELEMENT INCOMPATIBLE AVEC LA FORMULATION 38 : C 39 : IRET = 0 40 : GOTO 666 41 : 10 CONTINUE 42 : DO 101 NP=1,NBNO 43 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 44 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 45 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 46 : 101 CONTINUE 46 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,2,1.D0,RR,DJAC) 47 : IF (DJAC.LT.0.) ISDJC = ISDJC + 1 48 : IF ( DJAC.EQ.0.) GOTO 667 49 : DJAC = ABS(DJAC) 50 : IF (IFOU.EQ.0.OR.IFOU.EQ.1) THEN 51 : C 52 : C CAS AXISYMETRIQUE OU FOURIER 53 : C NST = 3 54 : C 55 : NST = 3 55 : CALL ZERO(XGENE,NBNO,NST) 56 : DO 103 NP=1,NBNO 57 : XGENE(NP,1)=SHP(1,NP) 58 : 103 CONTINUE 59 : A1 = XEL(2,2) - XEL(2,3) 60 : A2 = XEL(2,3) - XEL(2,1) 61 : A3 = XEL(2,1) - XEL(2,2) 62 : B1 = XEL(1,3) - XEL(1,2) 63 : B2 = XEL(1,1) - XEL(1,3) 64 : B3 = XEL(1,2) - XEL(1,1) 65 : C 66 : C XJAC EST LE JACOBIEN ( 2*SURFACE DU TRIANGLE ) 67 : C 68 : XJAC = (B3*A2 -B2*A3) 69 : IF ( XJAC.EQ.0.) GOTO 667 70 : C 71 : C (LI = CI + AI*R + BI*Z ) 72 : C 73 : B1 = B1/XJAC 74 : B2 = B2/XJAC 75 : B3 = B3/XJAC 76 : C 77 : C XGENE(NBNO,2 ) = DERIVEE 2ND PAR RAPPORT A Z DES FONCTIONS 78 : C D' INTERPOLATIONS (CUBIQUE) 79 : C N1= L1+(L1**2)*L2+(L1**2)*L3-L1*(L2**2)-L1*(L3**2) 80 : C INTERPOLATION DES DEPLACEMENTS 81 : C 82 : XGENE(1,2)=2.D0*(2.D0*B1*(B2+B3)-B2*B2-B3*B3)*XGENE(1,1)+2.D0*B1* 83 : #(B1-2.D0*B2)*XGENE(2,1)+2.D0*B1*(B1-2.D0*B3)*XGENE(3,1) 84 : XGENE(2,2)=2.D0*(2.D0*B2*(B3+B1)-B3*B3-B1*B1)*XGENE(2,1)+2.D0*B2* 85 : #(B2-2.D0*B3)*XGENE(3,1)+2.D0*B2*(B2-2.D0*B1)*XGENE(1,1) 86 : XGENE(3,2)=2.D0*(2.D0*B3*(B1+B2)-B1*B1-B2*B2)*XGENE(3,1)+2.D0*B3* 87 : #(B3-2.D0*B1)*XGENE(1,1)+2.D0*B3*(B3-2.D0*B2)*XGENE(2,1) 88 : C 89 : C XGENE(NBNO,3) = DERIVEE 2ND PAR RAPPORT A Z DES FONCTIONS 90 : C D' INTERPOLATIONS (CUBIQUE) 91 : C N2= A2*(L3*(L1**2)+0.5*L1*L2*L3)-A3*(L2*(L1**2)+0.5*L1*L2*L3) 92 : C INTERPOLATION DES ROTATIONS 93 : C 94 : XGENE(1,3)=(4.D0*B1*(A2*B3-A3*B2)+(A2-A3)*B2*B3)*XGENE(1,1)+ 95 : # (2.D0*A2*B1*B1+(A2-A3)*B1*B2)*XGENE(3,1)+ 96 : # ((A2-A3)*B1*B3-2.D0*A3*B1*B1)*XGENE(2,1) 97 : XGENE(2,3)=(4.D0*B2*(A3*B1-A1*B3)+(A3-A1)*B3*B1)*XGENE(2,1)+ 98 : # (2.D0*A3*B2*B2+(A3-A1)*B2*B3)*XGENE(1,1)+ 99 : # ((A3-A1)*B2*B1-2.D0*A1*B2*B2)*XGENE(3,1) 100 : XGENE(3,3)=(4.D0*B3*(A1*B2-A2*B1)+(A1-A2)*B1*B2)*XGENE(3,1)+ 101 : # (2.D0*A1*B3*B3+(A1-A2)*B3*B1)*XGENE(2,1)+ 102 : # ((A1-A2)*B3*B2-2.D0*A2*B3*B3)*XGENE(1,1) 103 : IRET=1 104 : ELSE 105 : C 106 : C NST = 1 CAS PLAN 107 : C XGENE(I,1) = ( L1 , L2 , L3 ) POUR L ELEMENT TRIH (NBNO =3) 108 : C 109 : NST = 1 109 : CALL ZERO(XGENE,NBNO,NST) 110 : DO 102 NP=1,NBNO 111 : XGENE(NP,1)=SHP(1,NP) 112 : 102 CONTINUE 113 : IRET=1 114 : ENDIF 115 : GOTO 666 116 : 667 CONTINUE 117 : C 118 : C JACOBIEN NUL 119 : C 120 : IRET = 2 121 : C 122 : 666 CONTINUE 123 : RETURN 124 : END 125 : 126 : 127 : 128 :
© Cast3M 2003 - All rights reserved.
Disclaimer