1 : C FDEBIT SOURCE CHAT 11/03/16 21:22:10 6902 2 : SUBROUTINE FDEBIT(IPCHE1,IPMODL,IPTFP,MOT1,IRET) 3 : C______________________________________________________________________ 4 : C 5 : C CALCULE LES FORCES DUES A UN DEBIT IMPOSE SUR UNE FRONTIERE DE 6 : C MASSIF ( INSPIRE DE FPMASS ) 7 : C 8 : C ENTREES : 9 : C --------- 10 : C 11 : C IPCHE1 CHPOINT CONTENANT LES VALEURS DES DEBITS AUX NOEUDS 12 : C DE LA FACE D UN MASSIF 13 : C IPMODL OBJET MMODEL SUR LEQUEL S APPLIQUE LA CONDITION DE 14 : C DEBIT 15 : C MOT1 NOM A DONNER AU RESULTAT SI PAS ' ' 16 : C 17 : C SORTIES : 18 : C --------- 19 : C 20 : C IPTFP CHPOINT DES FORCES NODALES EQUIVALENTES 21 : C IRET 1 OU 0 SUIVANT SUCCES OU NON 22 : C 23 : C Passage aux nouveaux CHAMELEM par JM CAMPENOB LE 06/91 24 : C 25 : C_______________________________________________________________________ 26 : C 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8(A-H,O-Z) 29 : C 30 : -INC CCOPTIO 31 : -INC CCGEOME 32 : -INC CCHAMP 33 : -INC SMCOORD 34 : -INC SMELEME 35 : -INC SMMODEL 36 : -INC SMCHAML 37 : -INC SMCHPOI 38 : -INC TMTRAV 39 : C 40 : logical ltelq 41 : SEGMENT INFO 42 : INTEGER INFELL(JG) 43 : ENDSEGMENT 44 : C 45 : C SEGMENTS DE TRAVAIL POUR CREER LE CHPOINT 46 : C 47 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 48 : C 49 : C CONTENU DU SEGMENT MTRAV 50 : C 51 : C NNNOE NOMBRE DE NOEUDS 52 : C IGEO LA LISTE DE CES NOEUDS 53 : C NNIN NOMBRE D'INCONNUES 54 : C INCO LA LISTE DE CES INCONNUES 55 : C NHAR LE NUMERO D'HARMONIQUE CORRESPONDANT 56 : C IBIN INDIQUE POUR UN NOEUD SI UNE INCONNUE EXISTE (=1 OU 0) 57 : C BB LA VALEUR CORRESPONDANTE 58 : C 59 : CHARACTER*(4) MOAPPU,MOSTRI,MOGEOM,MOFP,MOT1 60 : DATA MOAPPU/'APPU'/,MOSTRI/'STRI'/ 61 : DATA MOGEOM/'GEOM'/,MOFP/'FP '/ 62 : C 63 : IRET=1 64 : NHRM=NIFOUR 65 : C 66 : MCHPOI=IPCHE1 67 : SEGACT MCHPOI 68 : C 69 : C ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS DU CHPOP 70 : C 71 : DO 50 I=1,IPCHP(/1) 72 : MSOUPO=IPCHP(I) 73 : SEGACT MSOUPO 74 : IF (I.GT.1) THEN 75 : ltelq=.false. 75 : CALL FUSE(IGEOM,IGEOC,IRET,ltelq) 76 : IGEOM=IRET 77 : ELSE 78 : IGEOM=IGEOC 79 : ENDIF 80 : SEGDES MSOUPO 81 : 50 CONTINUE 82 : SEGDES MCHPOI 83 : IF (IERR.NE.0) RETURN 84 : C 85 : C ACTIVATION DU MODEL 86 : C 87 : MMODEL=IPMODL 88 : SEGACT MMODEL 89 : NSOUS=KMODEL(/1) 90 : IRRT=0 91 : DO 100 ISOUS=1,NSOUS 92 : C 93 : C ON RECUPERE L INFORMATION GENERALE 94 : C 95 : IMODEL=KMODEL(ISOUS) 96 : SEGACT IMODEL 97 : IPMAIL=IMAMOD 98 : C 99 : C TRAITEMENT DU MODEL 100 : C 101 : MELM=NEFMOD 102 : C 103 : C ON RECUPERE LES ELTS DE L ENVELOPPE DU MASSIF APPUYES 104 : C STRICTEMENT SUR LE CHPOINT DE DEBIT 105 : C 105 : CALL ECROBJ('MAILLAGE',IGEOM) 105 : CALL ECRCHA(MOSTRI) 105 : CALL ECRCHA(MOAPPU) 105 : CALL ECROBJ('MAILLAGE',IPMAIL) 105 : IF (IDIM.EQ.2) CALL PRCONT 105 : IF (IDIM.EQ.3) CALL ENVELO 106 : IF (IERR.NE.0) THEN 107 : IRET=0 108 : SEGDES MMODEL 109 : SEGDES IMODEL 110 : RETURN 111 : ENDIF 111 : CALL EXTREL (IRR,0,IBNOR) 112 : IF(IRR.EQ.1) THEN 113 : IRRT=IRRT+IRR 114 : GOTO 100 115 : ENDIF 115 : CALL LIROBJ('MAILLAGE',IPOGEO,1,IRETOU) 116 : IF (IERR.NE.0) THEN 117 : IRET=0 118 : SEGDES MMODEL,IMODEL 119 : RETURN 120 : ENDIF 121 : C 122 : C ON DETERMINE LA FORMULATION ASSOCIEE A L OBJET 123 : C GEOMETRIQUE ELEMENTAIRE DE SURFACE 124 : C 125 : IPT3=IPOGEO 126 : SEGACT IPT3 127 : IPT2=IPT3 128 : IB=0 129 : C 130 : C BOUCLE SUR LES SOUS ZONES DE L ENVELOPPE 131 : C 132 : DO 110 IB=1,MAX(1,IPT3.LISOUS(/1)) 133 : IF (IPT3.LISOUS(/1).NE.0) THEN 134 : IPT2=IPT3.LISOUS(IB) 135 : SEGACT IPT2 136 : IPOGEO=IPT2 137 : ENDIF 138 : NBNN=IPT2.NUM(/1) 139 : IF (IPT3.LISOUS(/1).EQ.0) GOTO 112 140 : SEGDES IPT2 141 : C 142 : 112 CONTINUE 143 : MELE=0 144 : C 145 : C MILIEUX POREUX : 146 : C ON RECUPERE L'ELEMENT QUADRATIQUE DE FACE 147 : C 148 : IF(MELM.EQ.79.OR.MELM.EQ.80.OR.MELM.EQ.108 149 : & .OR.MELM.EQ.173.OR.MELM.EQ.174.OR.MELM.EQ.178 150 : & .OR.MELM.EQ.179.OR.MELM.EQ.185.OR.MELM.EQ.188) THEN 151 : MELE=3 152 : IELI=2 153 : ELSE IF(MELM.EQ.81.OR.MELM.EQ.82.OR.MELM.EQ.83 154 : & .OR.MELM.EQ.109.OR.MELM.EQ.110.OR.MELM.EQ.175 155 : & .OR.MELM.EQ.176.OR.MELM.EQ.177.OR.MELM.EQ.180 156 : & .OR.MELM.EQ.181.OR.MELM.EQ.182.OR.MELM.EQ.186 157 : & .OR.MELM.EQ.187.OR.MELM.EQ.189.OR.MELM.EQ.190) THEN 158 : IF (NBNN.EQ.6) THEN 159 : MELE=33 160 : C IELI=3 BALD 96/02/23 161 : IELI=4 162 : ELSE 163 : MELE=34 164 : C IELI=4 BALD 96/02/23 165 : IELI=8 166 : ENDIF 167 : ENDIF 168 : C 169 : IF (MELE.EQ.0) THEN 170 : C 171 : C ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR DEBIT POUR 172 : C LES ELEMENTS DE FORMULATION MELM 173 : C 174 : MOTERR(1:4)=NOMTP(MELM) 175 : MOTERR(5:8)=' ' 175 : CALL ERREUR(193) 176 : SEGDES MMODEL 177 : SEGDES IMODEL 178 : SEGDES IPT3 179 : IRET=0 180 : RETURN 181 : ENDIF 182 : C 183 : C ON CREE L OBJET MODEL ASSOCIE A LA SURFACE ELEMENTAIRE 184 : C 185 : N1=1 186 : SEGINI MMODE1 187 : IPMOD1=MMODE1 188 : NFOR=FORMOD(/2) 189 : NMAT=MATMOD(/2) 190 : MN3 =INFMOD(/1) 191 : NPARMO=0 192 : nobmod=0 193 : SEGINI IMODE1 194 : MMODE1.KMODEL(1)=IMODE1 195 : IMODE1.IMAMOD=IPOGEO 196 : IMODE1.NEFMOD=MELE 197 : DO 10 I=1,NFOR 198 : IMODE1.FORMOD(I)=FORMOD(I) 199 : 10 CONTINUE 200 : DO 11 I=1,NFOR 201 : IMODE1.MATMOD(I)=MATMOD(I) 202 : 11 CONTINUE 203 : SEGDES MMODE1 204 : lzero=0 204 : call inomid ( imode1,' ',iret,lzero,lzero,lzero,lzero) 204 : call prquoi(imode1) 205 : SEGDES IMODE1 206 : C 207 : C ON TRANSFORME LE CHPOINT DE PRESSION EN CHELEM ELEMENTAIRE 208 : C 208 : CALL CHAME1(0,IPMOD1,IPCHE1,' ',ICHELP,3) 209 : IF (IERR.NE.0) THEN 210 : IRET=0 210 : CALL DTMODL(IPMOD1) 211 : SEGDES IPT3 212 : RETURN 213 : ENDIF 214 : MCHEL1=ICHELP 215 : SEGACT MCHEL1 216 : MCHAM1=MCHEL1.ICHAML(1) 217 : SEGACT MCHAM1 218 : IPTVPR=MCHAM1.IELVAL(1) 219 : C 220 : C INFORMATION SUR L'ELEMENT FINI 221 : C 222 : if(infmod(/1).lt.5) then 222 : CALL ELQUOI(MELE,0,3,IPINF,IMODEL) 223 : IF (IERR.NE.0) THEN 224 : IRET=0 225 : SEGDES MMODEL 226 : SEGDES IMODEL 227 : SEGDES IPT3 227 : CALL DTCHAM(ICHELP) 227 : CALL DTMODL(IPMOD1) 228 : RETURN 229 : ENDIF 230 : INFO=IPINF 231 : MFR =INFELL(13) 232 : IELE =INFELL(14) 233 : IPTINT=INFELL(11) 234 : segsup info 235 : ELSE 236 : iptint=infmod(5) 237 : MFR =INFELE(13) 238 : IELE =INFELE(14) 239 : ENDIF 240 : C 241 : C INITIALISATION DU CHELEM ELEMENTAIRE DES FORCES NODALES 242 : C 243 : N1=1 244 : L1=8 245 : N3=3 246 : SEGINI MCHELM 247 : TITCHE='SCALAIRE' 248 : IFOCHE=IFOUR 249 : IPCHEL=MCHELM 250 : C 251 : IMACHE(1)=IPOGEO 252 : INFCHE(1,1)=0 253 : INFCHE(1,2)=0 254 : INFCHE(1,3)=NHRM 255 : C 256 : C RECHERCHE DE LA TAILLE DES MELVALS 257 : C 258 : MELEME=IPOGEO 259 : SEGACT MELEME 260 : N1EL =NUM(/2) 261 : NBBB=NBNNE(IELI) 262 : N1PTEL=NBBB 263 : N2PTEL=0 264 : N2EL =0 265 : SEGDES MELEME 266 : C 267 : C CREATION DU MCHAML DE LA SOUS ZONE 268 : C 269 : N2=1 270 : SEGINI MCHAML 271 : ICHAML(1)=MCHAML 272 : NOMCHE(1)='SCAL' 273 : TYPCHE(1)='REAL*8' 274 : SEGINI MELVAL 275 : IELVAL(1)=MELVAL 276 : IVAFOR=MELVAL 277 : C 278 : C CALCUL DES FORCES NODALES EQUIVALENTES 279 : C DEBRANCHEMENT SUIVANT LE TYPE DES ELEMENTS 280 : C 281 : C CAS DES ELEMENTS MASSIFS BIDIMENSIONNELS 282 : C FACE ASSOCIEE SEG3 283 : C CAS DES ELEMENTS MASSIFS TRIDIMENSIONNELS 284 : C FACES ASSOCIEES FAC6,FAC8 285 : C 286 : IF (MELE.EQ.3.OR.MELE.EQ.33.OR.MELE.EQ.34) THEN 286 : CALL FDE23D(IPTVPR,IPOGEO,IPTINT,IVAFOR,IELI) 287 : ELSE 288 : C 289 : C ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE 290 : C 291 : MOTERR(1:4)=NOMTP(MELE) 292 : MOTERR(5:12)='FDEBIT' 292 : CALL ERREUR(86) 293 : SEGDES IPT3 294 : SEGDES MCHEL1 295 : SEGDES MCHAM1 295 : CALL DTMODL(IPMOD1) 296 : GOTO 9990 297 : ENDIF 298 : C 299 : MELVAL=IVAFOR 300 : C 301 : C ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN 302 : C ET ON ADDITIONNE LES CHAM/POIN ELEMENTAIRES 303 : C 304 : SEGINI ICPR 305 : NNNOE=0 306 : MELEME = IPOGEO 307 : C 308 : C CREATION DU TABLEAU ICPR 309 : C 310 : SEGACT MELEME 311 : NBNN =NUM(/1) 312 : NBELEM=NUM(/2) 313 : C 314 : DO 511 IOP = 1,NBNN 315 : DO 511 JOP = 1,NBELEM 316 : IPT= NUM(IOP,JOP) 317 : IF(ICPR(IPT).EQ.0) THEN 318 : NNNOE=NNNOE+1 319 : ICPR(IPT)=NNNOE 320 : ENDIF 321 : 511 CONTINUE 322 : C 323 : NNIN=1 324 : SEGINI MTRAV 325 : IF(MOT1.EQ.' ') THEN 326 : INCO(1)=MOFP 327 : ELSE 328 : INCO(1)=MOT1 329 : ENDIF 330 : SEGACT MELVAL 331 : NBPTEL=VELCHE(/1) 332 : NEL =VELCHE(/2) 333 : C 334 : C BOUCLE SUR LES ELEMENTS ET LES NOEUDS 335 : C 336 : DO 420 IBB=1,NBELEM 337 : DO 420 IC=1,NBSOM(IELE) 338 : ICC=IBSOM(NSPOS(IELE)+IC-1) 339 : IPT=ICPR(NUM(ICC,IBB)) 340 : BB(1,IPT)=VELCHE(IC,IBB)+BB(1,IPT) 341 : IBIN(1,IPT)=1 342 : IGEO(IPT)=NUM(ICC,IBB) 343 : 420 CONTINUE 344 : C 345 : SEGDES MELVAL,MELEME 346 : C 347 : C CREATION DU CHPOINT 348 : C 348 : CALL CRECHP(MTRAV,IPCHPO) 349 : SEGSUP MTRAV,ICPR 350 : C 351 : SEGDES MELVAL,MCHAML,MCHELM 351 : CALL DTCHAM(IPCHEL) 351 : CALL DTCHAM(ICHELP) 352 : C 353 : IF (IPCHPO.EQ.0) GOTO 9990 354 : C 355 : C ADDITION DES CHPOINTS ELEMENTAIRES 356 : C 357 : IF ((ISOUS-IRRT).GT.1.OR.IB.GT.1) THEN 357 : CALL ADCHPO(IPCHPO,IPTFP,IRET,1D0,1D0) 357 : CALL ECRCHA(MOGEOM) 357 : CALL DTCHPO(IPCHPO) 357 : CALL ECRCHA(MOGEOM) 357 : CALL DTCHPO(IPTFP) 358 : IF (IRET.EQ.0) GOTO 9990 359 : IPTFP=IRET 360 : ELSE 361 : IPTFP=IPCHPO 362 : ENDIF 362 : CALL DTMODL(IPMOD1) 363 : 110 CONTINUE 364 : SEGDES IPT3 365 : SEGDES IMODEL 366 : C 367 : 100 CONTINUE 368 : IF(IRRT.EQ.KMODEL(/1)) THEN 368 : CALL ERREUR(395) 369 : IRET=0 370 : ENDIF 371 : SEGDES MMODEL 372 : RETURN 373 : C 374 : 9990 CONTINUE 375 : IRET=0 376 : C 377 : C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 378 : C 379 : MELVAL=IVAFOR 380 : SEGSUP MELVAL 381 : SEGSUP MCHAML 382 : SEGSUP MCHELM 383 : C 384 : SEGDES IMODEL 385 : SEGDES MMODEL 386 : RETURN 387 : END 388 : 389 : 390 : 391 : 392 : 393 : 394 : 395 : 396 : 397 : 398 : 399 : 400 : 401 : 402 : 403 : 404 : 405 : 406 :
© Cast3M 2003 - All rights reserved.
Disclaimer