1 : C LEKTAB SOURCE CHAT 11/03/16 21:26:58 6902 2 : SUBROUTINE LEKTAB(MTB,NOMI,IPOINT) 3 : C--------------------------------------------------------------------- 4 : C Ce sous-programme recherche dans la table MTABLE l'indice NOMI. 5 : C NOMI doit se trouver dans la liste LISTS. Le soustype de la table 6 : C est controlé par l'opérateur appelé. 7 : C 8 : C Si l'objet trouvé à l'indice NOMI est du bon type, son pointeur 9 : C IPOINT est renvoyé au sous-programme appelant. 10 : C Sinon, il est calculé et placé à l'indice NOMI de la table MTABLE 11 : C et son pointeur IPOINT est renvoyé au sous-programme appelant. 12 : C--------------------------------------------------------------------- 13 : C 14 : C--------------------------- 15 : C Paramètres Entrée/Sortie : 16 : C--------------------------- 17 : C 18 : C E/ MTABLE : Pointeur de la table contenant l'information cherchée 19 : C E/ NOMI : Indice de la table où on cherche une donnée 20 : C /S IPOINT : Pointeur sur l'objet trouvé ou ajouté à l'indice NOMI 21 : C En cas de problème IPOINT est nul. 22 : C 23 : C--------------------------------------------------------------------- 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8 (A-H,O-Z) 26 : -INC CCOPTIO 27 : -INC CCGEOME 28 : -INC SMELEME 29 : POINTEUR MELEMQ.MELEME 30 : -INC SMMODEL 31 : -INC SMTABLE 32 : POINTEUR IPTR.MTABLE,MTABM.MTABLE 33 : CHARACTER*8 MOTYP,TYPOBJ 34 : CHARACTER*72 ICHAI,CHARRE 35 : LOGICAL IRETL,IBOOL,LOGRE,VLOGI 36 : REAL*8 XRET,XVALRE 37 : * 38 : CHARACTER*(*) NOMI 39 : CHARACTER*8 NOMC,NOMDOM 40 : PARAMETER (NBO=60) 41 : CHARACTER*8 LISTS(NBO),TYPE,NOM,MIND,MINDS,TYPI,MNEFMD 42 : DATA LISTS/'MATESI ','XXVOLUM ','XXCOTE ','XXDIAME ','XXDIEMIN', 43 : & 'MATC ','XXPSOML ','INCO ','KIZG ','KOPT ', 44 : & 'PASDETPS','DOMAINE ','DOMZ ','EQEX ','EQPR ', 45 : & 'XXDIAGSI','KIZG1 ','KIZD ','SOMMET ','CENTRE ', 46 : & 'FACE ','FACEL ','FACEP ','XXNORMAF','XXSURFAC', 47 : & 'MAILLAGE','CETR&FAC','MATRIS ','ELTFA ','XXNORMAE', 48 : & 'KIZA ','ARGS ','SOMCEN ','CESOCE ','NORMALEV', 49 : & 'OENVELOP','XXMSOMME','MATEEF ','ELKONV ','XXDIAGFA', 50 : & 'M1BULLE ','CENTREP0','ELTP1NC ','CENTREP1','VOLUMAC ', 51 : & 'MACRO ','QUADRATI','MACRO1 ','XXDXDY ','MSOMMET ', 52 : & 'MMAIL ','MLGVNIMP','MLGVTIMP','ENVELOPP','FACEL2 ', 53 : & 'QUAF ','XXCTREP1','XXCTREP0','MAILFACE','ARETE '/ 54 : C 55 : C- Initialisations 56 : C 57 : C write(6,*)'DEBUT LEKTAB MTB,NOMI=',MTB,NOMI 58 : MTABLE = ABS(MTB) 59 : 59 : CALL ECRCHA('INEFMD ') 59 : CALL ECROBJ('TABLE',MTABLE) 59 : CALL EXIS 59 : CALL LIRLOG(VLOGI,1,IRET) 60 : IF(IRET.EQ.0)THEN 61 : write(6,*)'LEKTAB : Pb avec INEFMD' 62 : go to 5000 63 : ENDIF 64 : IF(VLOGI)THEN 65 : TYPE=' ' 65 : CALL ACMO(MTABLE,'INEFMD ',TYPE,INEFMD) 66 : IF(TYPE.EQ.'MOT')THEN 66 : CALL ACMM(MTABLE,'INEFMD ',MNEFMD) 67 : IF(MNEFMD.EQ.'LINE')THEN 68 : INEFMD=1 69 : ELSEIF(MNEFMD.EQ.'MACRO')THEN 70 : INEFMD=2 71 : ELSEIF(MNEFMD.EQ.'QUAF ')THEN 72 : INEFMD=3 73 : ELSEIF(MNEFMD.EQ.'LINB ')THEN 74 : INEFMD=4 75 : ELSEIF(MNEFMD.EQ.'ISOQ ')THEN 76 : INEFMD=5 77 : ELSE 78 : INEFMD=0 79 : ENDIF 80 : ELSEIF(TYPE.EQ.'ENTIER')THEN 80 : CALL ACME(MTABLE,'INEFMD ',INEFMD) 81 : ELSE 82 : write(6,*)'LEKTAB : Pb avec INEFMD' 83 : GO TO 5000 84 : ENDIF 85 : ELSE 86 : INEFMD=0 87 : ENDIF 88 : 89 : KECR=0 90 : IF(MTB.LT.0)KECR=1 91 : NOM = NOMI 92 : IPOINT = 0 93 : I211 = 0 94 : I221 = 0 95 : I231 = 0 96 : I241 = 0 97 : I251 = 0 98 : I271 = 0 99 : I291 = 0 100 : I301 = 0 101 : I331 = 0 102 : I341 = 0 103 : I371 = 0 104 : I391 = 0 105 : I501 = 0 106 : I511 = 0 107 : I1201 = 0 108 : I541 = 0 109 : I542 = 0 110 : I551 = 0 111 : I591 = 0 112 : C 113 : C- Détermination du cas à traiter et ventilation 114 : C 115 : CG SEGACT MTABLE 115 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 116 : IPREC=0 117 : ISTOK=0 118 : IF (TYPE.EQ.'DOMAINE ') THEN 119 : c 120 : c traitement special pour le cas ou PRECONDI n'existait pas 121 : c 122 : ICHAI(1:8)='PRECONDI' 123 : MOTYP='MOT' 124 : TYPOBJ=' ' 124 : CALL ACCTAB(MTABLE,MOTYP,IVAL,XRET,ICHAI(1:8),IBOOL 125 : $ ,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 126 : IRETL=.TRUE. 127 : IF(TYPOBJ.EQ.' ') IRETL = .FALSE. 127 : IF(.NOT.IRETL)CALL ECME(MTABLE,'PRECONDI',1) 127 : CALL ACME(MTABLE,'PRECONDI',IPREC) 128 : ENDIF 129 : ISTOK=IPREC 130 : 131 : 131 : CALL OPTLI(IP,LISTS,NOM,NBO) 132 : C write(6,*)' LEKTAB NOM=',nom 133 : IF (IP.EQ.0) THEN 134 : IF (NOM(1:4).EQ.'ARGS') THEN 135 : IP = 32 136 : ELSE 137 : C Indice %m1:8 : N'est pas un indice de table reconnu 138 : MOTERR(1:8) = NOM 138 : CALL ERREUR(791) 139 : RETURN 140 : ENDIF 141 : ENDIF 142 : C write(6,*)' LEKTAB IP=',IP, ' NOMI==========',NOMI 143 : GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90,100 144 : & ,110,120,130,140,150,160,170,180,190,200 145 : & ,210,220,230,240,250,260,270,280,290,300 146 : & ,310,320,330,340,350,360,370,380,390,400 147 : & ,410,420,430,440,450,460,470,480,490,500 148 : & ,510,520,530,540,550,560,570,580,590,600),IP 149 : C 150 : C Si PRECONDI = 0 (IPREC=0) On recaclcule systématiquement les numéros 151 : C suivant : 10 20 30 40 50 60 70 160 240 250 300 350 360 370 380 400 152 : C 450 490 153 : C 154 : C-*DOMAINE.'MATESI' 155 : C 156 : 10 CONTINUE 157 : TYPE = ' ' 157 : CALL ACMO(MTABLE,'MATESI',TYPE,MATRIK) 158 : IF (TYPE.NE.'MATRIK '.OR.IPREC.EQ.0) THEN 158 : CALL ECROBJ('TABLE',MTABLE) 158 : CALL HRSI 159 : TYPE='MATRIK' 159 : CALL LIROBJ(TYPE,MATRIK,1,IRET) 160 : IF (IRET.EQ.0) GOTO 5000 160 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATESI','MATRIK',MATRIK) 161 : ENDIF 162 : IPOINT = MATRIK 162 : IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK) 163 : RETURN 164 : C 165 : C-*DOMAINE.'XXVOLUM' : CHPO CENTRE contenant le volume des éléments 166 : C 167 : 20 CONTINUE 168 : TYPE = ' ' 168 : CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI) 169 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 170 : C write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule' 171 : TYPE=' ' 171 : CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC) 171 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME) 171 : CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI) 171 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI) 172 : ENDIF 173 : IPOINT = MCHPOI 173 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 174 : C write(6,*) 'Retour XXVOLUM : MTABLE=',MTABLE 175 : RETURN 176 : C 177 : C-*DOMAINE.'XXCOTE' 178 : C 179 : 30 CONTINUE 180 : TYPE=' ' 180 : CALL ACMO(MTABLE,'XXCOTE',TYPE,MCHPOI) 181 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 182 : C write(6,*) 'On ne trouve pas XXCOTE -> On le calcule' 182 : CALL ECROBJ('TABLE ',MTABLE) 182 : CALL KCOT 183 : TYPE = 'CHPOINT ' 183 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 184 : IF (IRET.EQ.0) GOTO 5000 184 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCOTE','CHPOINT ',MCHPOI) 185 : ENDIF 186 : IPOINT = MCHPOI 186 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 187 : C write(6,*) 'Retour XXCOTE : MTABLE=',MTABLE 188 : RETURN 189 : C 190 : C-*DOMAINE.'XXDIAME' 191 : C 192 : 40 CONTINUE 193 : TYPE = ' ' 193 : CALL ACMO(MTABLE,'XXDIAME ',TYPE,MCHPOI) 194 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 195 : C write(6,*) 'On ne trouve pas XXDIAME -> On le calcule' 195 : CALL ECROBJ('TABLE ',MTABLE) 195 : CALL KDME 196 : TYPE = 'CHPOINT ' 196 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 197 : IF (IRET.EQ.0) GOTO 5000 197 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAME','CHPOINT ',MCHPOI) 198 : ENDIF 199 : IPOINT = MCHPOI 199 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 200 : C write(6,*) 'Retour XXDIAME : MTABLE=',MTABLE 201 : RETURN 202 : C 203 : C-*DOMAINE.'XXDIEMIN' 204 : C 205 : 50 CONTINUE 206 : TYPE = ' ' 206 : CALL ACMO(MTABLE,'XXDIEMIN',TYPE,MCHPOI) 207 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 208 : C write(6,*) 'On ne trouve pas XXDIEMIN -> On le calcule' 208 : CALL ECROBJ('TABLE ',MTABLE) 208 : CALL KDMI 209 : TYPE = 'CHPOINT ' 209 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 210 : IF (IRET.EQ.0) GOTO 5000 210 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIEMIN','CHPOINT ',MCHPOI) 211 : ENDIF 212 : IPOINT = MCHPOI 212 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 213 : C write(6,*) 'Retour XXDIEMIN : MTABLE=',MTABLE 214 : RETURN 215 : C 216 : C-*????.'MATC' 217 : C 218 : 60 CONTINUE 219 : TYPE = ' ' 219 : CALL ACMO(MTABLE,'MATC',TYPE,MATRAK) 220 : IF (TYPE.NE.'MATRAK '.OR.IPREC.EQ.0) THEN 221 : c? IF (TYPE.NE.'MATRAK ') THEN 221 : CALL KMEC(MTABLE,MATRAK) 222 : IF (MATRAK.EQ.0) GOTO 5000 222 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATC','MATRAK',MATRAK) 223 : ENDIF 224 : IPOINT = MATRAK 224 : IF(KECR.EQ.1)CALL ECROBJ('MATRAK',MATRAK) 225 : RETURN 226 : C 227 : C-*DOMAINE.'XXPSOML' : MCHAML, intégrale des fonctions tests par élément 228 : C 229 : 70 CONTINUE 229 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 230 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 231 : TYPE = ' ' 231 : CALL ACMO(MTABLE,'XXPSOML',TYPE,ICHE) 232 : IF (TYPE.NE.'MCHAML '.OR.IPREC.EQ.0) THEN 232 : CALL ECROBJ('TABLE',MTABLE) 232 : CALL KPSOML 233 : TYPE = 'MCHAML' 233 : CALL LIROBJ(TYPE,ICHE,1,IRET) 234 : IF (IRET.EQ.0) GOTO 5000 234 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXPSOML','MCHAML',ICHE) 235 : ENDIF 236 : IPOINT = ICHE 236 : IF(KECR.EQ.1)CALL ECROBJ('MCHAML ',ICHE) 237 : RETURN 238 : C 239 : C- ????-INCO : TABLE de sous-type INCO 240 : C 241 : 80 CONTINUE 242 : MIND = LISTS(8) 243 : MINDS = LISTS(8) 244 : GOTO 1000 245 : C 246 : C- ????-KIZG : TABLE de sous-type KIZG 247 : C 248 : 90 CONTINUE 249 : MIND = LISTS(9) 250 : MINDS = LISTS(9) 251 : GOTO 1000 252 : C 253 : C- ????-KOPT : TABLE de sous-type KOPT 254 : C 255 : 100 CONTINUE 256 : MIND = LISTS(10) 257 : MINDS = LISTS(10) 258 : GOTO 1000 259 : C 260 : C- ????-PASDETPS : TABLE de sous-type PASDETPS 261 : C 262 : 110 CONTINUE 263 : MIND = LISTS(11) 264 : MINDS = LISTS(11) 265 : GOTO 1000 266 : C 267 : C- ????-DOMAINE : TABLE de sous-type DOMAINE 268 : C 269 : 120 CONTINUE 270 : MIND = LISTS(12) 271 : MINDS = LISTS(12) 272 : GOTO 1000 273 : C 274 : C- ????-DOMZ : TABLE de sous-type DOMAINE 275 : C 276 : 130 CONTINUE 277 : MIND = LISTS(13) 278 : MINDS = LISTS(12) 279 : GOTO 1000 280 : C 281 : C- ????-EQEX : TABLE de sous-type EQEX 282 : C 283 : 140 CONTINUE 284 : MIND = LISTS(14) 285 : MINDS = LISTS(14) 286 : GOTO 1000 287 : C 288 : C- ????-EQPR : TABLE de sous-type EQPR 289 : C 290 : 150 CONTINUE 291 : MIND = LISTS(15) 292 : MINDS = LISTS(15) 293 : GOTO 1000 294 : C 295 : C-*DOMAINE.'XXDIAGSI' 296 : C 297 : 160 CONTINUE 298 : TYPE = ' ' 298 : CALL ACMO(MTABLE,'XXDIAGSI',TYPE,MCHPOI) 299 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 300 : C write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule' 300 : CALL ECROBJ('TABLE ',MTABLE) 300 : CALL CADGSI 301 : TYPE = 'CHPOINT ' 301 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 302 : IF (IRET.EQ.0) GOTO 5000 302 : IF(ISTOK.EQ.1) CALL ECMO(MTABLE,'XXDIAGSI','CHPOINT ',MCHPOI) 303 : ENDIF 304 : IPOINT = MCHPOI 304 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 305 : C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE 306 : RETURN 307 : C 308 : C- ????-KIZG1 : TABLE de sous-type KIZG1 309 : C 310 : 170 CONTINUE 311 : MIND = LISTS(17) 312 : MINDS = LISTS(17) 313 : GOTO 1000 314 : C 315 : C- ????-KIZD : TABLE de sous-type KIZD 316 : C 317 : 180 CONTINUE 318 : MIND = LISTS(18) 319 : MINDS = LISTS(18) 320 : GOTO 1000 321 : C 322 : C- DOMAINE.'SOMMET' : MELEME de POI1 contenant les sommets du maillage 323 : C 324 : 190 CONTINUE 324 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 325 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 326 : TYPE = ' ' 326 : CALL ACMO(MTABLE,'SOMMET',TYPE,MELEM1) 327 : IF (TYPE.NE.'MAILLAGE') THEN 328 : TYPE = ' ' 328 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME) 329 : IF (TYPE.NE.'MAILLAGE') GOTO 5000 329 : CALL ECRCHA('POI1') 329 : CALL ECROBJ('MAILLAGE',MELEME) 329 : CALL PRCHAN 329 : CALL LIROBJ('MAILLAGE',MELEM1,1,IRET) 330 : IF (IRET.EQ.0) GOTO 5000 330 : CALL ECMO(MTABLE,'SOMMET','MAILLAGE',MELEM1) 331 : ENDIF 332 : IPOINT = MELEM1 332 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEM1) 333 : RETURN 334 : C 335 : C- DOMAINE.'CENTRE' : MELEME de POI1 contenant les centres du maillage 336 : C 337 : 200 CONTINUE 337 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 338 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 339 : TYPE = ' ' 339 : CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC) 340 : IF (TYPE.NE.'MAILLAGE') THEN 341 : TYPE = ' ' 341 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME) 342 : IF (TYPE.NE.'MAILLAGE') GOTO 5000 342 : CALL ECROBJ('MAILLAGE',MELEME) 342 : CALL CRECTR 342 : CALL LIROBJ('MAILLAGE',MELEMC,1,IRET) 343 : IF (IRET.EQ.0) GOTO 5000 343 : CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMC) 344 : ENDIF 345 : IPOINT = MELEMC 345 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMC) 346 : RETURN 347 : C 348 : C- DOMAINE.'FACE' : MELEME de POI1 contenant les faces du maillage 349 : C 350 : 210 CONTINUE 350 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 351 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 352 : TYPE = ' ' 352 : CALL ACMO(MTABLE,'FACE',TYPE,MELEF1) 353 : IF (TYPE.NE.'MAILLAGE') THEN 354 : I211 = 1 355 : GOTO 1100 356 : ENDIF 357 : 211 CONTINUE 358 : IPOINT = MELEF1 358 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEF1) 359 : RETURN 360 : C 361 : C- DOMAINE.'FACEL' : MELEME des connectivités centre-face-centre 362 : C 363 : 220 CONTINUE 363 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 364 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 365 : TYPE = ' ' 365 : CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF) 366 : IF (TYPE.NE.'MAILLAGE') THEN 367 : I221 = 1 368 : GOTO 1100 369 : ENDIF 370 : 221 CONTINUE 371 : IPOINT = MELEMF 371 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMF) 372 : RETURN 373 : C 374 : C- DOMAINE.'FACEP' : MELEME des connectivités sommet-face-sommet 375 : C 376 : 230 CONTINUE 376 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 377 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 378 : TYPE = ' ' 378 : CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP) 379 : IF (TYPE.NE.'MAILLAGE') THEN 380 : I231 = 1 381 : GOTO 1100 382 : ENDIF 383 : 231 CONTINUE 384 : IPOINT = MELEMP 384 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMP) 385 : RETURN 386 : C 387 : C-*DOMAINE.'XXNORMAE' : CHPO FACE contenant la normale choisie à la face 388 : C 389 : 240 CONTINUE 389 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 390 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 391 : TYPE = ' ' 391 : CALL ACMO(MTABLE,'XXNORMAF',TYPE,ICHPV) 392 : 393 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN 394 : I241 = 1 395 : GOTO 1200 396 : ENDIF 397 : 241 CONTINUE 398 : IPOINT = ICHPV 398 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',ICHPV) 399 : RETURN 400 : C 401 : C-*DOMAINE.'XXSURFAC' : CHPO FACE contenant l'aire de la face 402 : C 403 : 250 CONTINUE 403 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 404 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 405 : TYPE = ' ' 405 : CALL ACMO(MTABLE,'XXSURFAC',TYPE,ICHP) 406 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 407 : I251 = 1 408 : GOTO 1200 409 : ENDIF 410 : 251 CONTINUE 411 : IPOINT = ICHP 411 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',ICHP) 412 : RETURN 413 : C 414 : C- DOMAINE.'MAILLAGE' : Maillage géométrique du domaine considéré 415 : C 416 : 260 CONTINUE 416 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 417 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 418 : TYPE=' ' 418 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME) 419 : IF (TYPE.NE.'MAILLAGE') THEN 420 : C Indice %m1:8 : Objet de type %m9:16 incorrect 421 : 422 : MOTERR(1:8) = NOM 423 : MOTERR(9:16) = TYPE 423 : CALL ERREUR(787) 424 : RETURN 425 : ENDIF 426 : IPOINT = MELEME 426 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME) 427 : RETURN 428 : C 429 : C- DOMAINE.'CETR&FAC' : Inutilisé (à verifier) -> renvoie 'CENTRE' 430 : C 431 : 270 CONTINUE 431 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 432 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 433 : TYPE = ' ' 433 : CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMK) 434 : IF (TYPE.NE.'MAILLAGE') THEN 435 : I271 = 1 436 : GOTO 1100 437 : ENDIF 438 : 271 CONTINUE 439 : IPOINT = MELEMK 439 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMK) 440 : RETURN 441 : C 442 : C- ????.'MATRIS' 443 : C 444 : 280 CONTINUE 445 : TYPE = ' ' 445 : CALL ACMO(MTABLE,'MATRIS',TYPE,MTABM) 446 : IF (TYPE.NE.'TABLE ') THEN 447 : IMPR=1 447 : CALL ECRENT(IMPR) 447 : CALL ECRCHA('IMPR') 447 : CALL ECROBJ('TABLE',MTABLE) 447 : CALL PROGCS 447 : CALL LIROBJ('TABLE',MTABM,1,IRET) 448 : IF (IRET.EQ.0) GOTO 5000 448 : CALL ECMO(MTABLE,'MATRIS','TABLE',MTABM) 449 : ENDIF 450 : IPOINT = MTABM 450 : IF(KECR.EQ.1)CALL ECROBJ('TABLE',MTABM) 451 : RETURN 452 : C 453 : C- DOMAINE.'ELTFA' : MELEME connectivite face par élément (Hdiv) 454 : C 455 : 290 CONTINUE 455 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 456 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 457 : TYPE = ' ' 457 : CALL ACMO(MTABLE,'ELTFA',TYPE,MELAF) 458 : IF (TYPE.NE.'MAILLAGE') THEN 459 : I291 = 1 460 : GOTO 1100 461 : ENDIF 462 : 291 CONTINUE 463 : IPOINT = MELAF 463 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELAF) 464 : RETURN 465 : C 466 : C-*DOMAINE.'XXNORMAE' : MCHAML d'orientation des normales 467 : C 468 : 300 CONTINUE 468 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 469 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 470 : TYPE = ' ' 470 : CALL ACMO(MTABLE,'XXNORMAE',TYPE,ICHE) 471 : IF (TYPE.NE.'MCHAML '.OR.IPREC.EQ.0) THEN 472 : I301 = 1 473 : GOTO 1200 474 : ENDIF 475 : 301 CONTINUE 476 : IPOINT = ICHE 476 : IF(KECR.EQ.1)CALL ECROBJ('MCHAML ',ICHE) 477 : RETURN 478 : C 479 : C- ????.'KIZA' : TABLE de sous-type KIZA 480 : C 481 : 310 CONTINUE 482 : MIND=LISTS(31) 483 : MINDS=LISTS(31) 484 : GOTO 1000 485 : C 486 : C- ????.'ARGS...' : CHPO 487 : C 488 : 320 CONTINUE 489 : TYPE = ' ' 489 : CALL ACMO(MTABLE,NOM,TYPE,MCHP) 490 : IF (TYPE.NE.'CHPOINT ') THEN 491 : NC = 10 491 : CALL COCHPT(NC,MCHP) 491 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,NOM,'CHPOINT',MCHP) 492 : ENDIF 493 : IPOINT = MCHP 493 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT',MCHP) 494 : RETURN 495 : C 496 : C- DOMAINE.'SOMCEN' 497 : C Cet indice contient un maillage de connectivités sommet-centre 498 : C Il est constitué d'éléments de type POLY : 499 : C - le premier noeud est le sommet considéré ; 500 : C - les noeuds suivants sont les centres des éléments 501 : C contenant le sommet considéré. 502 : C 503 : 330 CONTINUE 503 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 504 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 505 : TYPE = ' ' 505 : * CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM) 505 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM) 506 : IF (TYPE.NE.'MAILLAGE') THEN 507 : C Indice %m1:8 : Objet de type %m9:16 incorrect 508 : 509 : MOTERR(1:8) = NOM 510 : MOTERR(9:16) = TYPE 510 : CALL ERREUR(787) 511 : RETURN 512 : ENDIF 513 : * IF (TYPE.NE.'MAILLAGE') THEN 514 : * I331 = 1 515 : * GOTO 1300 516 : * ENDIF 517 : 331 CONTINUE 518 : TYPE = ' ' 518 : CALL ACMO(MTABLE,'SOMCEN',TYPE,MSOCEN) 519 : IF (TYPE.NE.'MAILLAGE') THEN 520 : TYPE = 'MAILLAGE' 520 : CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN) 520 : * CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS) 520 : CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS) 520 : CALL POIELE(MMELEM,MMLEMS,MELCEN,MSOCEN) 520 : CALL ECMO(MTABLE,'SOMCEN','MAILLAGE',MSOCEN) 521 : ENDIF 522 : IPOINT = MSOCEN 522 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MSOCEN) 523 : RETURN 524 : C 525 : C- DOMAINE.'CESOCE' 526 : C cet indice contient un maillage de connectivités 527 : C centre-(sommet)-centre. 528 : C Il est constitué d'éléments de type POLY : 529 : C - le premier noeud est le centre de l'élément considéré ; 530 : C - les noeuds suivants sont les centres des éléments 531 : C ayant au moins un sommet commun avec l'élément considéré. 532 : C 533 : 340 CONTINUE 533 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 534 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 535 : TYPE=' ' 535 : * CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM) 535 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM) 536 : IF (TYPE.NE.'MAILLAGE') THEN 537 : C Indice %m1:8 : Objet de type %m9:16 incorrect 538 : 539 : MOTERR(1:8) = NOM 540 : MOTERR(9:16) = TYPE 540 : CALL ERREUR(787) 541 : RETURN 542 : ENDIF 543 : * IF (TYPE.NE.'MAILLAGE') THEN 544 : * I341 = 1 545 : * GOTO 1300 546 : * ENDIF 547 : 341 CONTINUE 548 : TYPE = ' ' 548 : CALL ACMO(MTABLE,'CESOCE',TYPE,MSOCEN) 549 : IF (TYPE.NE.'MAILLAGE') THEN 550 : TYPE = 'MAILLAGE' 550 : CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN) 550 : * CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS) 550 : CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS) 550 : CALL ELPOEL(MMELEM,MMLEMS,MELCEN,MCESOC) 550 : CALL ECMO(MTABLE,'CESOCE','MAILLAGE',MCESOC) 551 : ENDIF 552 : IPOINT = MCESOC 552 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MCESOC) 553 : RETURN 554 : C 555 : C-*NORMALEV 556 : C 557 : 350 CONTINUE 558 : TYPE = ' ' 558 : CALL ACMO(MTABLE,'NORMALEV',TYPE,MNORM) 559 : 351 CONTINUE 560 : IF (TYPE.NE.'MAILLAGE'.OR.IPREC.EQ.0) THEN 561 : TYPE = 'MAILLAGE' 561 : CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ) 562 : C petite verification 563 : SEGACT MELEMQ 564 : ICONF=1 565 : DO 62486 L=1,MAX(1,MELEMQ.LISOUS(/1)) 566 : IPT1=MELEMQ 567 : IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L) 568 : SEGACT IPT1 569 : IF(IDIM.EQ.2.AND.NOMS(IPT1.ITYPEL).NE.'SEG3')THEN 570 : ICONF=0 571 : ENDIF 572 : IF(IDIM.EQ.3.AND.NOMS(IPT1.ITYPEL).NE.'TRI7' 573 : & .AND.NOMS(IPT1.ITYPEL).NE.'QUA9')THEN 574 : ICONF=0 575 : ENDIF 576 : SEGDES IPT1 577 : 62486 CONTINUE 578 : SEGDES MELEMQ 579 : 580 : IF(ICONF.EQ.0)THEN 581 : TYPE=' ' 581 : CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL) 582 : IF(TYPE.NE.'MAILLAGE')THEN 582 : CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET) 583 : IF (IRET.EQ.0) GOTO 5000 583 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL) 583 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI) 584 : IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP') 584 : & CALL ECROBJ('MAILLAGE',MENVEL) 584 : IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')CALL ECROBJ('CHPOINT',MCHPOI) 585 : ENDIF 585 : CALL ACME(MTABLE,'INEFMD',INEFMD) 585 : CALL ACMF(MTABLE,'TOLER',TOLER) 585 : CALL ACMM(MTABLE,'NOMDOM',NOMDOM) 586 : MACRO=0 587 : MTABI=0 587 : CALL KKDOM(MENVEL,MACRO,TOLER,NOMDOM,MTABI,MTABD,INEFMD) 587 : CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME) 587 : CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS) 588 : ELSE 588 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME) 588 : CALL ACMO(MTABLE,'SOMMET',TYPE,MELEMS) 589 : ENDIF 590 : 590 : CALL NORMNO(MELEME,MELEMS,MNORM,IRET) 591 : IF (IRET.EQ.0) THEN 592 : C Indice %m1:8 : Objet de type %m9:16 incorrect 593 : 594 : MOTERR(1:8) = 'NORMALEV' 595 : MOTERR(9:16) = TYPE 595 : CALL ERREUR(787) 596 : RETURN 597 : ENDIF 598 : ENDIF 598 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'NORMALEV','CHPOINT',MNORM) 599 : IPOINT=MNORM 600 : IF(NOM.EQ.'OENVELOP')IPOINT=MCHPOI 600 : IF(KECR.EQ.1.AND.NOMI.EQ.'NORMALEV')CALL ECROBJ('CHPOINT',MNORM) 600 : IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')CALL ECROBJ('CHPOINT',MCHPOI) 601 : 602 : RETURN 603 : C 604 : C-*OENVELOP 605 : C 606 : 360 CONTINUE 606 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 607 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 608 : TYPE=' ' 608 : CALL ACMO(MTABLE,'OENVELOP',TYPE,MCHPOI) 609 : IF (TYPE.NE.'CHPOINT'.OR.IPREC.EQ.0)THEN 610 : TYPE=' ' 611 : GO TO 351 612 : ENDIF 613 : IPOINT = MCHPOI 613 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME) 614 : RETURN 615 : C 616 : C-*DOMAINE.'XXMSOMME' 617 : C 618 : 370 CONTINUE 619 : TYPE = ' ' 619 : CALL ACMO(MTABLE,'XXMSOMME',TYPE,MCHPOI) 620 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 621 : C write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule' 621 : CALL ACMO(MTABLE,'MMAIL ',TYPE,MELEME) 622 : IF (TYPE.NE.'MAILLAGE') THEN 623 : I371 = 1 624 : GOTO 1300 625 : ENDIF 625 : CALL ECRCHA('MSOMMET') 625 : CALL ECROBJ('TABLE ',MTABLE) 625 : CALL CADGSI 626 : TYPE = 'CHPOINT ' 626 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 627 : IF (IRET.EQ.0) GOTO 5000 627 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXMSOMME','CHPOINT ',MCHPOI) 628 : ENDIF 629 : IPOINT = MCHPOI 629 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 630 : C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE 631 : RETURN 632 : C /\ 633 : C-*DOMAINE.'MATEEF' : En chantier /! \ / 634 : C / <-/ 635 : 380 CONTINUE 635 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 636 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 637 : TYPE=' ' 637 : CALL ACMO(MTABLE,'MATEEF',TYPE,MATRIK) 638 : IF (TYPE.NE.'MATRIK '.OR.IPREC.EQ.0) THEN 638 : CALL ECROBJ('TABLE',MTABLE) 638 : C CALL HREF 639 : MOTERR(1:27) = ' LEKTAB : HREF hors service' 639 : CALL ERREUR(-301) 640 : TYPE='MATRIK' 640 : CALL LIROBJ(TYPE,MATRIK,1,IRET) 641 : IF (IRET.EQ.0) GOTO 5000 641 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATEEF','MATRIK',MATRIK) 642 : ENDIF 643 : IPOINT = MATRIK 643 : IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK) 644 : RETURN 645 : C 646 : C- DOMAINE.'ELKONV' 647 : C 648 : 390 CONTINUE 648 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 649 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 650 : TYPE = ' ' 650 : CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF) 651 : IF (TYPE.NE.'MAILLAGE') THEN 652 : C write(6,*)' LEKTAB FACEL n existe pas on le cree ' 653 : I391 = 1 654 : GOTO 1100 655 : ENDIF 656 : C write(6,*)' LEKTAB FACEL existe ' 657 : 391 CONTINUE 658 : TYPE = ' ' 658 : CALL ACMO(MTABLE,'ELKONV',TYPE,MKONV) 659 : IF (TYPE.NE.'MAILLAGE') THEN 660 : TYPI = 'MAILLAGE' 660 : CALL ACMO(MTABLE,'FACE',TYPI,MELEF1) 660 : CALL ACMO(MTABLE,'FACEL',TYPI,MELEMF) 660 : CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMK) 660 : CALL ACMO(MTABLE,'ELTFA',TYPI,MELAF) 661 : C write(6,*)' melef1,melemf,melemk,melaf=' 662 : C & ,melef1,melemf,melemk,melaf 662 : CALL ELKONV(MELAF,MELEMF,MELEF1,MELEMK,MKONV) 662 : CALL ECMO(MTABLE,'ELKONV','MAILLAGE',MKONV) 663 : ENDIF 664 : IPOINT = MKONV 664 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MKONV) 665 : RETURN 666 : C 667 : C-*DOMAINE.'XXDIAGFA' 668 : C 669 : 400 CONTINUE 670 : TYPE=' ' 670 : CALL ACMO(MTABLE,'XXDIAGFA',TYPE,MCHPOI) 671 : IF(TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN 672 : C write(6,*)' On a pas trouve XXDIAGFA On le calcule ' 672 : CALL ECROBJ('TABLE ',MTABLE) 672 : CALL CADGFA 673 : TYPE='CHPOINT ' 673 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 674 : IF (IRET.EQ.0) GOTO 5000 674 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAGFA','CHPOINT ',MCHPOI) 675 : ENDIF 676 : IPOINT = MCHPOI 676 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 677 : C write(6,*)' retour XXDIAGFA : MTABLE=',MTABLE 678 : RETURN 679 : C 680 : C- ????.'M1BULLE' : En chantier 681 : C 682 : 410 CONTINUE 683 : TYPE = ' ' 683 : CALL ACMO(MTABLE,'M1BULLE',TYPE,IPOINT) 684 : IF(TYPE.NE.'MAILLAGE')THEN 685 : C write(6,*)' On a pas trouve M1BULLE On le calcule ' 685 : CALL ACMO(MTABLE,'MAILLAGE',TYPI,MELEME) 685 : CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMC) 685 : CALL GENMCT(MELEME,MELEMC,IPOINT) 685 : CALL ECMO(MTABLE,'M1BULLE','MAILLAGE',IPOINT) 685 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT) 686 : ENDIF 687 : RETURN 688 : C 689 : C- DOMAINE.'CENTREP0' 690 : C 691 : 420 CONTINUE 692 : TYPE = ' ' 692 : CALL ACMO(MTABLE,'CENTREP0',TYPE,IPOINT) 693 : IF (TYPE.NE.'MAILLAGE') THEN 693 : CALL KCTRP0(MTABLE,IPOINT) 694 : ENDIF 694 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT) 695 : RETURN 696 : C 697 : C- DOMAINE.'ELTP1NC ' 698 : C 699 : 430 CONTINUE 700 : IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000 701 : TYPE=' ' 701 : CALL ACMO(MTABLE,'ELTP1NC ',TYPE,IPOINT) 702 : IF (TYPE.NE.'MAILLAGE') THEN 702 : CALL KCTRP1(MTABLE,IPOINT,2) 703 : ENDIF 703 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT) 704 : RETURN 705 : C 706 : C- DOMAINE.'CENTREP1' 707 : C 708 : 440 CONTINUE 709 : IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000 710 : TYPE=' ' 710 : CALL ACMO(MTABLE,'CENTREP1',TYPE,IPOINT) 711 : IF (TYPE.NE.'MAILLAGE') THEN 711 : CALL KCTRP1(MTABLE,IPOINT,1) 712 : ENDIF 712 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT) 713 : RETURN 714 : C 715 : C-*DOMAINE.'VOLUMAC ' 716 : C 717 : 450 CONTINUE 718 : TYPE=' ' 718 : CALL ACMO(MTABLE,'VOLUMAC ',TYPE,IPOINT) 719 : IF(IPOINT.NE.0)RETURN 720 : 721 : TYPE=' ' 721 : CALL ACMO(MTABLE,'MACRO',TYPE,MELEME) 722 : IF(MELEME.EQ.0)THEN 723 : C Indice %m1:8 : Objet de type %m9:16 incorrect 724 : 725 : MOTERR(1:8) = 'VOLUMAC ' 726 : MOTERR(9:16) = 'NONMACRO' 726 : CALL ERREUR(787) 727 : RETURN 728 : ENDIF 729 : 730 : TYPE=' ' 730 : CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME) 731 : IF (TYPE.NE.'MAILLAGE') THEN 731 : CALL KMACRO(MACRO,MELEME,MTABLE) 732 : RETURN 733 : ENDIF 734 : TYPE = ' ' 734 : CALL ACMO(MTABLE,'CENTREP0',TYPE,MELEMQ) 735 : IF (TYPE.NE.'MAILLAGE') THEN 735 : CALL KCTRP0(MTABLE,MELEMQ) 736 : RETURN 737 : ENDIF 738 : 738 : CALL KVOL(MELEME,MELEMQ,'CENTREP0',IPOINT) 738 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'VOLUMAC ','CHPOINT ',IPOINT) 738 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',IPOINT) 739 : RETURN 740 : 741 : C 742 : C- DOMAINE.'MACRO ' 743 : C 744 : 460 CONTINUE 745 : TYPE=' ' 745 : CALL ACMO(MTABLE,'MACRO',TYPE,MELEME) 746 : IPOINT = MELEME 746 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME) 747 : RETURN 748 : C 749 : C- DOMAINE.'QUADRATI' 750 : C 751 : 470 CONTINUE 752 : TYPE=' ' 752 : CALL ACMO(MTABLE,'QUADRATI',TYPE,MELEME) 753 : IPOINT = MELEME 753 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME) 754 : RETURN 755 : C 756 : C- DOMAINE.'MACRO1' 757 : C 758 : 480 CONTINUE 759 : TYPE=' ' 759 : CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME) 760 : IF (TYPE.NE.'MAILLAGE') THEN 761 : TYPE=' ' 761 : CALL ACMO(MTABLE,'MACRO',TYPE,MACRO) 762 : IF(TYPE.NE.'MAILLAGE')THEN 763 : TYPE=' ' 763 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,IPOINT) 764 : RETURN 765 : ELSE 765 : CALL KMACRO(MACRO,IPOINT,MTABLE) 766 : RETURN 767 : ENDIF 768 : ENDIF 769 : 770 : IPOINT = MELEME 770 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME) 771 : RETURN 772 : C 773 : C-*????.'XXDXDY' : En chantier 774 : C 775 : 490 CONTINUE 776 : TYPE = ' ' 776 : CALL ACMO(MTABLE,'XXDXDY',TYPE,MCHPOI) 777 : C write(6,*)' ACMO XXDXDY : MTABLE=',MTABLE 778 : IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN 779 : C write(6,*)' On a pas trouve XXDXDY On le calcule ' 779 : CALL ECROBJ('TABLE ',MTABLE) 780 : C write(6,*)' ECROBJ XXDXDY : MTABLE=',MTABLE 780 : CALL KDXDY 781 : TYPE = 'CHPOINT ' 781 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 782 : IF (IRET.EQ.0) GOTO 5000 782 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDXDY','CHPOINT ',MCHPOI) 783 : ENDIF 784 : IPOINT = MCHPOI 784 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 785 : C write(6,*)' retour XXDXDY : MTABLE=',MTABLE 786 : RETURN 787 : C 788 : C- DOMAINE.'MSOMMET' 789 : C 790 : 500 CONTINUE 790 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 791 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 792 : TYPE=' ' 792 : CALL ACMO(MTABLE,'MSOMMET ',TYPE,MMLEMS) 793 : IF(TYPE.NE.'MAILLAGE')THEN 794 : I501 = 1 795 : GO TO 1300 796 : ENDIF 797 : 501 CONTINUE 798 : IPOINT = MMLEMS 798 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MMLEMS) 799 : RETURN 800 : C 801 : C- DOMAINE.'MMAIL ' 802 : C 803 : 510 CONTINUE 803 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 804 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 805 : TYPE=' ' 805 : CALL ACMO(MTABLE,'MMAIL ',TYPE,MMELEM) 806 : IF(TYPE.NE.'MAILLAGE')THEN 807 : I511 = 1 808 : GOTO 1300 809 : ENDIF 810 : 511 CONTINUE 811 : IPOINT = MMELEM 811 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MMELEM) 812 : RETURN 813 : C 814 : C- DOMAINE.'MLGVNIMP' 815 : C 816 : 520 CONTINUE 816 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 817 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 818 : TYPE=' ' 818 : CALL ACMO(MTABLE,'MLGVNIMP',TYPE,MELETI) 819 : 820 : IF(TYPE.EQ.'MAILLAGE')THEN 821 : IPOINT = MELETI 821 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI) 822 : RETURN 823 : ELSE 824 : TYPE=' ' 824 : CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME) 825 : IF (TYPE.NE.'MAILLAGE') GO TO 5000 825 : CALL MEULTI(MELEME,MELETI,TYPE) 826 : IF (TYPE.NE.'MAILLAGE') THEN 827 : C Indice %m1:8 : Objet de type %m9:16 incorrect 828 : 829 : MOTERR(1:8) = NOM 830 : MOTERR(9:16) = TYPE 830 : CALL ERREUR(787) 831 : RETURN 832 : ENDIF 832 : CALL ECMO(MTABLE,'MLGVNIMP','MAILLAGE',MELETI) 833 : IPOINT = MELETI 833 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI) 834 : RETURN 835 : ENDIF 836 : C 837 : C- DOMAINE.'MLGVTIMP' 838 : C 839 : 530 CONTINUE 839 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 840 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 841 : TYPE=' ' 841 : CALL ACMO(MTABLE,'MLGVTIMP',TYPE,MELETI) 842 : 843 : IF(TYPE.EQ.'MAILLAGE')THEN 844 : IPOINT = MELETI 844 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI) 845 : RETURN 846 : ELSE 847 : TYPE=' ' 847 : CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME) 848 : IF (TYPE.NE.'MAILLAGE') GO TO 5000 848 : CALL MEULTI(MELEME,MELETI,TYPE) 849 : IF (TYPE.NE.'MAILLAGE') THEN 850 : C Indice %m1:8 : Objet de type %m9:16 incorrect 851 : 852 : MOTERR(1:8) = NOM 853 : MOTERR(9:16) = TYPE 853 : CALL ERREUR(787) 854 : RETURN 855 : ENDIF 855 : CALL ECMO(MTABLE,'MLGVTIMP','MAILLAGE',MELETI) 856 : IPOINT = MELETI 856 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI) 857 : RETURN 858 : ENDIF 859 : C 860 : C- DOMAINE.'ENVELOPP' 861 : C 862 : 540 CONTINUE 862 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 863 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 864 : TYPE=' ' 864 : CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL) 865 : 866 : IF(TYPE.EQ.'MAILLAGE')THEN 867 : IPOINT = MENVEL 867 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MENVEL) 868 : RETURN 869 : ELSE 870 : TYPE = ' ' 870 : C CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP) 870 : CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2) 871 : IF (TYPE.NE.'MAILLAGE') THEN 872 : I541 = 1 873 : GOTO 1100 874 : ENDIF 875 : ENDIF 876 : 541 CONTINUE 877 : TYPE = ' ' 877 : CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ) 878 : 542 CONTINUE 878 : CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET) 879 : IF (IRET.EQ.0) GOTO 5000 879 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL) 879 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI) 880 : IPOINT = MENVEL 881 : IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP') 881 : & CALL ECROBJ('MAILLAGE',MENVEL) 882 : RETURN 883 : C 884 : C- DOMAINE.'FACEL2' : MELEME connectivite face -> centre (partitionne) 885 : C rgt partitionne 886 : 550 CONTINUE 886 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 887 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 888 : TYPE = ' ' 888 : CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2) 889 : IF (TYPE.NE.'MAILLAGE') THEN 890 : I551 = 1 891 : GOTO 1100 892 : ENDIF 893 : 551 CONTINUE 894 : IPOINT = MELEF2 894 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEF2) 895 : RETURN 896 : C 897 : C- DOMAINE.'QUAF ' : Maillage QUAF du domaine considéré 898 : C 899 : 560 CONTINUE 899 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 900 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 901 : TYPE=' ' 901 : CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME) 902 : IF (TYPE.NE.'MAILLAGE') THEN 903 : C Indice %m1:8 : Objet de type %m9:16 incorrect 904 : 905 : MOTERR(1:8) = NOM 906 : MOTERR(9:16) = TYPE 906 : CALL ERREUR(787) 907 : RETURN 908 : ENDIF 909 : IPOINT = MELEME 909 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME) 910 : RETURN 911 : C 912 : C- DOMAINE.'XXCTREP1' 913 : C 914 : 570 CONTINUE 915 : TYPE = ' ' 915 : CALL ACMO(MTABLE,'XXCTREP1',TYPE,MCHPOI) 916 : IF (TYPE.NE.'CHPOINT ') THEN 916 : CALL ECRCHA('CENTREP1') 916 : CALL ECROBJ('TABLE ',MTABLE) 916 : CALL CADGSI 917 : TYPE = 'CHPOINT ' 917 : CALL LIROBJ(TYPE,MCHPOI,1,IRET) 918 : IF (IRET.EQ.0) GOTO 5000 918 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP1','CHPOINT ',MCHPOI) 919 : ENDIF 920 : IPOINT = MCHPOI 920 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 921 : C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE 922 : RETURN 923 : C 924 : C- DOMAINE.'XXCTREP0' 925 : C 926 : 580 CONTINUE 927 : TYPE = ' ' 927 : CALL ACMO(MTABLE,'XXCTREP0',TYPE,MCHPOI) 928 : IF (TYPE.NE.'CHPOINT ') THEN 929 : TYPE = ' ' 929 : CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI) 930 : IF (TYPE.NE.'CHPOINT ') THEN 931 : write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule' 932 : TYPE=' ' 932 : CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC) 932 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME) 932 : CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI) 932 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP0','CHPOINT ',MCHPOI) 932 : IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI) 933 : ENDIF 934 : ENDIF 935 : IPOINT = MCHPOI 935 : IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI) 936 : RETURN 937 : C 938 : C- DOMAINE.'MAILFACE' : MELEME des elements face 939 : C 940 : 590 CONTINUE 940 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 941 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 942 : TYPE = ' ' 942 : CALL ACMO(MTABLE,'MAILFACE',TYPE,MFF2) 943 : IF (TYPE.NE.'MAILLAGE') THEN 944 : I591 = 1 945 : GOTO 1100 946 : ENDIF 947 : 591 CONTINUE 948 : IPOINT = MFF2 948 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MFF2) 949 : RETURN 950 : C 951 : C- DOMAINE.'ARETE ' : MELEME des éléments arêtes 952 : C 953 : 600 CONTINUE 953 : CALL ACMM(MTABLE,'SOUSTYPE',TYPE) 954 : IF (TYPE.NE.'DOMAINE ') GOTO 5010 955 : TYPE = ' ' 955 : CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME) 956 : IF (TYPE.NE.'MAILLAGE') THEN 957 : C Indice %m1:8 : Objet de type %m9:16 incorrect 958 : 959 : MOTERR(1:8) = NOM 960 : MOTERR(9:16) = TYPE 960 : CALL ERREUR(787) 961 : RETURN 962 : ENDIF 963 : TYPE = ' ' 963 : CALL ACMO(MTABLE,'ARETE ',TYPE,MARET) 964 : IF (TYPE.NE.'MAILLAGE') THEN 964 : CALL ECROBJ('MAILLAGE',MELEME) 964 : CALL CHANLG 964 : CALL LIROBJ('MAILLAGE',MARET,1,IRETOU) 965 : IF (IRETOU.NE.1) THEN 966 : C Indice %m1:8 : Objet de type %m9:16 incorrect 967 : 968 : MOTERR(1:8) = 'ARETE' 969 : MOTERR(9:16) = 'MAILLAGE' 969 : CALL ERREUR(787) 970 : RETURN 971 : ENDIF 972 : ENDIF 973 : IPOINT = MARET 973 : IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MARET) 974 : RETURN 975 : C 976 : C- Emplacement libre 977 : C 978 : 610 CONTINUE 979 : IPOINT = 0 980 : RETURN 981 : C 982 : C 983 : C--------------------------------------------------------- 984 : C Traitement commun à plusieures options et mise en facteur 985 : C--------------------------------------------------------- 986 : C 987 : C 988 : C- Recherche à l'indice mot MIND d'une table de sous-type MINDS 989 : C- ATTENTION : ERREUR NON GERE POUR L'INSTANT : Si IPTR.EQ.0 5000 990 : C 991 : 1000 CONTINUE 992 : TYPE = ' ' 992 : CALL ACMO(MTABLE,MIND,TYPE,IPTR) 993 : IF (TYPE.EQ.'TABLE ') THEN 994 : TYPE = ' ' 994 : CALL ACMM(IPTR,'SOUSTYPE',TYPE) 995 : IF (TYPE.EQ.MINDS) THEN 996 : IPOINT = IPTR 997 : ENDIF 998 : ELSE IF(TYPE.EQ.'MMODEL')THEN 998 : CALL LEKMOD(IPTR,IPOINT,INEFMD) 999 : IF(IPOINT.EQ.0)RETURN 1000 : ENDIF 1001 : RETURN 1002 : C 1003 : C- Construction des indices 'FACE', 'FACEP', 'FACEL', 'CENTRE', 'ELTFA', 'FACEL2' 1004 : C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options 1005 : C 1006 : 1100 CONTINUE 1007 : TYPE = ' ' 1007 : CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME) 1008 : IF (TYPE.NE.'MAILLAGE') GOTO 5000 1009 : 1010 : NOMC=' ' 1010 : CALL TQ2CF(MELEME,MELEMQ,MELEMK, 1011 : & MELEF1,MELAF,MELEMP,MELEMF,MELEF2,MFF2,NOMC,IKR) 1012 : IF(IKR.EQ.1)IQUAD=1 1013 : 1014 : IF(IQUAD.EQ.1)THEN 1014 : CALL ECMO(MTABLE,'QUADRATIQUE','MAILLAGE',MELEME) 1014 : CALL ECMO(MTABLE,'MAILLAGE','MAILLAGE',MELEMQ) 1015 : ENDIF 1016 : 1016 : CALL ECMO(MTABLE,'FACE','MAILLAGE',MELEF1) 1016 : CALL ECMO(MTABLE,'FACEL','MAILLAGE',MELEMF) 1016 : CALL ECMO(MTABLE,'FACEL2','MAILLAGE',MELEF2) 1016 : CALL ECMO(MTABLE,'FACEP','MAILLAGE',MELEMP) 1016 : CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMK) 1016 : CALL ECMO(MTABLE,'ELTFA','MAILLAGE',MELAF) 1016 : CALL ECMO(MTABLE,'MAILFACE','MAILLAGE',MFF2) 1017 : 1018 : IF (I211 .EQ.1) GOTO 211 1019 : IF (I221 .EQ.1) GOTO 221 1020 : IF (I231 .EQ.1) GOTO 231 1021 : IF (I271 .EQ.1) GOTO 271 1022 : IF (I291 .EQ.1) GOTO 291 1023 : IF (I391 .EQ.1) GOTO 391 1024 : IF (I541 .EQ.1) GOTO 541 1025 : IF (I551 .EQ.1) GOTO 551 1026 : IF (I1201.EQ.1) GOTO 1201 1027 : IF (I591 .EQ.1) GOTO 591 1028 : C 1029 : C- Construction des indices 'XXNORMAE', 'XXSURFAC' et 'XXNORMAF' 1030 : C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options 1031 : C 1032 : 1200 CONTINUE 1033 : TYPE = ' ' 1033 : CALL ACMO(MTABLE,'FACE',TYPE,MELEME) 1034 : IF (TYPE.NE.'MAILLAGE') THEN 1035 : I1201 = 1 1036 : GOTO 1100 1037 : ENDIF 1038 : 1201 CONTINUE 1038 : CALL KNRF(MTABLE,ICHE,ICHPV,ICHP) 1039 : IF(ISTOK.EQ.1)THEN 1039 : CALL ECMO(MTABLE,'XXNORMAE','MCHAML ',ICHE) 1039 : CALL ECMO(MTABLE,'XXSURFAC','CHPOINT ',ICHP) 1039 : CALL ECMO(MTABLE,'XXNORMAF','CHPOINT ',ICHPV) 1040 : ENDIF 1041 : 1042 : IF (I241.EQ.1) GOTO 241 1043 : IF (I251.EQ.1) GOTO 251 1044 : IF (I301.EQ.1) GOTO 301 1045 : IF (I542.EQ.1) GOTO 542 1046 : C 1047 : C Construction des indices 'MSOMMET' et 'MMAIL' d'une table 1048 : C de sous-types 'DOMAINE'. 1049 : C A l'indice 'MSOMMET', on trouve le maillage des "vrais" 1050 : C sommets (les sommets géométriques des éléments), par 1051 : C opposition à l'indice 'SOMMET' qui est le spg des inconnues 1052 : C définies dans l'espace L2. 1053 : C A l'indice 'MMAIL' qui lui correspond, on trouve le maillage 1054 : C des "vrais" éléments (les éléments géométriques : 1055 : C ils ont le type le plus simple pour un forme 1056 : C géométrique donnée (ex. TRI3, PYR5, CUB8...)) 1057 : C par opposition à l'indice 'MAILLAGE' qui contient 1058 : C éventuellement des éléments avec plus de points qui sont les 1059 : C spg des différentes inconnues. 1060 : C spg=support géométrique. 1061 : C 1062 : 1300 CONTINUE 1063 : TYPE=' ' 1063 : CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME) 1064 : IF (TYPE.NE.'MAILLAGE') GO TO 5000 1064 : CALL MSOMET(MELEME,MMELEM,MMLEMS,TYPE) 1065 : IF (TYPE.NE.'MAILLAGE') THEN 1066 : C Indice %m1:8 : Objet de type %m9:16 incorrect 1067 : 1068 : MOTERR(1:8) = NOM 1069 : MOTERR(9:16) = TYPE 1069 : CALL ERREUR(787) 1070 : RETURN 1071 : ENDIF 1071 : CALL ECMO(MTABLE,'MMAIL ','MAILLAGE',MMELEM) 1071 : CALL ECMO(MTABLE,'MSOMMET ','MAILLAGE',MMLEMS) 1072 : 1073 : IF (I331.EQ.1) GOTO 331 1074 : IF (I341.EQ.1) GOTO 341 1075 : IF (I371.EQ.1) GOTO 370 1076 : IF (I501.EQ.1) GOTO 501 1077 : IF (I511.EQ.1) GOTO 511 1078 : C 1079 : C---------------------------------------- 1080 : C Erreur détectée : traitement impossible 1081 : C---------------------------------------- 1082 : C 1083 : 5000 CONTINUE 1084 : C Indice %m1:8 : Problème de données détecté dans lektab 1085 : 1086 : IPOINT = 0 1087 : MOTERR(1:8) = NOM 1087 : CALL ERREUR(792) 1088 : RETURN 1089 : 5010 CONTINUE 1090 : C Indice %m1:8 : La table n'est pas de sous-type %m9:16 1091 : 1092 : IPOINT = 0 1093 : MOTERR(1:8) = NOM 1094 : MOTERR(9:16) = 'DOMAINE ' 1094 : CALL ERREUR(790) 1095 : RETURN 1096 : C 1097 : END 1098 : 1099 : 1100 : 1101 : 1102 : 1103 : 1104 : 1105 : 1106 : 1107 : 1108 : 1109 : 1110 : 1111 : 1112 : 1113 : 1114 : 1115 : 1116 : 1117 : 1118 : 1119 : 1120 : 1121 : 1122 : 1123 : 1124 : 1125 : 1126 : 1127 : 1128 : 1129 :
© Cast3M 2003 - All rights reserved.
Disclaimer