1 : C EXTRAI SOURCE GOUNAND 14/01/29 21:15:04 7923 2 : SUBROUTINE EXTRAI 3 : 4 : C======================================================================= 5 : C 6 : C ELEM = EXTRAIRE OBJET RANG ; 7 : C 8 : C 9 : C OBJET TYPE1 OBJET DONT ON EXTRAIT UN ELEMENT. 10 : C RANG TYPE2 INDICE DE POSITION DE L'ELEMENT A EXTRAIRE 11 : C DE L'OBJET "OBJET". 12 : C ELEM TYPE3 OBJET EXTRAIT DE "OBJET". 13 : C 14 : C 15 : C AUTEUR, DATE DE CREATION: 16 : C ------------------------- 17 : C 18 : C PASCAL MANIGOT 5 DECEMBRE 1984 19 : C 20 : C MODIFIE SEPTEMBRE 94 21 : C======================================================================= 22 : 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : 26 : -INC CCOPTIO 27 : -INC CCGEOME 28 : -INC CCHAMP 29 : 30 : -INC SMSUPER 31 : -INC SMRIGID 32 : -INC SMELEME 33 : -INC SMCHPOI 34 : -INC SMBASEM 35 : -INC SMTABLE 36 : -INC SMDEFOR 37 : -INC SMMODEL 38 : -INC SMEVOLL 39 : -INC SMLREEL 40 : -INC SMLENTI 41 : -INC SMLMOTS 42 : -INC SMLCHPO 43 : -INC SMNUAGE 44 : 45 : SEGMENT LIMODE(0) 46 : 47 : PARAMETER (NBFORM=100 , NBCHGT=8) 48 : CHARACTER*4 CAMPL(1), MOOPT(7), NOMU(3), LMOSU(5), MOTBAS(5), 49 : & NUMO(5), MCHGT(NBCHGT), CMOC(20) 50 : CHARACTER*16 MOFORM(NBFORM) 51 : CHARACTER*4 MOT_4,CMOT,MOT1,MOT2 52 : CHARACTER*8 MOT_8,CTYP,CTYP1 53 : CHARACTER*512 CTEXTL 54 : CHARACTER*72 CTEXT 55 : logical ltelq, LAG,BORNINF,MINI 56 : C 57 : DATA LMOSU /'RIGI','ELEM','RIGT','MASS','BLOQ'/ 58 : DATA NOMU /'NOMU','MULT','UNIL'/ 59 : DATA MOOPT /'MAIL','RIGI','SYME','ANTI','CONT','COMP','DIAG'/ 60 : DATA MOTBAS/'RIGI','MASS','MODE','STAT','PSMO'/ 61 : DATA CAMPL /'AMPL'/ 62 : DATA NUMO /'INFE','SUPE','MINI','MAXI','ENTR'/ 63 : DATA CMOC /'MAIL','ZONE','FORM','CONS','ELEM','GEOM','CONT', 64 : $ 'DEFO','DEPL','FORC','GRAD','GRAF','MATE','CONP', 65 : $ 'TEMP','VARI','PARA','DEIN','COMP','OBJE'/ 66 : DATA MCHGT /'CHAR','CHAM','TRAJ','EVOL','VITE','COMP', 67 : & 'LIE ','LIBR' / 68 : C 68 : CALL QUETYP(CTYP,0,IRETOU) 69 : IF (IRETOU.EQ.0) THEN 69 : CALL ERREUR(533) 70 : RETURN 71 : ENDIF 72 : C 73 : IF(CTYP.EQ.'MOT ') THEN 73 : call lircha(CTEXTL,1,LONMOT) 74 : if(ierr.ne.0) return 75 : 76 : ***** JCARDO 13/03/2012 : extraction d'une sous-chaîne 76 : CALL QUETYP(CTYP1,0,IRETOU) 77 : IF (IRETOU.NE.0) THEN 78 : IF (CTYP1.EQ.'ENTIER'.OR.CTYP1.EQ.'LISTENTI') THEN 78 : CALL SOUCHA(CTEXTL,LONMOT,CTYP1) 79 : RETURN 80 : ENDIF 81 : ENDIF 82 : MOT_8=CTEXTL(1:8) 83 : ***** 84 : 84 : call repert(MOT_8,ia) 85 : m=ia 86 : segini mtable 87 : mlotab=0 88 : do 7765 i=1,ia 89 : if(MOT_8.eq.'FLOTTANT' ) then 89 : call lirree(xval,1,iretou) 90 : elseif(MOT_8.eq.'LOGIQUE ') then 90 : call lirlog(lag,1,iretou) 91 : elseif (MOT_8.eq.'ENTIER ') then 91 : call lirent(ival,1,iretou) 92 : elseif(MOT_8.eq.'MOT ') then 92 : call lircha(CTEXT,1,iretou) 93 : else 93 : call lirobj(MOT_8,ival,1,iretou) 94 : endif 94 : call ecctab(mtable,'ENTIER ',i,xval1,MOT_4,mini,ilo, 95 : $ MOT_8,ival,xval,CTEXT(1:iretou),lag,ival) 96 : 7765 continue 97 : segdes mtable 97 : call ecrobj('TABLE ',mtable) 98 : return 99 : C 100 : ELSE IF (CTYP.EQ.'DEFORME ') THEN 100 : CALL LIROBJ('DEFORME ',MDEFOR,1,IRETOU) 101 : IF(IERR.NE.0) RETURN 101 : CALL LIRMOT(CAMPL,1,IRET,1) 102 : IF(IERR.NE.0) RETURN 103 : SEGACT MDEFOR 104 : IF (AMPL(/1).NE.1) THEN 104 : CALL ERREUR(475) 105 : ELSE 106 : AMP=AMPL(1) 106 : CALL ECRREE(AMP) 107 : ENDIF 108 : SEGDES MDEFOR 109 : RETURN 110 : C 111 : ELSE IF (CTYP.EQ.'BASEMODA') THEN 111 : CALL LIROBJ('BASEMODA',IPBASE,1,IRETOU) 112 : IF(IERR.NE.0) RETURN 112 : CALL LIRMOT(MOTBAS,5,IRET,1) 113 : IF(IERR.NE.0) RETURN 114 : MOT_4=MOTBAS(IRET) 114 : CALL EXTRA7(IPBASE,MOT_4,IPTR) 115 : IF(IERR.NE.0) RETURN 116 : IF (IRET.LE.2) THEN 116 : CALL ECROBJ('RIGIDITE',IPTR) 117 : ELSE 117 : CALL ECROBJ('SOLUTION',IPTR) 118 : ENDIF 119 : RETURN 120 : C 121 : ELSE IF (CTYP.EQ.'EVOLUTIO') THEN 121 : CALL LIROBJ('EVOLUTIO',IBOLL,1,IRETOU) 122 : IF(IERR.NE.0) RETURN 122 : CALL EXTRA6 (IBOLL) 123 : RETURN 124 : C 125 : ENDIF 126 : C 127 : C CAS D'UN OBJET SUPER ELEMENT 128 : C 128 : CALL LIROBJ ('SUPERELE',MSUPER,0,IRETOU) 129 : IF (IERR.NE.0) RETURN 130 : IF (IRETOU.EQ.0) GO TO 113 130 : CALL LIRMOT(LMOSU,5,IRET,1) 131 : IF (IERR.NE.0) RETURN 132 : SEGACT MSUPER 133 : IF (IRET.EQ.1) THEN 134 : IPTR=MSURAI 134 : CALL ECROBJ('RIGIDITE',IPTR) 135 : ELSEIF (IRET.EQ.2) THEN 136 : IPTR=MSUPEL 136 : CALL ECROBJ('MAILLAGE',IPTR) 137 : ELSEIF (IRET.EQ.3) THEN 138 : IPTR=MRIGTO 138 : CALL ECROBJ('RIGIDITE',IPTR) 139 : ELSEIF (IRET.EQ.4) THEN 140 : IPTR=MSUMAS 140 : CALL ECROBJ('RIGIDITE',IPTR) 141 : ELSEIF (IRET.EQ.5) THEN 142 : * 143 : * EXTRAI DE MSUPER LES BLOQUAGES DU SUPERELEMENT 144 : * 145 : NRIGEL=MBLOQU 146 : RI1=MRIGTO 147 : SEGACT,RI1 148 : SEGINI,MRIGID 149 : MTYMAT=RI1.MTYMAT 150 : DO 1 IE1=1,NRIGEL 151 : COERIG(IE1)=RI1.COERIG(IE1) 152 : DO 11 IE2=1,8 153 : IRIGEL(IE2,IE1)=RI1.IRIGEL(IE2,IE1) 154 : 11 CONTINUE 155 : 1 CONTINUE 156 : SEGDES,RI1,MRIGID 156 : CALL ECROBJ('RIGIDITE',MRIGID) 157 : ENDIF 158 : SEGDES MSUPER 159 : RETURN 160 : C 161 : C CAS D'UN OBJET MATRIK 162 : C 163 : 113 CONTINUE 163 : CALL LIROBJ ('MATRIK',IBOGID,0,IRETOU) 164 : IF(IRETOU.EQ.0) GO TO 1132 164 : CALL LIRMOT(MOOPT,7,IRET,0) 165 : IF (IRET.EQ.0) THEN 165 : CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETLM) 166 : IF (IRETLM.EQ.1) THEN 166 : CALL LIROBJ('LISTMOTS',MLMOT2,1,IRET) 167 : IF (IERR.NE.0) RETURN 168 : ELSE 168 : CALL LIRCHA(MOT1,1,IRET) 169 : IF (IERR.NE.0) RETURN 169 : CALL LIRCHA(MOT2,1,IRET) 170 : IF (IERR.NE.0) RETURN 171 : JGN=4 172 : JGM=1 173 : SEGINI MLMOT1,MLMOT2 174 : MLMOT1.MOTS(1)=MOT1 175 : MLMOT2.MOTS(1)=MOT2 176 : ENDIF 176 : CALL EXINCK(IBOGID,MLMOT1,MLMOT2,IOUT,IMPR,IRET) 177 : IF (IRETLM.NE.1) SEGSUP MLMOT1,MLMOT2 178 : IF (IERR.NE.0) RETURN 178 : CALL ECROBJ('MATRIK',IOUT) 179 : RETURN 180 : ELSEIF (IRET.EQ.7) THEN 180 : CALL ECROBJ('MATRIK',IBOGID) 180 : CALL EXDIAG(1) 181 : RETURN 182 : ELSEIF(IRET.EQ.6) THEN 182 : CALL LIRCHA(CMOT,0,ICDUAL) 183 : IF (ICDUAL.NE.0) THEN 184 : IF (CMOT.NE.'DUAL') THEN 185 : MOTERR(1:4)=CMOT 185 : CALL ERREUR(7) 186 : RETURN 187 : ENDIF 188 : ENDIF 188 : CALL EXTR26(IBOGID,ICDUAL,IPLSTM) 188 : CALL ECROBJ('LISTMOTS',IPLSTM) 189 : RETURN 190 : ELSE 191 : MOTERR(1:4)=MOOPT(IRET) 191 : CALL ERREUR(7) 192 : RETURN 193 : ENDIF 194 : C 195 : C CAS D'UN OBJET RIGIDITE 196 : C 197 : 1132 CONTINUE 197 : CALL LIROBJ ('RIGIDITE',IBOGID,0,IRETOU) 198 : IF(IRETOU.EQ.0) GO TO 114 198 : CALL LIRMOT(MOOPT,7,IRET,0) 199 : IF (IRET.EQ.0) THEN 199 : CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETLM) 200 : IF (IRETLM.EQ.1) THEN 200 : CALL LIROBJ('LISTMOTS',MLMOT2,1,IRET) 201 : IF (IERR.NE.0) RETURN 202 : ELSE 202 : CALL LIRCHA(MOT1,1,IRET) 203 : IF (IERR.NE.0) RETURN 203 : CALL LIRCHA(MOT2,1,IRET) 204 : IF (IERR.NE.0) RETURN 205 : JGN=4 206 : JGM=1 207 : SEGINI MLMOT1,MLMOT2 208 : MLMOT1.MOTS(1)=MOT1 209 : MLMOT2.MOTS(1)=MOT2 210 : ENDIF 210 : CALL EXINCR(IBOGID,MLMOT1,MLMOT2,IOUT) 211 : IF (IRETLM.NE.1) SEGSUP MLMOT1,MLMOT2 212 : IF (IERR.NE.0) RETURN 212 : CALL ECROBJ('RIGIDITE',IOUT) 213 : RETURN 214 : ELSEIF (IRET.EQ.7) THEN 214 : CALL EXDIAR(IBOGID,ICHP) 215 : IF (IERR.NE.0) RETURN 215 : CALL ECROBJ('CHPOINT ',ICHP) 216 : RETURN 217 : ELSEIF(IRET.EQ.6) THEN 217 : CALL LIRCHA(CMOT,0,ICDUAL) 218 : IF (ICDUAL.NE.0) THEN 219 : IF (CMOT.NE.'DUAL') THEN 220 : MOTERR(1:4)=CMOT 220 : CALL ERREUR(7) 221 : RETURN 222 : ENDIF 223 : ENDIF 223 : CALL EXTR16(IBOGID,ICDUAL,IPLSTM) 223 : CALL ECROBJ('LISTMOTS',IPLSTM) 224 : RETURN 225 : ELSE IF(IRET.EQ.5) THEN 226 : MRIGID=IBOGID 227 : SEGACT MRIGID 228 : ISOPE= ISUPEQ 228 : IF(ISUPEQ.EQ.0) CALL CRTABL(ISOPE) 229 : MTABLE=ISOPE 230 : SEGDES MTABLE 230 : CALL ECROBJ('TABLE ',ISOPE) 231 : RETURN 232 : ELSE IF (IRET.EQ.3 .OR. IRET.EQ.4) THEN 232 : CALL EXTR13(IBOGID,IRET) 233 : RETURN 234 : ENDIF 235 : ICO=0 236 : IMO=3 237 : IF(IRET.EQ.2) THEN 238 : ICO=1 239 : IMO=2 240 : ENDIF 240 : CALL LIRMOT(NOMU,IMO,IMUL,ICO) 241 : IF(IERR.NE.0) RETURN 242 : IF(IRET.EQ.2) THEN 242 : CALL SEPA(IBOGID,IMUL) 242 : CALL ECROBJ('RIGIDITE',IBOGID) 243 : RETURN 244 : ENDIF 245 : IF(IMUL.NE.0) THEN 245 : CALL POIRIG(IBOGID,IMUL) 246 : RETURN 247 : ENDIF 248 : IF(IERR.NE.0) RETURN 249 : MRIGID=IBOGID 250 : SEGACT MRIGID 251 : NBSOUS=IRIGEL(/2) 252 : IF(NBSOUS.EQ.0) THEN 253 : NBNN=0 254 : NBELEM=0 255 : NBREF=0 256 : SEGINI MELEME 257 : SEGDES MELEME,MRIGID 257 : CALL ECROBJ ('MAILLAGE',MELEME) 258 : RETURN 259 : ENDIF 260 : IPP1 = IRIGEL(1,1) 261 : IF(NBSOUS.GT.1) THEN 262 : nbref=0 263 : nbnn=0 264 : nbelem=0 265 : segini ipt4 266 : kt4 = 1 267 : ipt4.lisous(kt4) = ipp1 268 : DO 1130 I=1,NBSOUS 269 : do 1129 jj = 1,kt4 270 : if (irigel(1,i).eq.ipt4.lisous(jj)) goto 1130 271 : 1129 continue 272 : kt4 = kt4 + 1 273 : IPT4.lisous(kt4)=IRIGEL(1,I) 274 : 1130 CONTINUE 275 : nbsous = kt4 276 : segadj ipt4 276 : CALL FUSEBO (IPT4,IPP1) 277 : ENDIF 278 : SEGDES MRIGID 278 : CALL ECROBJ('MAILLAGE',IPP1) 279 : RETURN 280 : C 281 : C CAS DU CHPOINT 282 : C 283 : 114 CONTINUE 283 : CALL LIROBJ ('CHPOINT ',IBOPOI,0,IRETOU) 284 : IF(IRETOU.EQ.0) GO TO 115 284 : CALL LIRCHA(CMOT,0,IRETOU) 285 : IF (IRETOU.NE.0) THEN 286 : C 287 : C Extraction du TITRe du CHPOINT 288 : IF (CMOT.EQ.'TITR') THEN 289 : MCHPOI = IBOPOI 290 : SEGACT MCHPOI 291 : CTEXT = MOCHDE 292 : SEGDES MCHPOI 293 : ILON = LEN(CTEXT) 294 : DO 100 I = ILON,1,-1 295 : IF (CTEXT(I:I).NE.' ') THEN 296 : NLON = I 297 : GOTO 102 298 : ENDIF 299 : 100 CONTINUE 300 : NLON = 1 301 : 102 CONTINUE 301 : CALL ECRCHA(CTEXT(1:NLON)) 302 : RETURN 303 : C 304 : C Extraction de la NATUre du CHPOINT 305 : ELSE IF (CMOT.EQ.'NATU') THEN 306 : MCHPOI = IBOPOI 307 : SEGACT MCHPOI 308 : INAT = JATTRI(1) 309 : IF (INAT.EQ.0) CTEXT(1:11) = 'INDETERMINE' 310 : IF (INAT.EQ.1) CTEXT(1:11) = 'DIFFUS ' 311 : IF (INAT.EQ.2) CTEXT(1:11) = 'DISCRET ' 312 : SEGDES MCHPOI 312 : CALL ECRCHA(CTEXT(1:11)) 313 : RETURN 314 : C 315 : C Extraction du MAILlage POI1 du CHPOINT 316 : ELSE IF (CMOT .EQ.'MAIL') THEN 317 : IMUL=0 317 : CALL LIRMOT(NOMU,1,IMUL,0) 318 : MCHPOI=IBOPOI 319 : SEGACT MCHPOI 320 : NBSOUS=IPCHP(/1) 321 : IPP1=0 322 : DO 1140 I=1,NBSOUS 323 : MSOUPO=IPCHP(I) 324 : SEGACT MSOUPO 325 : IF(NOCOMP(1).EQ.'LX '.AND.IMUL.EQ.1) GO TO 1140 326 : IF (IPP1.EQ.0) THEN 327 : IPP1= IGEOC 328 : ELSE 329 : IPP2=IGEOC 330 : ltelq=.false. 330 : CALL FUSE (IPP1,IPP2,IRET,ltelq) 331 : IPP1=IRET 332 : ENDIF 333 : SEGDES MSOUPO 334 : 1140 CONTINUE 335 : SEGDES MCHPOI 336 : IF(IPP1.EQ.0) THEN 337 : * Création Maillage vide 338 : NBELEM=0 339 : NBNN=0 340 : NBREF=0 341 : NBSOUS=0 342 : SEGINI MELEME 343 : ITYPEL = 1 344 : IPP1 = MELEME 344 : * CALL ECRENT( 0) 345 : * ELSE 346 : ENDIF 346 : CALL ECROBJ('MAILLAGE',IPP1) 347 : RETURN 348 : C 349 : C Extraction de la liste des COMPosantes du CHPOINT 350 : ELSE IF (CMOT .EQ.'COMP') THEN 350 : CALL EXTR11(IBOPOI,KLISTM) 350 : CALL ECROBJ('LISTMOTS',KLISTM) 351 : RETURN 352 : C 353 : C Extraction du TYPE du CHPOINT 354 : ELSE IF (CMOT.EQ.'TYPE') THEN 355 : MCHPOI = IBOPOI 356 : SEGACT MCHPOI 357 : MOT_8 = MTYPOI 358 : SEGDES MCHPOI 358 : CALL ECRCHA(MOT_8(1:8)) 359 : RETURN 360 : C 361 : C Extraction des VALEurs du CHPOINT (a une seule composante) 362 : ELSE IF (CMOT.EQ.'VALE') THEN 362 : CALL LIROBJ('MAILLAGE',MELEME,0,IRETOU) 362 : CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU) 363 : IF (IRETOU.EQ.0) THEN 363 : CALL LIRCHA(MOT_4,0,IRETOU) 364 : IF (IRETOU.GT.0) THEN 365 : JGN=4 366 : JGM=1 367 : SEGINI,MLMOTS 368 : MOTS(1)=MOT_4 369 : SEGDES,MLMOTS 370 : ENDIF 371 : ENDIF 372 : IF (IERR.NE.0) RETURN 372 : CALL EXTR23(IBOPOI,MLMOTS,MELEME,MLREEL) 373 : IF (IERR.NE.0) RETURN 373 : CALL ECROBJ('LISTREEL',MLREEL) 374 : RETURN 375 : ELSE 376 : C 377 : C Extraction de la valeur en un POINT d'une composante donnee du CHPOINT 377 : CALL LIROBJ('POINT ',MPOINT,1,IRETOU) 378 : IF (IRETOU.EQ.0) THEN 379 : MOTERR(1:8)='POINT' 379 : CALL ERREUR(37) 380 : RETURN 381 : ENDIF 381 : CALL EXTRA9(IBOPOI,MPOINT,CMOT,KERRE,XFLOT) 382 : IF (KERRE.EQ.0) THEN 382 : CALL ECRREE(XFLOT) 383 : RETURN 384 : ENDIF 385 : MOTERR(1:4)=CMOT 386 : MOTERR(5:12)='CHPOINT' 387 : INTERR(1)=MPOINT 387 : CALL ERREUR(65) 388 : RETURN 389 : ENDIF 390 : ENDIF 391 : * 392 : * Cas du MCHAML 393 : * 394 : 115 CONTINUE 394 : CALL LIROBJ('MCHAML',IPCHE1,0,IRET) 395 : IF(IRET.EQ.0) GOTO 116 396 : * 396 : CALL LIRCHA(CMOT,1,IRET0) 397 : IF(IERR.NE.0) RETURN 398 : * 399 : IF (CMOT.EQ.'DEVA'.OR.CMOT.EQ.'COVA') THEN 399 : CALL EXCHA1(IPCHE1,ILISR,CMOT) 399 : IF (ILISR.NE.0) CALL ECROBJ('LISTMOTS',ILISR) 400 : RETURN 401 : ELSE IF(CMOT.EQ.'NBZO') THEN 401 : CALL EXTR18(IPCHE1,NBZONE) 402 : if (ierr.ne.0) return 402 : CALL ECRENT(NBZONE) 403 : RETURN 404 : ELSE IF(CMOT.EQ.'COMP' ) THEN 404 : CALL LIROBJ('MMODEL',IPMODL,0,IRETM) 405 : IF (IRETM.NE.0) THEN 406 : * 407 : * RECHERCHE DES NOMS DES COMPOSANTES APPARTENANT 408 : * A LA ZONE DU MODELE 409 : * 409 : CALL EXTR15(IPMODL,IPCHE1,IPLSTM) 409 : IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM) 410 : RETURN 411 : ELSE 412 : * 413 : * RECHERCHE DES NOMS DE TOUTES LES COMPOSANTES 414 : * 414 : CALL EXTR17(IPCHE1,IPLSTM) 414 : CALL ECROBJ('LISTMOTS',IPLSTM) 415 : RETURN 416 : ENDIF 417 : * 418 : ELSE IF(CMOT.EQ.'CONS' ) THEN 418 : CALL LIROBJ('MMODEL',IPMODL,0,IRETM) 419 : IF (IRETM.NE.0) THEN 420 : * 421 : * RECHERCHE DES NOMS DES constituants APPARTENANT 422 : * A LA ZONE DU MODELE 423 : * 423 : CALL EXTR35(IPMODL,IPCHE1,IPLSTM) 423 : IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM) 424 : RETURN 425 : ELSE 426 : * 427 : * RECHERCHE DES NOMS DE TOUs LES constituants 428 : * 428 : CALL EXTR37(IPCHE1,IPLSTM) 428 : CALL ECROBJ('LISTMOTS',IPLSTM) 429 : RETURN 430 : ENDIF 431 : * 432 : ELSE 433 : IF (CMOT.NE.'TITR'.AND.CMOT.NE.'TYPE'.AND.CMOT.NE.'MAIL') 434 : $ THEN 434 : CALL LIRENT(IENT1,1,IRET1) 435 : IF(IRET1.EQ.0) RETURN 435 : CALL LIRENT(IENT2,1,IRET2) 436 : IF(IRET2.EQ.0) RETURN 436 : CALL LIRENT(IENT3,1,IRET3) 437 : IF(IRET3.EQ.0) RETURN 438 : ENDIF 438 : CALL EXTR14(IPCHE1,IENT1,IENT2,IENT3,CMOT) 439 : RETURN 440 : ENDIF 441 : C 442 : C CAS DU MMODEL 443 : C 444 : 116 CONTINUE 444 : CALL LIROBJ('MMODEL',IPMODL,0,IRET) 445 : IF(IRET.EQ.0) GOTO 117 445 : CALL LIRMOT(CMOC,20,IRET,1) 446 : IF(IERR.NE.0) RETURN 447 : CMOT=CMOC(IRET) 448 : MMODEL=IPMODL 449 : SEGACT MMODEL 450 : NSOUS=KMODEL(/1) 451 : * en cas de modele melange derouler : creer un nouveau mmode 452 : segini limode 453 : do im = 1,NSOUS 454 : imodel = kmodel(im) 455 : segact imodel 456 : limode(**) = imodel 457 : if (formod(1).eq.'MELANGE') then 458 : if (ivamod(/1).ge.1) then 459 : do ivm1 = 1,ivamod(/1) 460 : if (tymode(ivm1).eq.'IMODEL') then 461 : limode(**) = ivamod(ivm1) 462 : endif 463 : enddo 464 : endif 465 : endif 466 : enddo 467 : segdes mmodel 468 : * test non redondance 469 : N1 = 1 470 : if (limode(/1).gt.1) then 471 : do 1161 it1 = limode(/1),2,-1 472 : imode1 = limode(it1) 473 : segact imode1 474 : do it2 = (it1 - 1) ,1,-1 475 : imode2 = limode(it2) 476 : segact imode2 477 : if (imode1.imamod.eq.imode2.imamod.and. 478 : & imode1.conmod.eq.imode2.conmod) then 479 : limode(it1) = 0 480 : goto 1161 481 : endif 482 : enddo 483 : N1 = N1 + 1 484 : 1161 continue 485 : endif 486 : is1 = 0 487 : if (limode(/1).gt.0) then 488 : segini,mmodel 489 : do is = 1,limode(/1) 490 : if (limode(is).gt.0) then 491 : is1 = is1 + 1 492 : kmodel(is1) = limode(is) 493 : endif 494 : enddo 495 : else 496 : endif 497 : NSOUS=KMODEL(/1) 498 : IPMODL = MMODEL 499 : 500 : IF (CMOT.EQ.'MAIL') THEN 501 : MMODEL=IPMODL 502 : SEGACT MMODEL 503 : NSOUS=KMODEL(/1) 504 : IMODEL=KMODEL(1) 505 : SEGACT IMODEL 506 : IPP1=IMAMOD 507 : SEGDES IMODEL 508 : IF(NSOUS.GT.1) THEN 509 : DO 1116 I=2,NSOUS 510 : IMODEL=KMODEL(I) 511 : SEGACT IMODEL 512 : IPP2 = IMAMOD 513 : SEGDES IMODEL 514 : ltelq=.false. 514 : CALL FUSE (IPP1,IPP2,IRET,ltelq) 515 : IPP1=IRET 516 : 1116 CONTINUE 517 : ENDIF 518 : SEGDES MMODEL 518 : CALL ECROBJ('MAILLAGE',IPP1) 519 : RETURN 520 : ELSEIF (CMOT.eq.'COMP') THEN 520 : CALL LIRCHA(MOFORM(1),1,iretou) 521 : if(ierr.ne.0) return 522 : MMODEL=IPMODL 523 : SEGACT MMODEL 524 : NSOUS=KMODEL(/1) 525 : segini,MMODE1=MMODEL 526 : N1=0 527 : DO 5497 I=1,NSOUS 528 : IMODEL=KMODEL(I) 529 : SEGACT IMODEL 530 : DO IB=1,MATMOD(/2) 531 : IF( MATMOD(IB).EQ.MOFORM(1)) go to 5498 532 : ENDDO 533 : SEGDES IMODEL 534 : GO TO 5497 535 : 5498 CONTINUE 536 : N1=N1+1 537 : MMODE1.KMODEL(N1)=KMODEL(I) 538 : SEGDES IMODEL 539 : 5497 CONTINUE 540 : SEGDES MMODEL 540 : IF(N1.EQ.0)CALL ERREUR(610) 541 : IF(N1.GE.0.AND.N1.NE.NSOUS) SEGADJ MMODE1 542 : segdes MMODE1 542 : CALL ECROBJ('MMODEL',MMODE1) 543 : RETURN 544 : ELSEIF(CMOT.EQ.'OBJE') THEN 545 : mmodel=ipmodl 546 : segact mmodel 547 : if(kmodel(/1).ne.1) then 548 : WRITE(IOIMP,*) ' it is not an elementary model' 548 : call erreur(19) 549 : return 550 : endif 551 : imodel=kmodel(1) 552 : segact imodel 553 : iob=ivamod(/1) 554 : do io=iob,1,-1 555 : ctyp=tymode(io) 556 : if( ctyp.eq.'ENTIER') then 556 : call ecrent(ivamod(io)) 557 : else 557 : call ecrobj(ctyp,ivamod(io)) 558 : endif 559 : enddo 560 : segdes imodel,mmodel 561 : return 562 : ELSEIF (CMOT.EQ.'ZONE') THEN 563 : MMODEL=IPMODL 564 : SEGACT MMODEL 565 : NSOUS=KMODEL(/1) 566 : M=NSOUS*2 567 : N1 = 1 568 : SEGINI MTABLE 569 : IF(NSOUS.NE.0) THEN 570 : DO 128 IOK=1,NSOUS 571 : IMODEL=KMODEL(IOK) 572 : SEGACT IMODEL 573 : NFOR=FORMOD(/2) 574 : C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT 574 : CALL PLACE (FORMOD,NFOR,IDARC,'DARCY') 574 : CALL PLACE (FORMOD,NFOR,IEULE,'EULER') 574 : CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES') 575 : IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN 576 : SEGINI,IMODE1= IMODEL 577 : IMODE1.INFMOD(2)=0 578 : SEGDES IMODEL 579 : IMODEL=IMODE1 580 : ENDIF 581 : SEGINI MMODE1 582 : MMODE1.KMODEL(1) = IMODEL 583 : SEGDES MMODE1 584 : IPP1= MMODE1 585 : IPP2=IMAMOD 586 : IVALI1=IOK*2 -1 587 : IVALI2=IOK*2 587 : CALL ECCTAB(MTABLE,'ENTIER ',IVALI1,XFLOT,MOT_8,LAG, 588 : $ IOBIN,'MMODEL ',IVALRE,XFLOT,MOT_8,LAG,IPP1) 588 : CALL ECCTAB(MTABLE,'ENTIER ',IVALI2,XFLOT,MOT_8,LAG, 589 : $ IOBIN,'MAILLAGE',IVALRE,XFLOT,MOT_8,LAG,IPP2) 590 : SEGDES IMODEL 591 : 128 CONTINUE 592 : ENDIF 592 : CALL ECROBJ('TABLE ',MTABLE) 593 : RETURN 594 : ELSE IF (CMOT.EQ.'FORM'.OR.CMOT.EQ.'CONS'.OR.CMOT.EQ.'ELEM'.OR. 595 : $ CMOT.EQ.'MATE') THEN 596 : INFOR=1 597 : IF (CMOT.EQ.'MATE') THEN 598 : IPASS=0 599 : ICOND=0 599 : 1191 CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO) 600 : IF (IERR.NE.0) RETURN 601 : IPASS=IPASS+1 602 : IF (IRETO.EQ.0.AND.IPASS.EQ.1) THEN 602 : CALL NOVARD(IPMODL,CMOT) 603 : RETURN 604 : ENDIF 605 : IF (IRETO.NE.0) THEN 606 : INFOR=INFOR+1 607 : IF (INFOR.GT.NBFORM) THEN 607 : CALL ERREUR(5) 608 : RETURN 609 : ENDIF 610 : GO TO 1191 611 : ENDIF 612 : ELSE 613 : ICOND=1 613 : 1192 CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO) 614 : IF (IERR.NE.0) RETURN 615 : ICOND=0 616 : IF (IRETO.NE.0) THEN 617 : INFOR=INFOR+1 618 : IF (INFOR.GT.NBFORM) THEN 618 : CALL ERREUR(5) 619 : RETURN 620 : ENDIF 621 : GO TO 1192 622 : ENDIF 623 : ENDIF 624 : INFOR=INFOR-1 625 : * 626 : MMODE1=IPMODL 627 : SEGACT MMODE1 628 : NSOUS=MMODE1.KMODEL(/1) 629 : N1=NSOUS 630 : SEGINI MMODEL 631 : IPP1=MMODEL 632 : NZON=0 633 : * 634 : DO 1119 I=1,NSOUS 635 : IMODEL=MMODE1.KMODEL(I) 636 : SEGACT IMODEL 637 : IF(CMOT.EQ.'FORM') THEN 638 : NFOR=FORMOD(/2) 639 : 640 : IF(NFOR.NE.INFOR) GO TO 1119 641 : IF(NFOR.EQ.1) THEN 642 : IF(MOFORM(1).NE.FORMOD(1)) GO TO 1119 643 : ELSE IF(NFOR.EQ.2) THEN 644 : IF(((MOFORM(1).NE.FORMOD(1)).AND.(MOFORM(2).NE 645 : $ .FORMOD(2))).AND.((MOFORM(1).NE.FORMOD(2)).AND 646 : $ .(MOFORM(2).NE.FORMOD(1))))GO TO 1119 647 : ELSE 648 : GO TO 1118 649 : ENDIF 650 : ELSE IF (CMOT.EQ.'CONS') THEN 651 : DO 425 IJ=1,INFOR 652 : C on enleve les espaces au debut et a la fin 653 : idim0=LEN(MOFORM(IJ)) 654 : idim1=CONMOD(/1) 655 : ideb0=0 656 : ifin0=0 657 : ideb1=0 658 : ifin1=0 659 : DO ii=1,idim0 660 : IF(ideb0.EQ.0.AND.MOFORM(IJ)(ii:ii).NE.' ') 661 : $ ideb0=ii 662 : IF(ifin0.EQ.0.AND. 663 : & MOFORM(IJ)(idim0-ii+1:idim0-ii+1).NE.' ') 664 : & ifin0=idim0-ii+1 665 : ENDDO 666 : DO ii=1,idim1 667 : IF(ideb1.EQ.0.AND.CONMOD(ii:ii).NE.' ') ideb1=ii 668 : IF(ifin1.EQ.0.AND. 669 : & CONMOD(idim1-ii+1:idim1-ii+1).NE.' ') 670 : & ifin1=idim1-ii+1 671 : ENDDO 672 : C print *,'Limites : ',ideb0,ifin0,' / ',ideb1,ifin1 673 : IF(MOFORM(IJ)(ideb0:ifin0).EQ.CONMOD(ideb1:ifin1)) 674 : & GOTO 429 675 : 425 CONTINUE 676 : GO TO 1119 677 : ELSE IF (CMOT.EQ.'ELEM') THEN 678 : DO 426 IJ=1,INFOR 679 : IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GO TO 429 680 : 426 CONTINUE 681 : GO TO 1119 682 : ELSEIF(CMOT.EQ.'MATE') THEN 683 : NMAT=MATMOD(/2) 684 : DO 427 IJ=1,INFOR 685 : DO 4275 JJ=1,NMAT 686 : IF(MATMOD(JJ).EQ.MOFORM(IJ)) GO TO 429 687 : 4275 CONTINUE 688 : 427 CONTINUE 689 : GO TO 1119 690 : ENDIF 691 : * on vient ici pour prendre les sous modeles 692 : 429 CONTINUE 693 : NZON=NZON+1 694 : NFOR=FORMOD(/2) 695 : C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT 695 : CALL PLACE (FORMOD,NFOR,IDARC,'DARCY') 695 : CALL PLACE (FORMOD,NFOR,IEULE,'EULER') 695 : CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES') 696 : IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN 697 : SEGINI,IMODE1= IMODEL 698 : IMODE1.INFMOD(2)=0 699 : SEGDES IMODEL 700 : IMODEL=IMODE1 701 : ENDIF 702 : KMODEL(NZON)=IMODEL 703 : SEGDES IMODEL 704 : 1119 CONTINUE 705 : * 706 : IF(NZON.EQ.0) GO TO 1118 707 : N1=NZON 708 : SEGADJ MMODEL 709 : SEGDES MMODEL 710 : SEGDES MMODE1 710 : CALL ECROBJ('MMODEL',IPP1) 711 : RETURN 712 : 1118 CONTINUE 712 : CALL ERREUR(610) 713 : SEGSUP MMODEL 714 : SEGDES IMODEL 715 : SEGDES MMODE1 716 : RETURN 717 : ELSE IF (IRET.GE.6.AND.IRET.LE.18.AND.IRET.NE.13) THEN 717 : CALL NOVARD(IPMODL,CMOT) 718 : RETURN 719 : ELSE 720 : MOTERR(1:4)=CMOT 720 : CALL ERREUR(7) 721 : RETURN 722 : ENDIF 723 : C+LP 724 : C 725 : C CAS DU CHARGEMENT 726 : C ===================== 727 : 117 CONTINUE 727 : CALL LIROBJ('CHARGEME',ICHAR,0,IRET) 728 : IF (IERR.NE.0) RETURN 729 : IF (IRET.EQ.0) GOTO 121 730 : C 731 : CMOT = ' ' 732 : ICHGT = 0 733 : LCHGT = 0 734 : IEC = 1 734 : CALL LIROBJ('LISTMOTS',LCHGT,0,IRET) 735 : IF (IERR.NE.0) RETURN 736 : IF (IRET.EQ.0) THEN 736 : CALL LIRCHA(CMOT,1,IRETOU) 737 : IF (IERR.NE.0) RETURN 737 : CALL PLACE(MCHGT,NBCHGT,ICHGT,CMOT) 738 : IF (ICHGT.GE.1 .AND. ICHGT.LE.5) THEN 738 : CALL LIRENT(IEC,0,IRETOU) 739 : IF (IERR.NE.0) RETURN 740 : IF (IRETOU.EQ.0) IEC = 1 741 : ELSE IF (ICHGT.EQ.0) THEN 741 : CALL LIRCHA(MOT_4,0,IRETOU) 742 : IF (IRETOU.NE.0) THEN 743 : IF (MOT_4.EQ.'TABL') THEN 744 : ICHGT=-1 745 : ELSE 745 : CALL REFUS 746 : ENDIF 747 : ENDIF 748 : ENDIF 749 : ENDIF 750 : C 750 : CALL EXTR20(ICHAR,CMOT,ICHGT,LCHGT,IEC,IOBJ1,CTYP1,IOBJ2,MOT_8) 751 : C 751 : IF (IOBJ1.NE.0) CALL ECROBJ(CTYP1,IOBJ1) 751 : IF (IOBJ2.NE.0) CALL ECROBJ(MOT_8,IOBJ2) 752 : RETURN 753 : C 754 : C CAS DE L'OBJET LISTCHPO 755 : C 756 : 121 CONTINUE 756 : CALL LIROBJ('LISTCHPO',ILCHP1,0,IRET) 757 : IF (IRET .EQ. 0 )GO TO 122 758 : MLCHP1 = ILCHP1 759 : SEGACT , MLCHP1 760 : LONCHP = MLCHP1.ICHPOI(/1) 760 : CALL LIROBJ('LISTENTI',ILENT,0,IRET) 761 : C 762 : C SOUS CAS DE LISTCHPO/LISTENTI 763 : C 764 : IF ( IRET .EQ. 1 ) THEN 765 : MLENTI = ILENT 766 : SEGACT , MLENTI 767 : JG = LECT(/1) 768 : N1=JG 769 : SEGINI , MLCHP2 770 : ILCHP2= MLCHP2 771 : DO 1211 I=1 , JG 772 : IF (( LECT(I) .GT. LONCHP ) .OR. ( LECT(I) .LT. 1 )) THEN 773 : INTERR(1) = LECT(I) 773 : CALL ERREUR(620) 774 : ENDIF 775 : MLCHP2.ICHPOI(I) = MLCHP1.ICHPOI(LECT(I)) 776 : 1211 CONTINUE 777 : SEGDES , MLENTI 778 : SEGDES , MLCHP1 779 : SEGDES , MLCHP2 779 : CALL ECROBJ ('LISTCHPO',ILCHP2) 780 : RETURN 781 : C 782 : C SOUS CAS LISTCHPO/ENTIER 783 : C 784 : ELSE 784 : CALL LIRENT (ILENT,1,IRETOU) 785 : IF (IERR .NE. 0) THEN 786 : SEGDES , MLCHP1 787 : RETURN 788 : ENDIF 789 : IF (ILENT.GT.LONCHP .OR. ILENT.LT.1 ) THEN 790 : INTERR(1)=ILENT 790 : CALL ERREUR(620) 791 : ENDIF 792 : ILCHPO = MLCHP1.ICHPOI(ILENT) 793 : SEGDES , MLCHP1 793 : CALL ECROBJ('CHPOINT ',ILCHPO) 794 : RETURN 795 : ENDIF 796 : 122 CONTINUE 797 : C 798 : C 799 : C CAS DE L'OBJET LIST DE MOT 800 : C 800 : CALL LIROBJ('LISTMOTS',ILMOT1,0,IRET) 801 : IF (IRET .EQ. 0 )GO TO 123 802 : MLMOT1 = ILMOT1 803 : SEGACT , MLMOT1 804 : LONMOT = MLMOT1.MOTS(/2) 805 : JGN = MLMOT1.MOTS(/1) 805 : CALL LIROBJ('LISTENTI',ILENT,0,IRET) 806 : C 807 : C SOUS CAS DE LISTMOTS/LISTENTI 808 : C 809 : IF ( IRET .EQ. 1 ) THEN 810 : MLENTI = ILENT 811 : SEGACT , MLENTI 812 : JGM = LECT(/1) 813 : SEGINI , MLMOT2 814 : ILMOT2= MLMOT2 815 : DO 1221 I=1 , JGM 816 : IF (( LECT(I) .GT. LONMOT ) .OR. ( LECT(I) .LT. 1 )) THEN 817 : INTERR(1) = LECT(I) 817 : CALL ERREUR(620) 818 : ENDIF 819 : MLMOT2.MOTS(I) = MLMOT1.MOTS(LECT(I)) 820 : 1221 CONTINUE 821 : SEGDES , MLENTI 822 : SEGDES , MLMOT1 823 : SEGDES , MLMOT2 823 : CALL ECROBJ ('LISTMOTS',ILMOT2) 824 : RETURN 825 : C 826 : C SOUS CAS LISTMOTS/ENTIER 827 : C 828 : ELSE 828 : CALL LIRENT (ILENT,1,IRETOU) 829 : IF (IERR .NE. 0) THEN 830 : SEGDES , MLMOT1 831 : RETURN 832 : ENDIF 833 : IF (ILENT.GT.LONMOT .OR. ILENT.LT.1 ) THEN 834 : INTERR(1)=ILENT 834 : CALL ERREUR(620) 835 : ELSE 836 : CTEXT = MLMOT1.MOTS(ILENT) 837 : ENDIF 838 : SEGDES , MLMOT1 838 : CALL ECRCHA(CTEXT(1:JGN)) 839 : RETURN 840 : ENDIF 841 : 123 CONTINUE 842 : C 843 : C 844 : C CAS DE L'OBJET LISTREEL 845 : C 845 : CALL LIROBJ('LISTREEL',ILREE1,0,IRET) 846 : IF (IRET .EQ. 0 )GO TO 124 847 : MLREE1 = ILREE1 848 : SEGACT , MLREE1 849 : LONREE = MLREE1.PROG(/1) 849 : CALL LIROBJ('LISTENTI',ILENT,0,IRET) 850 : C 851 : C SOUS CAS LISTREEL/LISTENTIER 852 : C 853 : IF ( IRET .EQ. 1 ) THEN 854 : MLENTI = ILENT 855 : SEGACT , MLENTI 856 : JG = LECT(/1) 857 : SEGINI , MLREE2 858 : ILREE2= MLREE2 859 : DO 1231 I=1 , JG 860 : IF (( LECT(I) .GT. LONREE ) .OR. ( LECT(I) .LT. 1 )) THEN 861 : INTERR(1) = LECT(I) 861 : CALL ERREUR(620) 862 : ENDIF 863 : MLREE2.PROG(I) = MLREE1.PROG(LECT(I)) 864 : 1231 CONTINUE 865 : SEGDES , MLENTI 866 : SEGDES , MLREE1 867 : SEGDES , MLREE2 867 : CALL ECROBJ ('LISTREEL',ILREE2) 868 : RETURN 869 : C 870 : C SOUS CAS LISTREEL/ENTIER 871 : C 872 : ELSE 872 : CALL LIRENT (ILENT,1,IRETOU) 873 : IF (IERR .NE. 0) THEN 874 : SEGDES , MLREE1 875 : RETURN 876 : ENDIF 877 : IF (ILENT.GT.LONREE .OR. ILENT.LT.1 ) THEN 878 : INTERR(1)=ILENT 878 : CALL ERREUR(620) 879 : ELSE 880 : REELDP = MLREE1.PROG(ILENT) 881 : ENDIF 882 : SEGDES , MLREE1 882 : CALL ECRREE(REELDP) 883 : RETURN 884 : ENDIF 885 : 124 CONTINUE 886 : C 887 : C 888 : C CAS DE L'OBJET LISTENTIER 889 : C 889 : CALL LIROBJ('LISTENTI',ILENT1,0,IRET) 890 : IF (IRET .EQ. 0 ) GO TO 125 891 : MLENT1 = ILENT1 892 : SEGACT , MLENT1 893 : LONENT = MLENT1.LECT(/1) 893 : CALL LIROBJ('LISTENTI',ILENT2,0,IRET) 894 : C 895 : C SOUS CAS LISTENTIER/LISTENTIER 896 : C 897 : IF ( IRET .EQ. 1 ) THEN 898 : MLENT2 = ILENT2 899 : SEGACT , MLENT2 900 : JG = MLENT2.LECT(/1) 901 : SEGINI , MLENT3 902 : ILENT3= MLENT3 903 : DO 1241 I=1 , JG 904 : IF (MLENT2.LECT(I).GT.LONENT.OR.MLENT2.LECT(I).LT.1) THEN 905 : INTERR(1) = MLENT2.LECT(I) 905 : CALL ERREUR(620) 906 : ENDIF 907 : MLENT3.LECT(I) = MLENT1.LECT(MLENT2.LECT(I)) 908 : 1241 CONTINUE 909 : SEGDES , MLENT1 910 : SEGDES , MLENT2 911 : SEGDES , MLENT3 911 : CALL ECROBJ ('LISTENTI',ILENT3) 912 : RETURN 913 : C 914 : C SOUS CAS LISTENTIER/ENTIER 915 : C 916 : ELSE 916 : CALL LIRENT (ILENT,1,IRETOU) 917 : IF (IERR .NE. 0) THEN 918 : SEGDES , MLENT1 919 : RETURN 920 : ENDIF 921 : IF (ILENT.GT.LONENT .OR. ILENT.LT.1 ) THEN 922 : INTERR(1)=ILENT 922 : CALL ERREUR(620) 923 : ELSE 924 : INTEGR = MLENT1.LECT(ILENT) 925 : ENDIF 926 : SEGDES , MLENT1 926 : CALL ECRENT(INTEGR) 927 : RETURN 928 : ENDIF 929 : 125 CONTINUE 930 : C 931 : C CAS DE L'OBJET NUAGE 932 : C 932 : CALL LIROBJ('NUAGE ',IPOINT,0,IRET) 933 : IF (IRET.EQ.0) GOTO 126 934 : 935 : MNUAGE=IPOINT 936 : SEGACT MNUAGE 936 : CALL LIRMOT(NUMO,5,INU1,0) 937 : IF (INU1.EQ.0) THEN 937 : CALL LIRCHA(CTYP1,1,IRETOU) 938 : IF (IERR.NE.0) THEN 939 : SEGDES MNUAGE 940 : GOTO 12599 941 : ENDIF 941 : CALL LIRMOT(NUMO,5,INU1,0) 942 : IF (INU1.EQ.0) THEN 943 : IF (CTYP1.EQ.'COMP ') THEN 944 : IPROG = 1 945 : ELSE 946 : IPOSI = 0 947 : DO 1250 I=1,NUANOM(/2) 948 : IF (NUANOM(I).EQ.CTYP1) IPOSI=I 949 : 1250 CONTINUE 950 : IF (IPOSI.EQ.0) THEN 951 : SEGDES MNUAGE 952 : MOTERR(1:8) = CTYP1 953 : *----CTYP1 n'est pas un nom de variable du NUAGE ----- 953 : CALL ERREUR(672) 954 : RETURN 955 : ENDIF 956 : IPROG = 2 957 : ENDIF 958 : ELSE 959 : IPOSI = 0 960 : DO 1251 I=1,NUANOM(/2) 961 : IF (NUANOM(I).EQ.CTYP1) IPOSI=I 962 : 1251 CONTINUE 963 : IF (IPOSI.EQ.0) THEN 964 : SEGDES MNUAGE 965 : MOTERR(1:8) = CTYP1 966 : *----CTYP1 n'est pas un nom de variable du NUAGE ----- 966 : CALL ERREUR(672) 967 : RETURN 968 : ENDIF 969 : IPROG = 3 970 : ENDIF 971 : ELSE 971 : CALL LIRCHA(CTYP1,1,IRETOU) 972 : IF (IERR.NE.0) THEN 973 : SEGDES MNUAGE 974 : GOTO 12599 975 : ENDIF 976 : IPOSI = 0 977 : DO 1252 I=1,NUANOM(/2) 978 : IF (NUANOM(I).EQ.CTYP1) IPOSI=I 979 : 1252 CONTINUE 980 : IF (IPOSI.EQ.0) THEN 981 : SEGDES,MNUAGE 982 : MOTERR(1:8) = CTYP1 983 : *----CTYP1 n'est pas un nom de variable du NUAGE ----- 983 : CALL ERREUR(672) 984 : RETURN 985 : ELSE 986 : IPROG = 3 987 : ENDIF 988 : ENDIF 989 : 990 : *----------- Lecture éventuelle des FLOTTANTS ------------- 991 : 992 : IF ((IPROG.EQ.3).AND.(INU1.NE.3).AND.(INU1.NE.4)) THEN 993 : IF ((INU1.EQ.1).OR.(INU1.EQ.2)) THEN 993 : CALL LIRREE(XVAL1,0,IRETOU) 994 : IF (IRETOU.EQ.0) THEN 995 : SEGDES,MNUAGE 996 : *---- Il manque la valeur de la composante reelle ----- 996 : CALL ERREUR(668) 997 : RETURN 998 : ENDIF 999 : ELSE 999 : CALL LIRREE(XVAL1,0,IRETOU1) 999 : CALL LIRREE(XVAL2,0,IRETOU2) 1000 : IF ((IRETOU1.EQ.0).OR.(IRETOU2.EQ.0)) THEN 1001 : SEGDES,MNUAGE 1002 : *---- Il faut spécifier deux valeurs reelles ----- 1002 : CALL ERREUR(673) 1003 : RETURN 1004 : ENDIF 1005 : ENDIF 1006 : ENDIF 1007 : SEGDES MNUAGE 1008 : 1009 : *------ Cas de l'extraction des noms des composantes du NUAGE ------- 1010 : 1011 : IF (IPROG.EQ.1) THEN 1011 : CALL EXTR19(IPOINT,IPLSTM) 1012 : IF (IPLSTM.NE.0) THEN 1012 : CALL ECROBJ('LISTMOTS',IPLSTM) 1013 : ENDIF 1014 : 1015 : *--- Cas de l'extraction de l'objet correspondant a une composante --- 1016 : *----------------- donnee d'un NUAGE "colonne" ----------------------- 1017 : 1018 : ELSE IF (IPROG.EQ.2) THEN 1018 : CALL EXTR51(IPOINT,IPOSI) 1019 : 1020 : *---------------------------- Autres cas ------------------------------ 1021 : ELSE IF (IPROG.EQ.3) THEN 1022 : IF (INU1.EQ.1) THEN 1023 : BORNINF=.TRUE. 1023 : CALL EXTR50(IPOINT,BORNINF,XVAL1,IPOSI) 1024 : ELSE IF (INU1.EQ.2) THEN 1025 : BORNINF=.FALSE. 1025 : CALL EXTR50(IPOINT,BORNINF,XVAL1,IPOSI) 1026 : ELSE IF (INU1.EQ.3) THEN 1027 : MINI =.TRUE. 1027 : CALL EXTR52(IPOINT,MINI,IPOSI) 1028 : ELSE IF (INU1.EQ.4) THEN 1029 : MINI =.FALSE. 1029 : CALL EXTR52(IPOINT,MINI,IPOSI) 1030 : ELSE IF (INU1.EQ.5) THEN 1030 : CALL EXTR53(IPOINT,XVAL1,XVAL2,IPOSI) 1031 : ELSE 1032 : GOTO 126 1033 : ENDIF 1034 : 1035 : *---------------------------- Cas non prevus --------------------------- 1036 : ELSE 1037 : GOTO 126 1038 : ENDIF 1039 : GOTO 12599 1040 : 1041 : 126 CONTINUE 1042 : *------ On ne trouve pas d'objet de type compatible avec EXTR ---- 1042 : CALL ERREUR(676) 1043 : 12599 CONTINUE 1044 : 1045 : RETURN 1046 : END 1047 : 1048 : 1049 : 1050 :
© Cast3M 2003 - All rights reserved.
Disclaimer