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