1 : C CUBHR1 SOURCE CHAT 05/01/12 22:32:36 5004 2 : C CUBHR1 SOURCE AM1 95/11/24 22:55:49 1918 3 : SUBROUTINE CUBHR1(IGAU,ITEL,MFR,NBNO,NIFOU,XEL, 4 : # SHPTOT,SHP,NST,ISDJC,XGENE,DJAC,IRET) 5 : C======================================================================= 6 : C 7 : C CALCULE LA MATRICE XGENE (NECESSAIRE POUR LE CALCUL DE LA MATRICE 8 : C DE RIGIDITE DANS LE CAS DE LA FORMULATION (37) HOMOGENE ) 9 : C ROUTINE FORTRAN PUR 10 : C======================================================================= 11 : C INPUT 12 : C IGAU=NUMERO DU POINT DE GAUSS 13 : C ITEL=NUMERO DE L ELEMENT DANS NOMTP 14 : C MFR =NUMERO DE LA FORMULATION 15 : C NBNO=NOMBRE DE NOEUDS 16 : C LRE =NOMBRE DE COLONNES DE LA MATRICE B 17 : C IFOU=IFOUR DE CCOPTIO 18 : C NIFOU=NIFOUR DE CCOPTIO 19 : C XEL =COORDONNEES DE L ELEMENT 20 : C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES 21 : C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN 22 : C ZONE DE TRAVAIL 23 : C SHP(6,NBNO)=TABLEAU DE TRAVAIL 24 : C OUTPUT 25 : C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN 26 : C NST =NBRE DE COLONNES DE LA MATRICE XGENE 27 : C DJAC=JACOBIEN 28 : C XGENE(NBNO,NST)=MATRICE (DE FONCTION DE FORME ) 29 : C IRET= INDICATEUR = 1 : SUCCES 30 : C = 0 : ECHEC (ELEMENT INCOMPATIBLE ) 31 : C = 2 : ECHEC (JACOBIEN NUL ) 32 : C======================================================================= 33 : IMPLICIT INTEGER(I-N) 34 : IMPLICIT REAL*8(A-H,O-Z) 35 : DIMENSION XEL(3,*),XGENE((NBNO*2),2),SHP(6,*),SHPTOT(6,NBNO,*) 36 : IF (ITEL.EQ.127) GOTO 10 37 : C 38 : C ERREUR : TYPE D' ELEMENT INCOMPATIBLE AVEC LA FORMULATION 39 : C 40 : IRET = 0 41 : GOTO 666 42 : 10 CONTINUE 43 : DO 101 NP=1,NBNO 44 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 45 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 46 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 47 : SHP(4,NP)=SHPTOT(4,NP,IGAU) 48 : 101 CONTINUE 49 : IDIM=3 49 : CALL JACOBI(XEL,SHP,IDIM,NBNO,DJAC) 50 : C WRITE(6,*)'DJAC1',DJAC 51 : IRET = 1 52 : IF (DJAC.LT.0.) ISDJC = ISDJC + 1 53 : DJAC = ABS(DJAC) 54 : C 55 : C CAS D'UN CALCUL TRIDIMENSIONNEL 56 : C 57 : NST = 2 58 : C 58 : CALL ZERO(XGENE,NBNO,NST) 59 : DO 103 NP=1,NBNO 60 : XGENE(NP,1)=SHP(1,NP) 61 : 103 CONTINUE 62 : C 63 : A1 = XEL(3,8) - XEL(3,1) 64 : A1 = ABS(A1) 65 : A2 = XEL(3,7) - XEL(3,1) 66 : A2 = ABS(A2) 67 : A3 = XEL(3,6) - XEL(3,1) 68 : A3 = ABS(A3) 69 : A4 = XEL(3,5) - XEL(3,1) 70 : A4 = ABS(A4) 71 : A5 = XEL(3,4) - XEL(3,1) 72 : A5 = ABS(A5) 73 : A6 = XEL(3,3) - XEL(3,1) 74 : A6 = ABS(A6) 75 : A7 = XEL(3,2) - XEL(3,1) 76 : A7 = ABS(A7) 77 : C 78 : A3 = (0.25D0)*(A1+A2+A3+A4+A5+A6+A7) 79 : C 80 : S1=SHP(1,1)+SHP(1,4)+SHP(1,5)+SHP(1,8) 81 : S2=SHP(1,2)+SHP(1,3)+SHP(1,6)+SHP(1,7) 82 : C 83 : T1=SHP(1,1)+SHP(1,2)+SHP(1,5)+SHP(1,6) 84 : T2=SHP(1,3)+SHP(1,4)+SHP(1,7)+SHP(1,8) 85 : C 86 : ZH=SHP(1,5)+SHP(1,6)+SHP(1,7)+SHP(1,8) 87 : C 88 : C DERIVEES SECONDES DES FONCTIONS Z 89 : C 90 : ZS1=(-6.D0/(A3**2))+((12.D0/(A3**2))*ZH) 91 : ZS2=-1.D0*ZS1 92 : ZS3=(-4.D0/A3)+((6.D0/A3)*ZH) 93 : ZS4=(-2.D0/A3)+((6.D0/A3)*ZH) 94 : C 95 : C FONCTIONS UTILISEES DANS TRIHR2.ESO 96 : C 97 : XGENE(1,2)=S1*T1*ZS1 98 : XGENE(2,2)=S2*T1*ZS1 99 : XGENE(3,2)=S2*T2*ZS1 100 : XGENE(4,2)=S1*T2*ZS1 101 : XGENE(5,2)=S1*T1*ZS2 102 : XGENE(6,2)=S2*T1*ZS2 103 : XGENE(7,2)=S2*T2*ZS2 104 : XGENE(8,2)=S1*T2*ZS2 105 : 106 : XGENE(9,2)=S1*T1*ZS3 107 : XGENE(10,2)=S2*T1*ZS3 108 : XGENE(11,2)=S2*T2*ZS3 109 : XGENE(12,2)=S1*T2*ZS3 110 : XGENE(13,2)=S1*T1*ZS4 111 : XGENE(14,2)=S2*T1*ZS4 112 : XGENE(15,2)=S2*T2*ZS4 113 : XGENE(16,2)=S1*T2*ZS4 114 : C 115 : IRET=1 116 : C 117 : 666 CONTINUE 118 : RETURN 119 : END 120 : 121 : 122 : 123 :
© Cast3M 2003 - All rights reserved.
Disclaimer