1 : C QUAHR2 SOURCE CHAT 05/01/13 02:41:08 5004 2 : C QUAHR2 SOURCE LOFT 88/06/23 21:07:05 3 : SUBROUTINE QUAHR2(XGENE,DJAC,VKL1,VKL2,LRE,NST,NBNO,IFOU,REL) 4 : C======================================================================= 5 : C 6 : C INTEGRE LE PRODUIT NT KL N 7 : C POUR LES ELEMENTS HOMOGENEISES TRIH 8 : C 9 : C ROUTINE FORTRAN PUR 10 : C 11 : C======================================================================= 12 : C NBDL = NOMBRE DE DDL PAR NOEUD 13 : C INPUT 14 : C XGENE(NBNO,NST)=MATRICE N 15 : C DJAC =JACOBIEN 16 : C VKL1=(COEFPR**2)/(RHO*C**2)*SFLU/SCEL 17 : C VKL2= EI/((EPS**2)*SCEL) 18 : C LRE=TAILLE DE LA MATRICE DE RIGIDITE 19 : C NST=NOMBRE DE COLONNES DE LA MATRICE XGENE 20 : C NBNO=NOMBRE DE NOEUDS DE L ELEMENT CONSIDERE 21 : C IFOU=IFOUR DE CCOPTIO 22 : C OUTPUT 23 : C REL=MATRICE DE RIGIDITE 24 : C======================================================================= 25 : IMPLICIT INTEGER(I-N) 26 : IMPLICIT REAL*8 (A-H,O-Z) 27 : DIMENSION REL(LRE,*),XGENE((NBNO+NBNO),*) 28 : NBDL=LRE/NBNO 29 : C 30 : C 31 : DJAC = ABS(DJAC) 32 : C 33 : C TERMES EN P*P 34 : C 35 : IX1=0 36 : IY1=0 37 : DO 300 IX=1,LRE ,NBDL 38 : IX1=IX1 + 1 39 : DO 400 IY=1,IX ,NBDL 40 : IY1=IY1 + 1 41 : REL(IX,IY) = REL(IX,IY) + DJAC*VKL1*XGENE(IX1,1)*XGENE(IY1,1) 42 : REL(IY,IX) = REL(IX,IY) 43 : 400 CONTINUE 44 : IY1=0 45 : 300 CONTINUE 46 : C 47 : C CAS AXISYMETRIQUE OU FOURIER ( NST = 2 ) 48 : C 49 : C TERMES EN (UR,RT )*(UR,RT ) 50 : C 51 : IX1=0 52 : IY1=0 53 : DO 302 IX=3,LRE ,NBDL 54 : IX1=IX1 + 1 55 : DO 402 IY=3,IX ,NBDL 56 : IY1=IY1 + 1 57 : REL(IX,IY) = REL(IX,IY) + DJAC*VKL2*XGENE(IX1,2)*XGENE(IY1,2) 58 : REL(IX+1,IY) = REL(IX+1,IY) + DJAC*VKL2*XGENE(IX1+4,2) 59 : #*XGENE(IY1,2) 60 : REL(IX,IY+1) = REL(IX,IY+1) + DJAC*VKL2*XGENE(IX1,2) 61 : #*XGENE(IY1+4,2) 62 : REL(IX+1,IY+1) = REL(IX+1,IY+1) + DJAC*VKL2*XGENE(IX1+4,2)* 63 : #XGENE(IY1+4,2) 64 : REL(IY,IX) = REL(IX,IY) 65 : REL(IY,IX+1) = REL(IX+1,IY) 66 : REL(IY+1,IX) = REL(IX,IY+1) 67 : REL(IY+1,IX+1) = REL(IX+1,IY+1) 68 : 402 CONTINUE 69 : IY1=0 70 : 302 CONTINUE 71 : C 72 : IF(IFOU.EQ.1) THEN 73 : C 74 : C TERMES EN (UT,RR )*(UT,RR ) 75 : C NON NULS QUE DANS LE CAS FOURIER 76 : C 77 : IX1=0 78 : IY1=0 79 : DO 303 IX=5,LRE ,NBDL 80 : IX1=IX1 + 1 81 : DO 403 IY=5,IX ,NBDL 82 : IY1=IY1 + 1 83 : 84 : REL(IX,IY) = REL(IX,IY) + DJAC*VKL2*XGENE(IX1,2)*XGENE(IY1,2) 85 : REL(IX+1,IY) = REL(IX+1,IY) + DJAC*VKL2*XGENE(IX1+4,2) 86 : #*XGENE(IY1,2)*(-1.D0) 87 : REL(IX,IY+1) = REL(IX,IY+1) + DJAC*VKL2*XGENE(IX1,2) 88 : #*XGENE(IY1+4,2)*(-1.D0) 89 : REL(IX+1,IY+1) = REL(IX+1,IY+1) + DJAC*VKL2*XGENE(IX1+4,2)* 90 : #XGENE(IY1+4,2) 91 : REL(IY,IX) = REL(IX,IY) 92 : REL(IY,IX+1) = REL(IX+1,IY) 93 : REL(IY+1,IX) = REL(IX,IY+1) 94 : REL(IY+1,IX+1) = REL(IX+1,IY+1) 95 : 403 CONTINUE 96 : IY1=0 97 : 303 CONTINUE 98 : C 99 : ENDIF 100 : RETURN 101 : END 102 : 103 :
© Cast3M 2003 - All rights reserved.
Disclaimer