1 : C LSIGMP SOURCE FANDEUR 13/01/29 21:15:59 7683 2 : SUBROUTINE LSIGMP(IMD,IPCHE1,IPCHE2,IPCHE3,IMAT, 3 : & IPCHE4,IRET,IPM,IPNS,IPCHE) 4 : C=======================================================================C 5 : C C 6 : C ENTREES: C 7 : C C 8 : C IPCHE1 Pointeur sur un MCHAML (PRECONTAINTES ET FORCES) C 9 : C IMD NOMBRE TOTAL DE CABLES C 10 : C C 11 : C SORTIES: C 12 : C C 13 : C IPCHE4 Pointeur sur un CHPOINT de forces aux noeuds C 14 : C IRET=1 OU 0 suivant succes ou pas (Message d'erreur) C 15 : C C 16 : C C 17 : C-----------------------------------------------------------------------C 18 : C JIANG modifié FLEURET 05/96 + JMB 10/97 C 19 : C=======================================================================C 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT REAL*8(A-H,O-Z) 22 : C 23 : -INC CCOPTIO 24 : -INC CCHAMP 25 : -INC SMCHAML 26 : -INC SMCHPOI 27 : -INC SMELEME 28 : -INC SMCOORD 29 : -INC SMMODEL 30 : -INC SMINTE 31 : DIMENSION IPM(*),IVASSS(100) 32 : C 33 : SEGMENT IPNN 34 : INTEGER IPNNUM(NSOU1) 35 : ENDSEGMENT 36 : C 37 : SEGMENT NNUM 38 : INTEGER NNM(NBN,NBELE),NBEM(2,NBELE) 39 : ENDSEGMENT 40 : POINTEUR INN1.NNUM 41 : 42 : SEGMENT ICCOUN 43 : INTEGER INCOR(NBELEM) 44 : ENDSEGMENT 45 : C 46 : SEGMENT NOTYPE 47 : CHARACTER*16 TYPE(NBTYPE) 48 : ENDSEGMENT 49 : C 50 : SEGMENT MPTVAL 51 : INTEGER IPOS(NS) ,NSOF(NS) 52 : INTEGER IVAL(NCOSOU) 53 : CHARACTER*16 TYVAL(NCOSOU) 54 : ENDSEGMENT 55 : C 56 : C SEGMENT WRK4 57 : C REAL*8 XEC(3,NBN) 58 : C ENDSEGMENT 59 : C 60 : PARAMETER ( NINF=3 ) 61 : INTEGER INFOS(NINF) 62 : CHARACTER*8 CMATE 63 : CHARACTER*(NCONCH) CONM 64 : LOGICAL lsupfo 65 : C 66 : C --- CREATION D UNE VARIABLE UTILISEE LORS DE LA DESTRUCTION D UN 67 : C CHAMP POINT 68 : C 69 : CHARACTER*4 LAGEOM 70 : LAGEOM='GEOM' 71 : C 72 : IPNN=IPNS 73 : SEGACT IPNN 74 : C 75 : C --- CABLES MERIDIENS 76 : C 77 : IPMODB=IPM(1) 78 : LIYW=IMD 79 : DO 99999 IMMD=2,LIYW 80 : IPMODC=IPM(IMMD) 81 : C 82 : C --- Verification du lieu support du MCHAML de contraintes 83 : C 83 : CALL QUESUP(IPMODC,IPCHE1,3,0,ISUP1,IRET1) 84 : IF (ISUP1.GT.1) THEN 85 : IRET=0 86 : RETURN 87 : ENDIF 88 : C======================================================================= 89 : C = 90 : C ACTIVATION DU MODELE (CABLE PRECONTRAINT: IMMD) = 91 : C = 92 : C======================================================================= 93 : MMODEL=IPMODC 94 : SEGACT MMODEL 95 : NSOU1=KMODEL(/1) 96 : 97 : DO 40 ISOU1=1,NSOU1 98 : IF(ISOU1.GT.1) THEN 99 : MMODEL = IPM(IMMD) 100 : SEGACT MMODEL 101 : END IF 102 : C 103 : C --- ACTIVATION DES CONTRAINTES 104 : C 105 : IRET=1 106 : MCHEL1=IPCHE1 107 : SEGACT MCHEL1 108 : C 109 : C --- BOUCLE SUR LES SOUS ZONES 110 : C 111 : C --- INITIALISATION 112 : C 113 : IVAMAT=0 114 : IVACAR=0 115 : IVASTR=0 116 : IVAFOR=0 117 : NMATR=0 118 : NMATF=0 119 : NCARA=0 120 : NCARF=0 121 : NSTR=0 122 : NFORC=0 123 : MOMATR=0 124 : MOCARA=0 125 : C 126 : C --- TRAITEMENT DU MODELE 127 : C 128 : IMODEL=KMODEL(ISOU1) 129 : SEGACT IMODEL 130 : MELE=NEFMOD 131 : MELEM=MELE 132 : IPMAIL=IMAMOD 133 : CONM =CONMOD 134 : NFOR=FORMOD(/2) 135 : NMAT=MATMOD(/2) 136 : C 137 : C --- ACTIVATION DU MELEME 138 : C 139 : MELEME=IPMAIL 140 : SEGACT MELEME 141 : NBNN=NUM(/1) 142 : NBELEM=NUM(/2) 143 : 144 : NNUM=IPNNUM(ISOU1) 145 : segact NNUM 146 : C 147 : C --- CREATION DU TABLEAU INFOS 148 : C 148 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 149 : IF (IRTD.EQ.0) THEN 150 : SEGDES IMODEL,MMODEL 151 : SEGDES MCHEL1 152 : IRET=0 153 : RETURN 154 : ENDIF 155 : C 156 : C --- INFORMATIONS SUR L'ELEMENT FINI 157 : C 158 : NBPGAC= INFELE(4) 159 : NBG = INFELE(6) 160 : * MINTE = INFELE(11) 161 : minte=infmod(5) 162 : MINTE1= INFMOD(8) 163 : IPMINT= MINTE 164 : IPMITC= INFELE(11) 165 : IPMIN1= MINTE1 166 : MFR = INFELE(13) 167 : NSTRS = INFELE(16) 168 : LW = INFELE(7) 169 : NDDL = INFELE(15) 170 : LIXW=1 171 : C======================================================================= 172 : C = 173 : C ACTIVATION DU MODELE (BETON) = 174 : C = 175 : C======================================================================= 176 : MMODEL=IPMODB 177 : SEGACT MMODEL 178 : NSOUS=KMODEL(/1) 179 : 180 : C 181 : C --- INITIALISATION DU MCHELM DE FORCES 182 : C 183 : L1=6 184 : N1=NSOUS 185 : N3=5 186 : IF(ISOU1.EQ.1) THEN 187 : SEGINI MCHELM 188 : IPCHE5=MCHELM 189 : ifoche=ifour 190 : titche='forces' 191 : ELSE 192 : MCHELM=IPCHE5 193 : SEGACT MCHELM 194 : END IF 195 : C IFOCHE=IFOUR 196 : C TITCHE='FORCES' 197 : C 198 : C --- BOUCLE SUR LES SOUS ZONES 199 : C 200 : DO 200 ISOUS=1,NSOUS 201 : 202 : C nnum = ipnnum(isous) 203 : C segact nnum 204 : 205 : C --- INITIALISATION 206 : C 207 : IVAMAT=0 208 : IVACAR=0 209 : IVASTR=0 210 : IVAFOR=0 211 : NMATR=0 212 : NMATF=0 213 : NCARA=0 214 : NCARF=0 215 : NFORC=0 216 : MOMATR=0 217 : MOCARA=0 218 : C 219 : C --- TRAITEMENT DU MODELE 220 : C 221 : IMODEL=KMODEL(ISOUS) 222 : SEGACT IMODEL 223 : MELE=NEFMOD 224 : IPMAIL=IMAMOD 225 : CONM =CONMOD 226 : NFOR=FORMOD(/2) 227 : NMAT=MATMOD(/2) 228 : 229 : 230 : MELEME=IPMAIL 231 : SEGACT MELEME 232 : NBNN=NUM(/1) 233 : NBELEM=NUM(/2) 234 : 235 : C----------------------------------------------- 236 : C -on ne construit un champ de force que sur les élements ad hoc 237 : 238 : segini iccoun 239 : 240 : C segact nnum 241 : nbele = nnm(/2) 242 : nbn = nnm(/1) 243 : C 244 : segini inn1 245 : inmo = inn1 246 : C 247 : nbelem = nnm(/2) 248 : nbnn = NUM(/1) 249 : * write(6,*) 'initial nbelem nbnn ' ,nbelem ,nbnn 250 : nbsous =0 251 : nbref = 0 252 : 253 : segini ipt4 254 : imaicab= ipt4 255 : ipt4.itypel= itypel 256 : ibnew = 0 257 : 258 : do 7000 ic=1,nbelem 259 : if(nbem(2,IC).ne.isous) goto 7000 260 : ib = nbem(1,IC) 261 : if (incor(ib).EQ.0 ) then 262 : ibnew = ibnew + 1 263 : incor(ib) = ibnew 264 : do 7001 in=1,nbnn 265 : ipt4.num(in,ibnew) = num(in,nbem(1,ic)) 266 : ibnec = ibnew 267 : 7001 continue 268 : else 269 : ibnec = incor(ib) 270 : endif 271 : 272 : inn1.nbem(1,ic) = ibnec 273 : inn1.nbem(2,ic) = isous 274 : 275 : do 6998 in = 1,nbn 276 : inn1.nnm(in,ic) = nnm(in,ic) 277 : 6998 continue 278 : * write(6,*) 'isous elbet elcab' ,isous, nbem(1,ic),ibnec 279 : 280 : 7000 continue 281 : 282 : nbelem = ibnew 283 : segadj ipt4 284 : 285 : C segdes nnum 286 : segdes inn1 287 : segsup iccoun 288 : 289 : C segdes ipt4 290 : 291 : C7002 continue 292 : C---------------------------------------------- 293 : C 294 : C --- RECOPIE DU MCHELM 295 : C 296 : C 297 : C IMACHE(ISOUS)=IPMAIL 298 : imache(isous)=imaicab 299 : C 300 : C --- INFORMATIONS SUR L'ELEMENT FINI 301 : C 302 : NBPGAU= INFELE(4) 303 : NBG = INFELE(6) 304 : * MINTE = INFELE(11) 305 : minte=INFMOD(5) 306 : MINTE1= INFMOD(8) 307 : IPMINT= MINTE 308 : IPMIN1= MINTE1 309 : MFR = INFELE(13) 310 : LW = INFELE(7) 311 : NDDL = INFELE(15) 312 : LRE = INFELE(9) 313 : LVAL = (LRE*(LRE+1))/2 314 : NHRM = NIFOUR 315 : C 316 : SEGACT MINTE 317 : NBNO=SHPTOT(/2) 318 : C 319 : INFCHE(ISOUS,1)=0 320 : INFCHE(ISOUS,2)=0 321 : INFCHE(ISOUS,3)=NIFOUR 322 : INFCHE(ISOUS,4)=0 323 : INFCHE(ISOUS,5)=0 324 : C 325 : C --- NOMS DE COMPOSANTES NECESSAIRES ( FORCES ) 326 : C 327 : if(lnomid(2).ne.0) then 328 : nomid=lnomid(2) 329 : segact nomid 330 : moforc=nomid 331 : nforc=lesobl(/2) 332 : nfac=0 333 : lsupfo=.false. 334 : else 335 : lsupfo=.true. 335 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NFAC) 336 : endif 337 : C 338 : C --- CREATION DU MCHAML 339 : C --- CAS PARTICULIER MILIEUX POREUX : RIEN SUR FP 340 : C --- CAS PARTICULIER DE LA DEFO PLANE GENE : RIEN SUR FZ MY MX 341 : C 342 : NFOREF=NFORC 343 : N2=NFOREF 344 : C 345 : IF(ISOU1.EQ.1) THEN 346 : SEGINI MCHAML 347 : ICHAML(ISOUS)=MCHAML 348 : ELSE 349 : MCHAML=ICHAML(ISOUS) 350 : SEGACT MCHAML 351 : END IF 352 : NOMID=MOFORC 353 : SEGACT NOMID 354 : C 355 : DO 110 ICOMP=1,N2 356 : NOMCHE(ICOMP)=LESOBL(ICOMP) 357 : TYPCHE(ICOMP)='REAL*8' 358 : 110 CONTINUE 359 : if(lsupfo)SEGsup NOMID 360 : 361 : C 362 : C --- TAILLES DE MELVAL 363 : C 364 : C N1EL=NBELEM 365 : C N1PTEL= NBNN 366 : n1el=ipt4.num(/2) 367 : n1ptel= ipt4.num(/1) 368 : * write(6,*) ' support forces n1el n1ptel ', n1el ,n1ptel 369 : 370 : NBPTEL=NBPGAU 371 : C NEL =N1EL 372 : C 373 : C --- CREATION DU MELVAL DE FORCES 374 : C 375 : NS=1 376 : NCOSOU=NFOREF 377 : IF(IMMD.EQ.2.AND.ISOU1.EQ.1) THEN 378 : SEGINI MPTVAL 379 : IVAFOR=MPTVAL 380 : IVASSS(ISOUS)=IVAFOR 381 : ELSE 382 : MPTVAL=IVASSS(ISOUS) 383 : IVAFOR=MPTVAL 384 : SEGACT MPTVAL 385 : END IF 386 : DO 100 ICOMP=1,NFOREF 387 : N2PTEL=0 388 : N2EL=0 389 : IF(IMMD.EQ.2.AND.ISOU1.EQ.1) THEN 390 : SEGINI MELVAL 391 : IELVAL(ICOMP)=MELVAL 392 : IVAL(ICOMP)=MELVAL 393 : END IF 394 : 100 CONTINUE 395 : C 396 : 396 : CALL LSIGM1(IMAICAB,LRE,NSTRS,NBPGAC,MELE,MELEM,IPCHE1,IPMITC, 397 : & NFORC,IVAFOR,ISOUS,ISOU1,IMMD,INMO) 398 : 399 : C 400 : ipt4 = imaicab 401 : SEGDES IMODEL,MCHAML,MINTE,ipt4 402 : C 403 : IF(IERR.NE.0)THEN 404 : IRET=0 405 : GO TO 9991 406 : ENDIF 407 : C 408 : 200 CONTINUE 409 : segsup inn1 410 : segdes nnum 411 : C 412 : C fin de la boucle sur les sz du modele cable ( 1 pout le moment) 413 : 40 CONTINUE 414 : C 415 : 99999 CONTINUE 416 : IF(ISUP1.EQ.1)THEN 416 : CALL DTMVAL(IVASTR,3) 417 : ELSE 417 : CALL DTMVAL(IVASTR,1) 418 : ENDIF 419 : C 419 : CALL DTMVAL(IVAFOR,1) 420 : C 421 : C --- TRANSFORMATION DU CHAMELEM EN CHPOINT 422 : C 422 : CALL CHAMPO(IPCHE5,0,IPCHE4,IRET) 422 : CALL DTCHAM(IPCHE5) 423 : SEGDES MMODEL 424 : RETURN 425 : 9990 CONTINUE 426 : IRET=0 427 : C 428 : C --- ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 429 : C 430 : IF(ISUP1.EQ.1)THEN 430 : CALL DTMVAL(IVASTR,3) 431 : ELSE 431 : CALL DTMVAL(IVASTR,1) 432 : ENDIF 432 : CALL DTMVAL(IVAFOR,3) 433 : C 434 : SEGDES MINTE 435 : SEGDES IMODEL 436 : 9991 CONTINUE 437 : segsup nnum 438 : SEGSUP MCHAML 439 : C 440 : SEGDES MELEME 441 : SEGDES MMODEL 442 : SEGSUP MCHELM 443 : END 444 : 445 : 446 : 447 : 448 : 449 : 450 : 451 : 452 : 453 : 454 : 455 : 456 :
© Cast3M 2003 - All rights reserved.
Disclaimer