1 : C RESHPX SOURCE BP208322 10/07/12 21:15:08 6711 2 : C 20.04.2005 3 : C 4 : SUBROUTINE RESHPX(NBG,NBSH,IELE,MELE,NPINT,IPT,IRT) 5 : C 6 : C===================================================================== 7 : C MET LES VALEURS DES FONCTIONS DE FORMES DANS SHPTOT 8 : C ET LES COORDOONEES REDUITES+LES POIDS D INTEGRATION 9 : C DANS QSIGAU ETAGAU DZEGAU POIGAU ; LE TOUT EST 10 : C MIS DANS LE POINTEUR MINTE SON POINTEUR EST IPT 11 : C NNN =NOMBRE DE POINTS DE GAUSS 12 : C NBSH =NOMBRE DE FONCTIONS D'INTERPOLATION 13 : C IELE =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME ) 14 : C MELE =NUMERO DE L ELEMENT DANS NOMTP 15 : C NPINT=NOMBRE DE POINTS D'INTEGRATION DONS LE CAS DES 16 : C ELEMENTS COQUES INTEGRES 17 : C IPT = POINTEUR SUR MINTE 18 : C IRET=1 OU 0 SUIVANT QUE MINTE A ETE CREEE OU PAS 19 : C 20 : C CETTE ROUTINE GERE LES MESSAGES D ERREURS 21 : C PROVENANT DE L INCOMPATIBILTE ENTRE NOMS 22 : C D ELEMENTS,NOMBRE DE POINTS DE GAUSS,ET FONCTIONS DE FORME 23 : C===================================================================== 24 : C 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : C 27 : -INC CCREEL 28 : -INC CCGEOME 29 : -INC SMINTE 30 : -INC CCOPTIO 31 : c 32 : c 33 : INTEGER NBG,NBSH,IELE,MELE,NPINT,IRET 34 : INTEGER NBNN,NBPGAU,NBNO,II,JJ,KK,KGAU,IENR,NBENR,INI 35 : c REAL*8 DELTAQSI,QSI0,ETA0 36 : C 37 : PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0) 38 : PARAMETER (TROIS=3.D0,QUATRE=4.D0,HUIT=8.D0) 39 : C 40 : PARAMETER (NGAUMAX=8) 41 : C 42 : REAL*8 QSIREF(NGAUMAX),ETAREF(NGAUMAX),POIREF(NGAUMAX) 43 : REAL*8 DZEREF(NGAUMAX) 44 : REAL*8 QSI,ETA,DELTAQSI,QSI0,ETA0 45 : REAL*8 DZE,DZE0 46 : REAL*8 SHP1,SHP2,SHP3,SHP4,SHP1Q,SHP2Q,SHP3Q,SHP4Q 47 : REAL*8 SHP5,SHP6,SHP7,SHP8,SHP5Q,SHP6Q,SHP7Q,SHP8Q 48 : REAL*8 SHP1E,SHP2E,SHP3E,SHP4E 49 : REAL*8 SHP5E,SHP6E,SHP7E,SHP8E 50 : REAL*8 SHP1D,SHP2D,SHP3D,SHP4D 51 : REAL*8 SHP5D,SHP6D,SHP7D,SHP8D 52 : C 53 : C 54 : 55 : DATA X577/.577350269189626D0/ 56 : 57 : C 58 : IF (IDIM.EQ.2) THEN 59 : c 60 : if (MELE.eq.263) then 61 : C++++++++ QUADRANGLE A 4 NOEUDS 62 : NBNN = 4 63 : NGAU = 4 64 : QSIREF(1)=-X577 65 : QSIREF(2)= X577 66 : QSIREF(3)= X577 67 : QSIREF(4)=-X577 68 : ETAREF(1)=-X577 69 : ETAREF(2)=-X577 70 : ETAREF(3)= X577 71 : ETAREF(4)= X577 72 : POIREF(1)= UN 73 : POIREF(2)= UN 74 : POIREF(3)= UN 75 : POIREF(4)= UN 76 : endif 77 : c 78 : ENDIF 79 : c 80 : C 81 : IF (IDIM.EQ.3) THEN 82 : c 83 : if (MELE.eq.264) then 84 : C++++++++ CUBE A 8 NOEUDS 85 : NBNN = 8 86 : NGAU = 8 87 : QSIREF(1)=-X577 88 : QSIREF(2)= X577 89 : QSIREF(3)= X577 90 : QSIREF(4)=-X577 91 : QSIREF(5)=-X577 92 : QSIREF(6)= X577 93 : QSIREF(7)= X577 94 : QSIREF(8)=-X577 95 : ETAREF(1)=-X577 96 : ETAREF(2)=-X577 97 : ETAREF(3)= X577 98 : ETAREF(4)= X577 99 : ETAREF(5)=-X577 100 : ETAREF(6)=-X577 101 : ETAREF(7)= X577 102 : ETAREF(8)= X577 103 : DZEREF(1)=-X577 104 : DZEREF(2)=-X577 105 : DZEREF(3)=-X577 106 : DZEREF(4)=-X577 107 : DZEREF(5)= X577 108 : DZEREF(6)= X577 109 : DZEREF(7)= X577 110 : DZEREF(8)= X577 111 : POIREF(1)= UN 112 : POIREF(2)= UN 113 : POIREF(3)= UN 114 : POIREF(4)= UN 115 : POIREF(5)= UN 116 : POIREF(6)= UN 117 : POIREF(7)= UN 118 : POIREF(8)= UN 119 : c 120 : endif 121 : c 122 : ENDIF 123 : 124 : C 125 : C===================================================================== 126 : C INITIALISATIONS 127 : C 128 : NBPGAU= NBG 129 : NBNO = NBSH 130 : SEGINI,MINTE 131 : IPT = MINTE 132 : IRET=1 133 : C 134 : NBENR = NBSH/NBNN 135 : C 136 : C===================================================================== 137 : C EN 2D SOUS DECOUPAGE EN NBSSEF Q4 A 4 POINT DE GAUSS 138 : C EN 3D SOUS DECOUPAGE EN NBSSEF CUB8 A 8 POINT DE GAUSS 139 : IF(MOD(NBG,NBNN).NE.0) 140 : $ WRITE(*,*) 'NOMBRE DE PT DE GAUSS INDIVISIBLE PAR 4(2D) ou 8(3D)' 141 : XDIM = 1./IDIM 142 : NBSSEF = NINT( (NBG / NBNN)**(XDIM) ) 143 : C NBSSEF = NINT( (NBG / NBNN)**(1/IDIM) ) 144 : C WRITE(*,*) 'TY',IDIM,XDIM,NBG,NBNN,NBSSEF 145 : IF((NBNN*(NBSSEF**IDIM)).NE.NBG) 146 : $ WRITE(*,*) 'NOMBRE DE PT DE GAUSS INCORRECT' 147 : C 148 : KGAU = 0 149 : C write(*,*) '--->boucle sur',NBSSEF,'^2 elements *', 150 : C $ NGAU,' pt de G' 151 : C 152 : DELTAQSI = DEUX/(FLOAT(NBSSEF)) 153 : C write(*,*) 'deltaqsi',deltaqsi 154 : C 155 : C===================================================================== 156 : C EN 2D SOUS DECOUPAGE EN NBSSEF Q4 A 4 POINT DE GAUSS 157 : IF (IDIM.EQ.2) THEN 158 : 159 : C********* boucle sur les lignes ********* 160 : DO JJ=1,NBSSEF 161 : C********* boucle sur les colonnes ********* 162 : DO II=1,NBSSEF 163 : C 164 : C coordonnees au centre du sous element 165 : QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN 166 : ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN 167 : C 168 : C***** boucle sur les pts de gauss du Pseudo-sous element ***** 169 : DO KK=1,NGAU 170 : KGAU = KGAU + 1 171 : C calcul des coordonnees + poids 172 : QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0 173 : ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0 174 : POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM)) 175 : c WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU) 176 : ENDDO 177 : C** fin de boucle sur les points de gauss du sous element ** 178 : ENDDO 179 : C***** fin de boucle sur les colonnes ****** 180 : ENDDO 181 : C*******fin de boucle sur les lignes ****** 182 : 183 : C===================================================================== 184 : C EN 3D SOUS DECOUPAGE EN NBSSEF CUB8 A 8 POINT DE GAUSS 185 : ELSE 186 : c (IDIM.EQ.3) 187 : 188 : JZMAX= NBSSEF 189 : C********* boucle sur la 3eme direction ********* 190 : DO JZ=1,JZMAX 191 : C********* boucle sur les lignes ********* 192 : DO JJ=1,NBSSEF 193 : C********* boucle sur les colonnes ********* 194 : DO II=1,NBSSEF 195 : C 196 : C coordonnees au centre du sous element 197 : QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN 198 : ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN 199 : DZE0 = DELTAQSI*(FLOAT(JZ)-UNDEMI) - UN 200 : C 201 : C***** boucle sur les pts de gauss du Pseudo-sous element ***** 202 : DO KK=1,NGAU 203 : KGAU = KGAU + 1 204 : C calcul des coordonnees + poids 205 : QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0 206 : ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0 207 : DZEGAU(KGAU) = (UNDEMI*DELTAQSI*DZEREF(KK)) + DZE0 208 : POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM)) 209 : c WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU) 210 : ENDDO 211 : C** fin de boucle sur les points de gauss du sous element ** 212 : ENDDO 213 : C***** fin de boucle sur les colonnes ****** 214 : ENDDO 215 : C*******fin de boucle sur les lignes ****** 216 : ENDDO 217 : C*******fin de boucle sur la 3eme direction ****** 218 : 219 : ENDIF 220 : C 221 : C===================================================================== 222 : 223 : C 224 : C======================================================= 225 : C ON MET LES Ni STD PARTOUT 226 : C 227 : C***** boucle sur les points de gauss ***** 228 : DO 2001 KGAU=1,NBPGAU 229 : 230 : QSI = QSIGAU(KGAU) 231 : ETA = ETAGAU(KGAU) 232 : 233 : IF (IDIM.EQ.2) THEN 234 : 235 : C fonctions standards : Ni 236 : SHP1 = (UN-QSI)*(UN-ETA)/QUATRE 237 : SHP2 = (UN+QSI)*(UN-ETA)/QUATRE 238 : SHP3 = (UN+QSI)*(UN+ETA)/QUATRE 239 : SHP4 = (UN-QSI)*(UN+ETA)/QUATRE 240 : C dérivée des fonctions standards : Ni,qsi 241 : SHP1Q = (ETA-UN)/QUATRE 242 : SHP2Q = -SHP1Q 243 : SHP3Q = (ETA+UN)/QUATRE 244 : SHP4Q = -SHP3Q 245 : C dérivée des fonctions standards : Ni,eta 246 : SHP1E = (QSI-UN)/QUATRE 247 : SHP2E = -(UN+QSI)/QUATRE 248 : SHP3E = -SHP2E 249 : SHP4E = -SHP1E 250 : C 251 : ELSE 252 : 253 : DZE = DZEGAU(KGAU) 254 : C fonctions standards : Ni 255 : SHP1 = (UN-QSI)*(UN-ETA)*(UN-DZE)/HUIT 256 : SHP2 = (UN+QSI)*(UN-ETA)*(UN-DZE)/HUIT 257 : SHP3 = (UN+QSI)*(UN+ETA)*(UN-DZE)/HUIT 258 : SHP4 = (UN-QSI)*(UN+ETA)*(UN-DZE)/HUIT 259 : SHP5 = (UN-QSI)*(UN-ETA)*(UN+DZE)/HUIT 260 : SHP6 = (UN+QSI)*(UN-ETA)*(UN+DZE)/HUIT 261 : SHP7 = (UN+QSI)*(UN+ETA)*(UN+DZE)/HUIT 262 : SHP8 = (UN-QSI)*(UN+ETA)*(UN+DZE)/HUIT 263 : C dérivée des fonctions standards : Ni,qsi 264 : SHP1Q = (ETA-UN)*(UN-DZE)/HUIT 265 : SHP2Q = -SHP1Q 266 : SHP3Q = (ETA+UN)*(UN-DZE)/HUIT 267 : SHP4Q = -SHP3Q 268 : SHP5Q = (ETA-UN)*(UN+DZE)/HUIT 269 : SHP6Q = -SHP5Q 270 : SHP7Q = (ETA+UN)*(UN+DZE)/HUIT 271 : SHP8Q = -SHP7Q 272 : C dérivée des fonctions standards : Ni,eta 273 : SHP1E = (QSI-UN)*(UN-DZE)/HUIT 274 : SHP2E = -(UN+QSI)*(UN-DZE)/HUIT 275 : SHP3E = -SHP2E 276 : SHP4E = -SHP1E 277 : SHP5E = (QSI-UN)*(UN+DZE)/HUIT 278 : SHP6E = -(UN+QSI)*(UN+DZE)/HUIT 279 : SHP7E = -SHP6E 280 : SHP8E = -SHP5E 281 : C dérivée des fonctions standards : Ni,dze 282 : SHP1D = (UN-QSI)*(ETA-UN)/HUIT 283 : SHP2D = (UN+QSI)*(ETA-UN)/HUIT 284 : SHP3D = -(UN+QSI)*(UN+ETA)/HUIT 285 : SHP4D = (QSI-UN)*(UN+ETA)/HUIT 286 : SHP5D = -SHP1D 287 : SHP6D = -SHP2D 288 : SHP7D = -SHP3D 289 : SHP8D = -SHP4D 290 : ENDIF 291 : 292 : 293 : C***** boucle sur les enrichissements ***** 294 : DO 2002 IENR=1,NBENR 295 : 296 : II = (IENR-1)*NBNN + 1 297 : C fonctions standards : Ni 298 : SHPTOT(1,II,KGAU) = SHP1 299 : SHPTOT(1,II+1,KGAU) = SHP2 300 : SHPTOT(1,II+2,KGAU) = SHP3 301 : SHPTOT(1,II+3,KGAU) = SHP4 302 : C dérivée des fonctions standards : Ni,qsi 303 : SHPTOT(2,II,KGAU) = SHP1Q 304 : SHPTOT(2,II+1,KGAU) = SHP2Q 305 : SHPTOT(2,II+2,KGAU) = SHP3Q 306 : SHPTOT(2,II+3,KGAU) = SHP4Q 307 : C dérivée des fonctions standards : Ni,eta 308 : SHPTOT(3,II,KGAU) = SHP1E 309 : SHPTOT(3,II+1,KGAU) = SHP2E 310 : SHPTOT(3,II+2,KGAU) = SHP3E 311 : SHPTOT(3,II+3,KGAU) = SHP4E 312 : C 313 : IF (IDIM.EQ.3) THEN 314 : C fonctions standards : Ni 315 : SHPTOT(1,II+4,KGAU) = SHP5 316 : SHPTOT(1,II+5,KGAU) = SHP6 317 : SHPTOT(1,II+6,KGAU) = SHP7 318 : SHPTOT(1,II+7,KGAU) = SHP8 319 : C dérivée des fonctions standards : Ni,qsi 320 : SHPTOT(2,II+4,KGAU) = SHP5Q 321 : SHPTOT(2,II+5,KGAU) = SHP6Q 322 : SHPTOT(2,II+6,KGAU) = SHP7Q 323 : SHPTOT(2,II+7,KGAU) = SHP8Q 324 : C dérivée des fonctions standards : Ni,eta 325 : SHPTOT(3,II+4,KGAU) = SHP5E 326 : SHPTOT(3,II+5,KGAU) = SHP6E 327 : SHPTOT(3,II+6,KGAU) = SHP7E 328 : SHPTOT(3,II+7,KGAU) = SHP8E 329 : C dérivée des fonctions standards : Ni,dze 330 : SHPTOT(4,II,KGAU) = SHP1D 331 : SHPTOT(4,II+1,KGAU) = SHP2D 332 : SHPTOT(4,II+2,KGAU) = SHP3D 333 : SHPTOT(4,II+3,KGAU) = SHP4D 334 : SHPTOT(4,II+4,KGAU) = SHP5D 335 : SHPTOT(4,II+5,KGAU) = SHP6D 336 : SHPTOT(4,II+6,KGAU) = SHP7D 337 : SHPTOT(4,II+7,KGAU) = SHP8D 338 : ENDIF 339 : C 340 : C 341 : 2002 CONTINUE 342 : 2001 CONTINUE 343 : C 344 : 345 : C======================================================= 346 : C ON CALCULE LES FONCTIONS D EXTRAPOLATIONS 347 : C 347 : C CALL EXTRAP(SHPTOT,NNN,NBBB,NBNO) 348 : C 349 : C 350 : 351 : C======================================================= 352 : C ON DESACTIVE LES SEGMENTS 353 : SEGDES MINTE 354 : C 355 : RETURN 356 : END 357 : 358 : 359 : 360 : 361 : 362 : 363 : 364 : 365 : 366 : 367 :
© Cast3M 2003 - All rights reserved.
Disclaimer