1 : C JACOPO SOURCE CHAT 11/03/16 21:25:50 6902 2 : SUBROUTINE JACOPO(IPMODL,IPCHE,IRET) 3 : C======================================================================= 4 : C ENTREES : 5 : C --------- 6 : C IPMODL= pointeur sur un MMODEL 7 : C 8 : C SORTIES : 9 : C -------- 10 : C 11 : C IPCHE = CHAMELEM contenant les JACOBIENS 12 : C IRET = 1 si succes 0 sinon 13 : C 14 : C Passage au nouveau Chamelem PAR S.RAMAHANDRY le 11/09/90 15 : C===================================================================== 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8(A-H,O-Z) 18 : PARAMETER(UN=1.D0,XZER=0.D0) 19 : -INC CCOPTIO 20 : -INC CCHAMP 21 : -INC SMCHAML 22 : -INC SMMODEL 23 : -INC SMELEME 24 : -INC SMCOORD 25 : -INC SMINTE 26 : C 27 : SEGMENT TRA 28 : REAL*8 XEL(3,NBNN) ,SHP(6,NBNN) ,XE(3,NBNN) ,BPSS(3,3) 29 : ENDSEGMENT 30 : C 31 : SEGMENT TR1 32 : REAL*8 TH(NBN1) ,TXR(3,3,NBN1) ,XJ(3,3) 33 : ENDSEGMENT 34 : C 35 : SEGMENT INFO 36 : INTEGER INFELL(JG) 37 : ENDSEGMENT 38 : C 39 : SEGMENT MPTVAL 40 : INTEGER IPOS(NS) , NSOF(NS) 41 : INTEGER IVAL(NCOSOU) 42 : CHARACTER*16 TYVAL(NCOSOU) 43 : ENDSEGMENT 44 : C 45 : DIMENSION BPSS(3,3) 46 : CHARACTER*8 CMATE 47 : C 48 : NHRM=NIFOUR 49 : IRET=1 50 : C 51 : C ACTIVATION DU MODELE 52 : C 53 : MMODEL= IPMODL 54 : SEGACT MMODEL 55 : NSOUS=KMODEL(/1) 56 : C 57 : C CREATION DU MCHELM 58 : C 59 : N1=NSOUS 60 : L1=8 61 : N3=6 62 : SEGINI MCHELM 63 : IPCHE=MCHELM 64 : TITCHE='SCALAIRE' 65 : IFOCHE=IFOUR 66 : IRT8=1 67 : C____________________________________________________________________ 68 : C 69 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES 70 : C____________________________________________________________________ 71 : C 72 : DO 500 ISOUS=1,NSOUS 73 : C 74 : C ON RECUPERE L INFORMATION GENERALE 75 : C 76 : IMODEL=KMODEL(ISOUS) 77 : SEGACT IMODEL 78 : IPMAIL=IMAMOD 79 : IMACHE(ISOUS)=IPMAIL 80 : CONCHE(ISOUS)=CONMOD 81 : C 82 : C TRAITEMENT DU MODELE 83 : C 84 : MELE=NEFMOD 85 : MELEME=IMAMOD 86 : NFOR=FORMOD(/2) 87 : NMAT=MATMOD(/2) 88 : C____________________________________________________________________ 89 : C 90 : C INFORMATION SUR L'ELEMENT FINI 91 : C____________________________________________________________________ 92 : C 93 : if(infmod(/1).lt.7) then 93 : CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 94 : IF (IERR.NE.0) THEN 95 : SEGDES IMODEL,MMODEL 96 : SEGSUP MCHELM 97 : IRET=0 98 : RETURN 99 : ENDIF 100 : INFO=IPINF 101 : MELE =INFELL(1) 102 : MFR =INFELL(13) 103 : MINTE=INFELL(11) 104 : MINTE1=INFELL(12) 105 : segsup info 106 : else 107 : MELE =INFELE(1) 108 : MFR =INFELE(13) 109 : MINTE=INFMOD(7) 110 : MINTE1=INFMOD(8) 111 : endif 112 : C 113 : INFCHE(ISOUS,1)=0 114 : INFCHE(ISOUS,2)=0 115 : INFCHE(ISOUS,3)=NHRM 116 : INFCHE(ISOUS,4)=MINTE 117 : INFCHE(ISOUS,5)=0 118 : INFCHE(ISOUS,6)=5 119 : C 120 : C INITIALISATION DE MINTE 121 : C 122 : SEGACT MINTE 123 : NBPGAU=POIGAU(/1) 124 : C 125 : C ACTIVATION DU MELEME 126 : C 127 : SEGACT MELEME 128 : NBNN =NUM(/1) 129 : NBELEM=NUM(/2) 130 : C 131 : C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER 132 : C 133 : N1PTEL=NBPGAU 134 : N1EL=NBELEM 135 : C 136 : C CREATION DU MCHAML DE LA SOUS ZONE 137 : C 138 : NJAC=1 139 : N2=1 140 : SEGINI MCHAML 141 : ICHAML(ISOUS)=MCHAML 142 : NS=1 143 : NCOSOU=NJAC 144 : SEGINI MPTVAL 145 : IVAJAC=MPTVAL 146 : C 147 : C 1 COMPOSANTE 148 : C 149 : ICOMP=1 150 : NOMCHE(ICOMP)='SCAL ' 151 : TYPCHE(ICOMP)='REAL*8' 152 : N2PTEL=0 153 : N2EL=0 154 : SEGINI MELVAL 155 : IELVAL(ICOMP)=MELVAL 156 : IVAL(ICOMP)=MELVAL 157 : C 158 : C ERREUR FORMULATION INDISPONIBLE 159 : C 160 : IF(MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9.OR.MFR.EQ.7 161 : 1 .OR.MFR.EQ.13.OR.MFR.EQ.33.OR.MFR.EQ.35) 162 : 1 GOTO 44 163 : MOTERR(1:8)=NOMFR(MFR) 163 : CALL ERREUR(193) 164 : IRET=0 165 : GOTO 9990 166 : C 167 : 44 CONTINUE 168 : C 169 : SEGINI TRA 170 : C 171 : C ================== FORMULATION JOINT ======================= 172 : C 173 : C ----------------- Element JOT3 174 : C 175 : IF(MFR.EQ.35) THEN 176 : IF(MELE.EQ.87) THEN 177 : DO 9000 IB=1,NBELEM 177 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 178 : DO 9002 IC=1,NBPGAU 179 : DO 9003 ID=1,6 180 : DO 9003 IE=1,NBNN 181 : SHP(ID,IE)=SHPTOT(ID,IE,IC) 182 : 9003 CONTINUE 183 : 183 : CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 184 : IF (NOQUAL.EQ.1) THEN 185 : INTERR(1)=IB 186 : MOTERR(1:4)='JOT3' 186 : CALL ERREUR(765) 187 : RETURN 188 : ELSE IF(NOQUAL.EQ.2) THEN 189 : INTERR(1)=IB 190 : MOTERR(1:4)='JOT3' 190 : CALL ERREUR(766) 191 : RETURN 192 : ENDIF 193 : 194 : NBNONN=NBNN/2 194 : CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOUR,NIFOUR,2,1.D0,RR,DJAC) 195 : IRRT = 0 196 : IF (DJAC.LT.0.0D0) THEN 197 : IRRT = 1 198 : ELSE IF(DJAC.EQ.0.0D0) THEN 199 : IRRT = 2 200 : ENDIF 201 : IF(IRRT.NE.0) THEN 201 : CALL ERREUR(764) 202 : RETURN 203 : ENDIF 204 : 205 : MPTVAL=IVAJAC 206 : MELVAL = IVAL(1) 207 : IBMN=MIN(IB, VELCHE(/2)) 208 : IGMN=MIN(IC, VELCHE(/1)) 209 : VELCHE(IGMN,IBMN)=ABS(DJAC) 210 : 9002 CONTINUE 211 : 9000 CONTINUE 212 : C 213 : C ----------------- Element JOI4 214 : C 215 : ELSE IF (MELE.EQ.88) THEN 216 : DO 8000 IB=1,NBELEM 216 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 217 : DO 8002 IC=1,NBPGAU 218 : DO 8003 ID=1,6 219 : DO 8003 IE=1,NBNN 220 : SHP(ID,IE)=SHPTOT(ID,IE,IC) 221 : 8003 CONTINUE 222 : 222 : CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 223 : IF (NOQUAL.EQ.1) THEN 224 : INTERR(1)=IB 225 : MOTERR(1:4)='JOI4' 225 : CALL ERREUR(765) 226 : RETURN 227 : ELSE IF(NOQUAL.EQ.2) THEN 228 : INTERR(1)=IB 229 : MOTERR(1:4)='JOI4' 229 : CALL ERREUR(766) 230 : RETURN 231 : ENDIF 232 : 233 : NBNONN=NBNN/2 233 : CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOUR,NIFOUR,2,1.D0,RR,DJAC) 234 : IRRT = 0 235 : IF (DJAC.LT.0.0D0) THEN 236 : IRRT = 1 237 : ELSE IF(DJAC.EQ.0.0D0) THEN 238 : IRRT = 2 239 : ENDIF 240 : IF(IRRT.NE.0) THEN 240 : CALL ERREUR(764) 241 : RETURN 242 : ENDIF 243 : 244 : MPTVAL=IVAJAC 245 : MELVAL = IVAL(1) 246 : IBMN=MIN(IB, VELCHE(/2)) 247 : IGMN=MIN(IC, VELCHE(/1)) 248 : VELCHE(IGMN,IBMN)=ABS(DJAC) 249 : 8002 CONTINUE 250 : 8000 CONTINUE 251 : 252 : ELSE 252 : CALL ERREUR(767) 253 : RETURN 254 : ENDIF 255 : 256 : 257 : 258 : C 259 : C ================ FORMULATION MASSIVE ======================= 260 : C 261 : C 262 : ELSE IF(MFR.EQ.1.OR.MFR.EQ.33) THEN 263 : DO 1000 IB=1,NBELEM 263 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 264 : DO 1002 IC=1,NBPGAU 265 : DO 1003 ID=1,6 266 : DO 1003 IE=1,NBNN 267 : SHP(ID,IE)=SHPTOT(ID,IE,IC) 268 : 1003 CONTINUE 268 : CALL JACOBI(XE,SHP,IDIM,NBNN,DJAC) 269 : MPTVAL=IVAJAC 270 : MELVAL = IVAL(1) 271 : IBMN=MIN(IB, VELCHE(/2)) 272 : IGMN=MIN(IC, VELCHE(/1)) 273 : VELCHE(IGMN,IBMN)=ABS(DJAC) 274 : 1002 CONTINUE 275 : 1000 CONTINUE 276 : GOTO 520 277 : C 278 : C ================ FORMULATION COQUE MINCE ===================== 279 : C 280 : C 281 : ELSE IF(MFR.EQ.3.OR.MFR.EQ.9) THEN 282 : IDI2=IDIM-1 283 : DO 3000 IB=1,NBELEM 283 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 284 : C 285 : IF(IDIM.EQ.2)THEN 285 : CALL VPAST2(XE,BPSS) 286 : ELSE IF(IDIM.EQ.3) THEN 286 : CALL VPAST(XE,BPSS) 287 : ENDIF 287 : CALL VCORL1(XE,XEL,BPSS,NBNN) 288 : DO 3002 IC=1,NBPGAU 289 : DO 3003 ID=1,6 290 : DO 3003 IE=1,NBNN 291 : SHP(ID,IE)=SHPTOT(ID,IE,IC) 292 : 3003 CONTINUE 292 : CALL JACOBI(XEL,SHP,IDI2,NBNN,DJAC) 293 : MPTVAL=IVAJAC 294 : MELVAL = IVAL(1) 295 : IBMN=MIN(IB, VELCHE(/2)) 296 : IGMN=MIN(IC,VELCHE(/1)) 297 : VELCHE(IGMN,IBMN)=ABS(DJAC) 298 : 3002 CONTINUE 299 : 3000 CONTINUE 300 : GOTO 520 301 : C 302 : C ================ FORMULATION POUTRE ET TUYAU ==================== 303 : C 304 : C 305 : ELSE IF(MFR.EQ.7.OR.MFR.EQ.13) THEN 306 : IDI2=IDIM-1 307 : DO 7000 IB=1,NBELEM 307 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 308 : C 309 : DO 7002 IC=1,NBPGAU 309 : CALL POUJAC(XE,DJAC) 310 : MPTVAL=IVAJAC 311 : MELVAL = IVAL(1) 312 : IBMN=MIN(IB, VELCHE(/2)) 313 : IGMN=MIN(IC, VELCHE(/1)) 314 : VELCHE(IGMN,IBMN)=DJAC 315 : 7002 CONTINUE 316 : 7000 CONTINUE 317 : GOTO 520 318 : C 319 : C ================ FORMULATION COQUE EPAISSE ==================== 320 : C 321 : C 322 : ELSE IF(MFR.EQ.5) THEN 323 : SEGACT MINTE1 324 : NBPGA1=MINTE1.POIGAU(/1) 325 : NBN1 =MINTE1.SHPTOT(/2) 326 : SEGINI TR1 327 : C 328 : C UNE PETITE HORREUR ON CONSIDERE LES EPAISSEURS CONSTANTES 329 : C 330 : DO 5010 IC=1,NBNN 331 : TH(IC)=UN 332 : 5010 CONTINUE 333 : DO 5000 IB=1,NBELEM 333 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 334 : C 334 : CALL CQ8LOC(XE,NBN1,MINTE1.SHPTOT,TXR,IRR) 335 : C 336 : DO 5002 IC=1,NBPGAU 337 : E=DZEGAU(IC) 337 : CALL COQ8JC(IC,NBN1,E,XE,TH,TXR,SHPTOT,XJ,DJAC,IRR) 338 : MPTVAL=IVAJAC 339 : MELVAL = IVAL(1) 340 : IBMN=MIN(IB, VELCHE(/2)) 341 : IGMN=MIN(IC, VELCHE(/1)) 342 : VELCHE(IGMN,IBMN)=ABS(DJAC) 343 : 5002 CONTINUE 344 : 5000 CONTINUE 345 : GOTO 520 346 : ENDIF 347 : C--------------------------------------------------------------------- 348 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS 349 : C--------------------------------------------------------------------- 350 : C 351 : 520 CONTINUE 352 : MPTVAL=IVAJAC 353 : DO 515 IO=1,NJAC 354 : IF(IVAL(IO).NE.0) THEN 355 : MELVAL=IVAL(IO) 356 : SEGDES MELVAL 357 : ENDIF 358 : 515 CONTINUE 359 : SEGSUP MPTVAL 360 : C 361 : SEGDES MINTE 362 : * SEGSUP INFO 363 : C 364 : SEGDES IMODEL 365 : SEGDES MELEME 366 : SEGDES MCHAML 367 : C 368 : IF (MFR.EQ.5) THEN 369 : SEGDES MINTE1,TR1 370 : ENDIF 371 : C 372 : SEGSUP TRA 373 : C 374 : 500 CONTINUE 375 : SEGDES MMODEL 376 : SEGDES MCHELM 377 : RETURN 378 : C 379 : C 380 : 9990 CONTINUE 381 : * 382 : C------------------------------------------------------------------- 383 : C ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR 384 : C------------------------------------------------------------------- 385 : * 386 : * 387 : * 388 : MPTVAL=IVAJAC 389 : DO 9993 IO=1,NJAC 390 : IF (IVAL(IO).NE.0) THEN 391 : MELVAL=IVAL(IO) 392 : SEGDES MELVAL 393 : ENDIF 394 : 9993 CONTINUE 395 : SEGSUP MPTVAL 396 : * 397 : * 398 : * 399 : SEGDES MELEME 400 : SEGDES IMODEL 401 : SEGDES MCHAML 402 : C 403 : SEGDES MMODEL 404 : SEGDES MCHELM 405 : SEGDES MINTE 406 : * SEGSUP INFO 407 : RETURN 408 : END 409 : 410 : 411 : 412 : 413 : 414 : 415 : 416 : 417 : 418 : 419 :
© Cast3M 2003 - All rights reserved.
Disclaimer