1 : C QUAHR1 SOURCE CHAT 05/01/13 02:41:02 5004 2 : C QUAHR1 SOURCE AM1 95/11/24 22:55:49 1918 3 : SUBROUTINE QUAHR1(IGAU,ITEL,MFR,NBNO,IFOU,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+NBNO),3),SHP(6,*),SHPTOT(6,NBNO,*) 36 : C PARAMETER(XZER=0.D0) 37 : IF (ITEL.EQ.126) GOTO 10 38 : C 39 : C ERREUR : TYPE D' ELEMENT INCOMPATIBLE AVEC LA FORMULATION 40 : C 41 : IRET = 0 42 : GOTO 666 43 : 10 CONTINUE 44 : DO 101 NP=1,NBNO 45 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 46 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 47 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 48 : 101 CONTINUE 48 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,2,1.D0,RR,DJAC) 49 : C WRITE(6,*)'RR=',RR 50 : C WRITE(6,*)'DJAC=',DJAC 51 : C WRITE(6,*)'SHP(1,1)=',SHP(1,1) 52 : IF (DJAC.LT.0.) ISDJC = ISDJC + 1 53 : IF ( DJAC.EQ.0.) GOTO 667 54 : DJAC = ABS(DJAC) 55 : C 56 : C CAS DE L'ELEMENT QUAH 57 : C 58 : C 59 : NST = 2 59 : CALL ZERO(XGENE,NBNO,NST) 60 : DO 113 NP=1,NBNO 61 : XGENE(NP,1)=SHP(1,NP) 62 : 113 CONTINUE 63 : C 64 : C FONCTIONS DE FORME 65 : 66 : SHP(4,1)=SHP(1,1) + SHP(1,4) 67 : SHP(4,2)=SHP(1,2) + SHP(1,3) 68 : SHP(4,3)=0.D0 69 : SHP(4,4)=0.D0 70 : C 71 : A1=MIN(XEL(2,1),XEL(2,2)) 72 : A2=MIN(XEL(2,1),XEL(2,3)) 73 : A3=MIN(XEL(2,1),XEL(2,4)) 74 : A4=MIN(A1,A2) 75 : A5=MIN(A1,A3) 76 : Z1=MIN(A4,A5) 77 : C WRITE(6,*)'Z1',Z1 78 : C 79 : B1=MAX(XEL(2,1),XEL(2,2)) 80 : B2=MAX(XEL(2,1),XEL(2,3)) 81 : B3=MAX(XEL(2,1),XEL(2,4)) 82 : B4=MAX(B1,B2) 83 : B5=MAX(B1,B3) 84 : Z2=MAX(B4,B5) 85 : C WRITE(6,*)'Z2',Z2 86 : C 87 : RH=Z2-Z1 88 : XZH=SHP(1,3) + SHP(1,4) 89 : C 90 : S1=SHP(1,1) + SHP(1,4) 91 : S2=SHP(1,2) + SHP(1,3) 92 : C 93 : C FONCTIONS DE FORME EN Z 94 : C 95 : SHP(5,1)=1.D0-3.D0*XZH*XZH+2.D0*XZH*XZH*XZH 96 : SHP(5,2)=3.D0*XZH*XZH-2.D0*XZH*XZH*XZH 97 : C 98 : SHP(5,3)=(RH*XZH)*(1.D0-2.D0*XZH+XZH*XZH) 99 : SHP(5,4)=(RH*XZH)*(XZH*XZH-XZH) 100 : C 101 : C DERIVEES SECONDES / A Z DES FONCTIONS DE FORME EN Z 102 : C 103 : SHP(6,1)=(-6.D0/(RH**2))+((12.D0/(RH**2))*XZH) 104 : SHP(6,2)=-1.D0*SHP(6,1) 105 : SHP(6,3)=(-4.D0/RH)+((6.D0/RH)*XZH) 106 : SHP(6,4)=(-2.D0/RH)+((6.D0/RH)*XZH) 107 : C 108 : C DERIVEES SECONDES DES FONCTIONS DE FORME POUR LA FLEXION 109 : C 110 : C POUR LES DEPLACEMENTS 111 : C 112 : XGENE(1,2)=S1*SHP(6,1) 113 : XGENE(2,2)=S2*SHP(6,1) 114 : XGENE(3,2)=S2*SHP(6,2) 115 : XGENE(4,2)=S1*SHP(6,2) 116 : C 117 : C POUR LES ROTATIONS 118 : C 119 : XGENE(5,2)=S1*SHP(6,3) 120 : XGENE(6,2)=S2*SHP(6,3) 121 : XGENE(7,2)=S2*SHP(6,4) 122 : XGENE(8,2)=S1*SHP(6,4) 123 : C 124 : IRET=1 125 : C 126 : GOTO 666 127 : 667 CONTINUE 128 : C 129 : C JACOBIEN NUL 130 : C 131 : IRET = 2 132 : C 133 : 666 CONTINUE 134 : RETURN 135 : END 136 : 137 : 138 : 139 :
© Cast3M 2003 - All rights reserved.
Disclaimer