1 : C TRIHM2 SOURCE CHAT 05/01/13 03:47:09 5004 2 : SUBROUTINE TRIHM2(IGAU,ITEL,MFR,NBNO,XEL,SHPTOT,SHP,IFOU, 3 : # NHARM,VKL12,VKL23,VKL33,POIGAU,ISDJC,LRE,REL,IRET) 4 : C======================================================================= 5 : C 6 : C CALCULE LES TERMES EN P * PI ,PI * (UR,RT) ,(UR,RT) *(UR,RT) 7 : C (UT,RR) * (UT,RR) , PI * (UT,RR) DE LA MATRICE 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 VKL12=-((COEFPI*COEFPR)/(RHOF*C**2))*SFLU/SCEL 20 : C VKL23=(BET11+BET22)*COEFPI/(2.*SCEL) 21 : C VKL33=(RHOS*2.+RHOF*(BET11+BET22))/SCEL 22 : C POIGAU=MINTE.POIGAU(IGAU) 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 ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN 26 : C ZONE DE TRAVAIL 27 : C SHP(5,NBNO)=TABLEAU DE TRAVAIL 28 : C OUTPUT 29 : C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN 30 : C REL=MATRICE DE MASSE 31 : C IRET:INDICATEUR = 1 : SUCCES 32 : C 0 : ECHEC (ELEMENT MELE INCOMPATIBLE ) 33 : C 2 : ECHEC (JACOBIEN NUL ) 34 : C 3 :ECHEC (ROUTINE N EST VALABLE QU 35 : C EN AXISYMETRIQUE OU FOURIER ) 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.92) 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 TRIH EN AXISYMETRIE OU EN FOURIER 57 : C NBDL = LRE/NBNO NOMBRE DE D.D.L PAR NOEUD 58 : C 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 (DJAC.LT.0.) ISDJC = ISDJC + 1 72 : C 73 : C SHP(4,I) : FONCTION DE FORME DE UR (DEPLACEMENTS) 74 : C SHP(5,I) : FONCTION DE FORME DE (DUR/DZ) (ROTATIONS) 75 : C 76 : SHP(4,1)=SHP(1,1)*(1.D0-SHP(1,2)*SHP(1,2)-SHP(1,3)*SHP(1,3)) + 77 : # SHP(1,1)*SHP(1,1)*(SHP(1,2)+SHP(1,3)) 78 : SHP(4,2)=SHP(1,2)*(1.D0-SHP(1,1)*SHP(1,1)-SHP(1,3)*SHP(1,3)) + 79 : # SHP(1,2)*SHP(1,2)*(SHP(1,1)+SHP(1,3)) 80 : SHP(4,3)=SHP(1,3)*(1.D0-SHP(1,1)*SHP(1,1)-SHP(1,2)*SHP(1,2)) + 81 : # SHP(1,3)*SHP(1,3)*(SHP(1,1)+SHP(1,2)) 82 : C 83 : C A1=SHP(2,1) , A2=SHP(2,2) , A3 = SHP(2,3) 84 : C 85 : A1=XEL(2,2)-XEL(2,3) 86 : A2=XEL(2,3)-XEL(2,1) 87 : A3=XEL(2,1)-XEL(2,2) 88 : SHP(5,1)= SHP(1,1)*SHP(1,1)*(A2*SHP(1,3)-A3*SHP(1,2)) + 89 : # 0.5D0*SHP(1,1)*SHP(1,2)*SHP(1,3)*(A2-A3) 90 : SHP(5,2)= SHP(1,2)*SHP(1,2)*(A3*SHP(1,1)-A1*SHP(1,3)) + 91 : # 0.5D0*SHP(1,1)*SHP(1,2)*SHP(1,3)*(A3-A1) 92 : SHP(5,3)= SHP(1,3)*SHP(1,3)*(A1*SHP(1,2)-A2*SHP(1,1)) + 93 : # 0.5D0*SHP(1,1)*SHP(1,2)*SHP(1,3)*(A1-A2) 94 : C 95 : C TERMES EN P * PI 96 : C 97 : DJAC1 = ABS(DJAC)*POIGAU 98 : IX1=0 99 : IY1=0 100 : DO 102 IX=2,LRE ,NBDL 101 : IX1=IX1 + 1 102 : DO 103 IY=1,IX ,NBDL 103 : IY1=IY1 + 1 104 : REL(IY,IX) = REL(IY,IX) + VKL12*DJAC1*SHP(1,IX1)*SHP(1,IY1) 105 : REL(IX,IY) = REL(IY,IX) 106 : 103 CONTINUE 107 : IY1=0 108 : 102 CONTINUE 109 : DO 104 IX=2+NBDL,LRE ,NBDL 110 : IX2=IX - NBDL 111 : DO 105 IY=1,IX2 ,NBDL 112 : REL(IY+1,IX-1) = REL(IY,IX) 113 : REL(IX-1,IY+1) = REL(IY+1,IX-1) 114 : 105 CONTINUE 115 : 104 CONTINUE 116 : C 117 : C TERMES EN PI * (UR , RT ) 118 : C 119 : IX1=0 120 : IY1=0 121 : DO 106 IX=3,LRE ,NBDL 122 : IX1=IX1 + 1 123 : DO 107 IY=2,IX ,NBDL 124 : IY1=IY1 + 1 125 : REL(IY,IX) = REL(IY,IX) + VKL23*DJAC1*SHP(2,IY1)*SHP(4,IX1) 126 : REL(IY,IX+1) = REL(IY,IX+1) + VKL23*DJAC1*SHP(2,IY1)*SHP(5,IX1) 127 : REL(IX,IY) = REL(IY,IX) 128 : REL(IX+1,IY) = REL(IY,IX+1) 129 : 107 CONTINUE 130 : IY1=0 131 : 106 CONTINUE 132 : IX1=1 133 : IY1=0 134 : DO 108 IX=2+NBDL,LRE ,NBDL 135 : IX1=IX1 + 1 136 : DO 109 IY=3,IX ,NBDL 137 : IY1=IY1 + 1 138 : REL(IY,IX) = REL(IY,IX) + VKL23*DJAC1*SHP(2,IX1)*SHP(4,IY1) 139 : REL(IY+1,IX) = REL(IY+1,IX) + VKL23*DJAC1*SHP(2,IX1)*SHP(5,IY1) 140 : REL(IX,IY) = REL(IY,IX) 141 : REL(IX,IY+1) = REL(IY+1,IX) 142 : 109 CONTINUE 143 : IY1=0 144 : 108 CONTINUE 145 : IF ( IFOU.EQ.1) THEN 146 : C 147 : C TERMES EN PI * (UT , RR ) 148 : C NON NULS QU EN FOURIER 149 : C 150 : DJAC2 = ABS(DJAC)*POIGAU 151 : VKL25 = -1.D0* VKL23*NHARM 152 : IX1=0 153 : IY1=0 154 : DO 110 IX=5,LRE ,NBDL 155 : IX1=IX1 + 1 156 : DO 111 IY=2,IX ,NBDL 157 : IY1=IY1 + 1 158 : REL(IY,IX) = REL(IY,IX) + VKL25*DJAC2*SHP(1,IY1)*SHP(4,IX1) 159 : REL(IY,IX+1) = REL(IY,IX+1) + VKL25*DJAC2*SHP(1,IY1)*SHP(5,IX1) 160 : REL(IX,IY) = REL(IY,IX) 161 : REL(IX+1,IY) = REL(IY,IX+1) 162 : 111 CONTINUE 163 : IY1=0 164 : 110 CONTINUE 165 : IX1=1 166 : IY1=0 167 : DO 112 IX=2+NBDL,LRE ,NBDL 168 : IX1=IX1 + 1 169 : DO 113 IY=5,IX ,NBDL 170 : IY1=IY1 + 1 171 : REL(IY,IX) = REL(IY,IX) + VKL25*DJAC2*SHP(1,IX1)*SHP(4,IY1) 172 : REL(IY+1,IX) = REL(IY+1,IX) + VKL25*DJAC2*SHP(1,IX1)*SHP(5,IY1) 173 : REL(IX,IY) = REL(IY,IX) 174 : REL(IX,IY+1) = REL(IY+1,IX) 175 : 113 CONTINUE 176 : IY1=0 177 : 112 CONTINUE 178 : ENDIF 179 : C 180 : C TERMES EN (UR,RT ) * (UR , RT ) 181 : C 182 : IX1=0 183 : IY1=0 184 : DO 114 IX=3,LRE ,NBDL 185 : IX1=IX1 + 1 186 : DO 115 IY=3,IX ,NBDL 187 : IY1=IY1 + 1 188 : REL(IY,IX) = REL(IY,IX) + VKL33*DJAC1*SHP(4,IY1)*SHP(4,IX1) 189 : REL(IY,IX+1) = REL(IY,IX+1) + VKL33*DJAC1*SHP(4,IY1)*SHP(5,IX1) 190 : REL(IY+1,IX) = REL(IY+1,IX) + VKL33*DJAC1*SHP(5,IY1)*SHP(4,IX1) 191 : REL(IY+1,IX+1) = REL(IY+1,IX+1)+VKL33*DJAC1*SHP(5,IY1)*SHP(5,IX1) 192 : REL(IX,IY) = REL(IY,IX) 193 : REL(IX+1,IY) = REL(IY,IX+1) 194 : REL(IX,IY+1) = REL(IY+1,IX) 195 : REL(IX+1,IY+1) = REL(IY+1,IX+1) 196 : 115 CONTINUE 197 : IY1=0 198 : 114 CONTINUE 199 : IF ( IFOU.EQ.1) THEN 200 : C 201 : C TERMES EN (UT,RR ) * (UT , RR ) 202 : C NON NULS QU EN FOURIER 203 : C 204 : DO 116 IX=3,LRE ,NBDL 205 : DO 117 IY=3,LRE ,NBDL 206 : IX2=IX + 2 207 : IY2=IY + 2 208 : REL(IX2,IY2) = REL(IX,IY) 209 : REL(IX2+1,IY2) = REL(IX+1,IY) 210 : REL(IX2,IY2+1) = REL(IX,IY+1) 211 : REL(IX2+1,IY2+1) = REL(IX+1,IY+1) 212 : 117 CONTINUE 213 : 116 CONTINUE 214 : ENDIF 215 : IRET = 1 216 : GOTO 666 217 : C 218 : C MESSAGE D ERREUR : ELEMENT A SURFACE NULLE 219 : C 220 : 667 CONTINUE 221 : IRET = 2 222 : GOTO 666 223 : C 224 : 666 CONTINUE 225 : RETURN 226 : END 227 : 228 : 229 :
© Cast3M 2003 - All rights reserved.
Disclaimer