1 : C QUAHM1 SOURCE CHAT 05/01/13 02:40:50 5004 2 : C QUAHM1 SOURCE AM1 95/11/24 22:53:28 1918 3 : SUBROUTINE QUAHM1(IGAU,ITEL,MFR,NBNO,XEL,SHPTOT,SHP,IFOU,NHARM, 4 : # B11,B22,SFLU,POIGAU,VKL22,LRE,REL,IRET) 5 : C======================================================================= 6 : C 7 : C CALCULE LES TERMES EN PI * PI DE LA MATRICE DE 8 : C MASSE DANS LE CAS AXISYMETRIQUE OU FOURIER POUR 9 : C LA FORMULATION (37) HOMOGENE 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 XEL =COORDONNEES DE L ELEMENT 17 : C IFOU=IFOUR DE CCOPTIO 18 : C NHARM=NUMERO DU MODE DE FOURIER 19 : C B11,B22 = PERMEABILITE ACOUSTIQUE DU MILIEU 20 : C SFLU = SURFACE FLUIDE DANS LA CELLULE ELEMENTAIRE 21 : C POIGAU=MINTE.POIGAU(IGAU) 22 : C VKL22=-(COEFPI**2)/(RHOF*SCEL) 23 : C LRE =NOMBRE DE D.D.L DE LA MATRICE DE RIGIDITE 24 : C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES 25 : C ZONE DE TRAVAIL 26 : C SHP(6,NBNO)=TABLEAU DE TRAVAIL 27 : C OUTPUT 28 : C REL=MATRICE DE MASSE 29 : C IRET : INDICATEUR = 1 : SUCCES 30 : C = 0 : ECHEC (ELEMENT MELE INCOMPATIBLE 31 : C AVEC LA FORMULATION ) 32 : C = 2 : ECHEC (JACOBIEN NUL ) 33 : C = 3 : ECHEC (ROUTINE N EST VALABLE QU EN 34 : C FOURIER OU AXISYMETRIQUE ) 35 : C = 4 : ECHEC (RAYON NUL ) 36 : C======================================================================= 37 : IMPLICIT INTEGER(I-N) 38 : IMPLICIT REAL*8(A-H,O-Z) 39 : DIMENSION XEL(3,*),SHP(6,*),SHPTOT(6,NBNO,*),REL(LRE,*) 40 : IF (ITEL.EQ.126) GOTO 10 41 : C 42 : C ERREUR : TYPE D' ELEMENT INCOMPATIBLE AVEC LA FORMULATION 43 : C 44 : IRET = 0 45 : GOTO 666 46 : 10 CONTINUE 47 : IF (IFOU.EQ.0.OR.IFOU.EQ.1) GOTO 11 48 : C 49 : C MESSAGE D ERREUR : ROUTINE N EST VALABLE QU EN FOURIER 50 : C OU EN AXISYMETRIQUE 51 : C 52 : IRET = 3 53 : GOTO 666 54 : 11 CONTINUE 55 : C 56 : C ELEMENTS HOMOGENEISES QUAH EN AXISYMETRIE OU EN FOURIER 57 : C NBDL = LRE/NBNO NOMBRE DE D.D.L PAR NOEUD 58 : C 59 : B33 = SFLU 60 : NBDL = LRE/NBNO 61 : C 62 : C SHP(1,I) : FONCTION DE FORME 63 : C SHP(2,I) : DERIVEE % R DE LA FONCTION DE FORME 64 : C SHP(3,I) : DERIVEE % Z DE LA FONCTION DE FORME 65 : C 66 : DO 101 NP=1,NBNO 67 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 68 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 69 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 70 : 101 CONTINUE 71 : C 72 : C 72 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NHARM,2,1.D0,RR,DJAC) 73 : IF (DJAC.EQ.0.) GOTO 667 74 : IF ( IFOU.EQ.0) THEN 75 : 76 : C 77 : C CAS AXISYMETRIQUE 78 : C 79 : DJAC = ABS(DJAC)*POIGAU 80 : 81 : IX1=0 82 : IY1=0 83 : DO 102 IX=2,LRE ,NBDL 84 : IX1=IX1 + 1 85 : DO 103 IY=2,IX ,NBDL 86 : IY1=IY1 + 1 87 : REL(IY,IX) = REL(IY,IX) + VKL22*DJAC*(0.5D0*(B11+B22)*SHP(2,IX1)* 88 : #SHP(2,IY1) 89 : # + B33*SHP(3,IX1)*SHP(3,IY1)) 90 : REL(IX,IY) = REL(IY,IX) 91 : 103 CONTINUE 92 : IY1=0 93 : 102 CONTINUE 94 : IRET = 1 95 : ELSE 96 : C 97 : C CAS ANALYSE EN FOURIER 98 : C 99 : C 100 : C 101 : IF (RR.EQ.0.) GOTO 668 102 : DJAC = ABS(DJAC) 103 : DJAC1 = DJAC*POIGAU 104 : DJAC2 = DJAC*POIGAU/(RR**2) 105 : C 106 : IX1=0 107 : IY1=0 108 : DO 104 IX=2,LRE ,NBDL 109 : IX1=IX1 + 1 110 : DO 105 IY=2,IX ,NBDL 111 : IY1=IY1 + 1 112 : C 113 : COEF1 = 0.5D0*(B11+B22)*SHP(2,IX1)*SHP(2,IY1) 114 : COEF2 = B33*SHP(3,IX1)*SHP(3,IY1) 115 : COEF3 = 0.5D0*NHARM*NHARM*(B11+B22)*SHP(1,IY1)*SHP(1,IX1) 116 : C 117 : REL(IY,IX)=REL(IY,IX)+VKL22*(DJAC1*(COEF1 + COEF2) 118 : #+DJAC2*COEF3) 119 : REL(IX,IY) = REL(IY,IX) 120 : 105 CONTINUE 121 : IY1=0 122 : 104 CONTINUE 123 : IRET = 1 124 : ENDIF 125 : GOTO 666 126 : C 127 : C MESSAGE D ERREUR : ELEMENT A SURFACE NULLE 128 : C 129 : 667 CONTINUE 130 : IRET = 2 131 : GOTO 666 132 : C 133 : C MESSAGE D ERREUR : LE RAYON EST NUL (IL FAUT AUGMENTER LE NOMBRE 134 : C DE POINTS D INTEGRATION DANS ICLEM(17) ) 135 : C 136 : 668 CONTINUE 137 : IRET = 4 138 : GOTO 666 139 : C 140 : 666 CONTINUE 141 : RETURN 142 : END 143 : 144 : 145 : 146 :
© Cast3M 2003 - All rights reserved.
Disclaimer