1 : C EXIS SOURCE JC220346 12/09/17 21:15:00 7510 2 : 3 : SUBROUTINE EXIS 4 : 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : 8 : -INC CCOPTIO 9 : -INC CCHAMP 10 : 11 : -INC SMSOLUT 12 : -INC SMLMOTS 13 : -INC SMLENTI 14 : -INC SMLREEL 15 : -INC SMCHARG 16 : -INC SMMODEL 17 : -INC SMNUAGE 18 : 19 : SEGMENT LIMODE(0) 20 : 21 : PARAMETER (NBFORM=20) 22 : CHARACTER*4 CMOT 23 : CHARACTER*8 MOTYP,TYPOBJ,MOTYP1,MONU1 24 : CHARACTER*(LCONMO) MOFORM(NBFORM) 25 : CHARACTER*72 ICHAI,CHARRE 26 : LOGICAL IRET,IBOOL,LOGRE 27 : * 28 : PARAMETER (LSOL = 1) 29 : CHARACTER*4 MOTSOL(LSOL) 30 : DATA MOTSOL/'CONT'/ 31 : * 32 : PARAMETER (NCLE=2) 33 : CHARACTER*2 LCLE(NCLE) 34 : DATA LCLE/'OU','ET'/ 35 : * 36 : ILE=1 37 : IOBJLU=0 37 : CALL LIROBJ('OBJET ',MTABLE,0,IRETOU) 38 : IF(IRETOU.NE.0) THEN 39 : IOBJLU=1 40 : ELSE 40 : CALL LIROBJ('TABLE ',MTABLE,0,IRETOU) 41 : ENDIF 42 : IF (IRETOU.NE.0) THEN 43 : c 44 : c traitement special pour les tables 45 : c 46 : 4 CONTINUE 46 : CALL QUETYP(MOTYP,0,IRETOU) 47 : IF( IRETOU.NE.0) THEN 48 : IF(MOTYP.EQ.'ENTIER ') THEN 48 : CALL LIRENT(IVAL,1,IRETOU) 49 : ELSEIF(MOTYP.EQ.'MOT ')THEN 49 : CALL LIRCHA(ICHAI,1,ILE) 50 : ELSEIF(MOTYP.EQ.'LOGIQUE ') THEN 50 : CALL LIRLOG(IBOOL,1,IRETOU) 51 : ELSEIF(MOTYP.EQ.'FLOTTANT') THEN 51 : CALL LIRREE(XRET,1,IRETOU) 52 : ELSE 52 : CALL LIROBJ(MOTYP,IOBJ,1,IRETOU) 53 : ENDIF 54 : IF(IERR.NE.0) RETURN 55 : TYPOBJ=' ' 55 : CALL ACCTAB(MTABLE,MOTYP,IVAL,XRET,ICHAI(1:ILE),IBOOL 56 : $ ,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 57 : IF( TYPOBJ.EQ.' '.AND.MOTYP.EQ.'MOT '. 57 : $ AND.IOBJLU.EQ.1) CALL ACCTAB (MTABLE,'METHODE ',IVAL, 58 : $ XRET,ICHAI(1:ILE),IBOOL,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE, 59 : $ LOGRE,IOBRE) 60 : MTABLE = IOBRE 61 : IRET=.TRUE. 62 : IF(TYPOBJ.EQ.'TABLE ') GO TO 4 63 : IF(TYPOBJ.EQ.' ') IRET = .FALSE. 64 : GO TO 100 65 : ELSE 66 : IRET=.TRUE. 67 : GO TO 100 68 : ENDIF 69 : ELSE 70 : IRET =.TRUE. 70 : CALL QUETYP(MOTYP,0,IRETOU) 71 : IF (IRETOU.EQ.0) THEN 72 : IRET = .FALSE. 73 : GOTO 100 74 : ENDIF 74 : CALL LIROBJ(MOTYP,IVAL,1,IRETOU) 75 : IF (MOTYP.NE.'CHPOINT ' .AND. 76 : & MOTYP.NE.'LISTMOTS' .AND.MOTYP.NE.'MCHAML '.AND. 77 : & MOTYP.NE.'LISTENTI' .AND.MOTYP.NE.'LISTREEL'.AND. 78 : & MOTYP.NE.'MMODEL ' .AND.MOTYP.NE.'NUAGE '.AND. 79 : & MOTYP.NE.'CHARGEME' ) THEN 80 : IF (MOTYP.EQ.'ANNULE ') THEN 81 : IRET = .FALSE. 82 : GOTO 100 83 : ELSE IF (MOTYP.EQ.'SOLUTION') THEN 83 : CALL LIRMOT(MOTSOL,LSOL,IPOS,0) 84 : IF (MOTSOL(IPOS).EQ.'CONT') THEN 85 : MSOLUT = IVAL 86 : SEGACT MSOLUT 87 : MSOLEN = MSOLIS(6) 88 : SEGDES MSOLUT 89 : IF (MSOLEN.EQ.0) THEN 90 : IRET = .FALSE. 91 : GOTO 100 92 : ENDIF 93 : ENDIF 94 : ENDIF 95 : GOTO 100 96 : ENDIF 97 : ENDIF 98 : c 99 : c existence d une composante dans un mchaml ou un champoint 100 : c 101 : IF (MOTYP.EQ.'CHPOINT '.OR.MOTYP.EQ.'MCHAML ') THEN 101 : CALL LIRCHA(CMOT,0,IRETOU) 102 : if (IRETOU.EQ.0) then 103 : if (MOTYP.EQ.'MCHAML ') then 103 : CALL QUETYP(MOTYP1,0,IRETO1) 104 : IF (IRETO1.NE.0) THEN 105 : IF (MOTYP1.NE.'MAILLAGE'.AND.MOTYP1.NE.'MMODEL') THEN 106 : MOTERR(1:8)=MOTYP1 106 : CALL ERREUR(39) 107 : RETURN 108 : ENDIF 108 : call exiszo(ival,iret) 109 : IF (IERR.NE.0) RETURN 110 : GOTO 100 111 : ELSE 112 : GOTO 122 113 : ENDIF 114 : else 115 : GOTO 122 116 : endif 117 : endif 117 : CALL EXISCO(MOTYP,IVAL,CMOT,IRET) 118 : IF(IERR.NE.0) RETURN 119 : GOTO 100 120 : c 121 : c existence d'un mot/listmots dans un listmots 122 : c 123 : ELSE IF (MOTYP.EQ.'LISTMOTS') THEN 123 : CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETO1) 124 : IF (IRETO1.NE.0) THEN 125 : SEGACT MLMOT1 126 : NTEST=MLMOT1.MOTS(/2) 127 : IF (NTEST.EQ.0) THEN 128 : MOTERR(1:8)='LISTMOTS' 129 : INTERR(1)=MLMOT1 129 : CALL ERREUR(356) 130 : RETURN 131 : ENDIF 131 : CALL LIRMOT(LCLE,NCLE,ICLE,0) 132 : ELSE 132 : CALL LIRCHA(CMOT,0,IRETO2) 133 : IF (IRETO2.EQ.0) GOTO 122 134 : NTEST=1 135 : ENDIF 136 : 137 : MLMOTS=IVAL 138 : SEGACT MLMOTS 139 : JGM=MOTS(/2) 140 : DO 22 I=1,NTEST 141 : IRET=.FALSE. 142 : IF (IRETO1.NE.0) CMOT=MLMOT1.MOTS(NTEST+1-I) 143 : DO 20 J=1,JGM 144 : IF (MOTS(J).EQ.CMOT) THEN 145 : IRET=.TRUE. 146 : IF (ICLE.EQ.0) THEN 146 : CALL ECRLOG(IRET) 147 : ELSEIF (ICLE.EQ.1) THEN 148 : * Mot-clé 'OU' : un mot trouve => on peut sortir 149 : GOTO 21 150 : ENDIF 151 : GOTO 22 152 : ENDIF 153 : 20 CONTINUE 154 : IF (ICLE.EQ.0) THEN 154 : CALL ECRLOG(IRET) 155 : ELSEIF (ICLE.EQ.2) THEN 156 : * Mot-clé 'ET' : un mot non trouve => on peut sortir 157 : GOTO 21 158 : ENDIF 159 : 22 CONTINUE 160 : 21 SEGDES MLMOTS 161 : IF (IRETO1.NE.0) SEGDES MLMOT1 162 : IF (ICLE.EQ.0) RETURN 163 : GOTO 100 164 : c 165 : c existence d'un entier dans un listenti 166 : c 167 : ELSE IF (MOTYP.EQ.'LISTENTI') THEN 167 : CALL LIRENT(ITEST,0,IRETOU) 168 : IF (IRETOU.EQ.0) GOTO 122 169 : IRET=.FALSE. 170 : MLENTI=IVAL 171 : SEGACT MLENTI 172 : JG=LECT(/1) 173 : DO 30 J=1,JG 174 : IF(LECT(J).EQ.ITEST) THEN 175 : IRET=.TRUE. 176 : GO TO 31 177 : ENDIF 178 : 30 CONTINUE 179 : 31 SEGDES MLENTI 180 : GOTO 100 181 : c 182 : c existence d'un reel dans un listreel 183 : c 184 : ELSE IF (MOTYP.EQ.'LISTREEL') THEN 184 : CALL LIRREE(XTEST,0,IRETOU) 185 : IF (IRETOU.EQ.0) GOTO 122 186 : * lecture eventuelle d une tolerance 186 : CALL LIRREE(XTOL,0,IRETOU) 187 : IRET=.FALSE. 188 : MLREEL=IVAL 189 : SEGACT MLREEL 190 : JG=PROG(/1) 191 : IF (IRETOU.EQ.0) THEN 192 : DO 40 J=1,JG 193 : IF(PROG(J).EQ.XTEST) THEN 194 : IRET=.TRUE. 195 : GO TO 41 196 : ENDIF 197 : 40 CONTINUE 198 : ELSE 199 : DO 42 J=1,JG 200 : IF(abs(PROG(J)-XTEST).LE.XTOL) THEN 201 : IRET=.TRUE. 202 : GO TO 41 203 : ENDIF 204 : 42 CONTINUE 205 : ENDIF 206 : 41 SEGDES MLREEL 207 : GOTO 100 208 : c 209 : c existence d'une formulation ou un constituant dans 210 : c un mmodel 211 : c 212 : ELSE IF (MOTYP.EQ.'MMODEL ') THEN 212 : CALL LIRCHA(CMOT,0,IRETOU) 213 : IF (IRETOU.EQ.0) GOTO 122 214 : IF (CMOT.EQ.'FORM'.OR.CMOT.EQ.'CONS'.OR.CMOT.EQ.'ELEM' 215 : & .OR.CMOT.EQ.'MATE') THEN 216 : ICOND=1 217 : INFOR=1 217 : 119 call lircha(moform(infor),icond,ireto) 218 : IF(IERR.NE.0) RETURN 219 : ICOND=0 220 : IF(IRETO.NE.0) THEN 221 : INFOR=INFOR+1 222 : IF(INFOR.GT.NBFORM) THEN 222 : CALL ERREUR(5) 223 : RETURN 224 : ENDIF 225 : GO TO 119 226 : ENDIF 227 : INFOR=INFOR-1 228 : * 229 : MMODEL=IVAL 230 : SEGACT MMODEL 231 : NSOUS=KMODEL(/1) 232 : c 233 : * en cas de modele melange derouler : creer un nouveau mmode 234 : segini limode 235 : do im = 1,NSOUS 236 : imodel = kmodel(im) 237 : segact imodel 238 : limode(**) = imodel 239 : if (formod(1).eq.'MELANGE') then 240 : if (ivamod(/1).ge.1) then 241 : do ivm1 = 1,ivamod(/1) 242 : if (tymode(ivm1).eq.'IMODEL') then 243 : limode(**) = ivamod(ivm1) 244 : endif 245 : enddo 246 : endif 247 : endif 248 : enddo 249 : 250 : segdes mmodel 251 : if (limode(/1).gt.0) then 252 : N1 = limode(/1) 253 : segini,mmodel 254 : do is = 1,limode(/1) 255 : kmodel(is) = limode(is) 256 : enddo 257 : NSOUS = N1 258 : else 259 : * write(6,*) 'pas de modele' 259 : call erreur(251) 260 : endif 261 : c 262 : * 263 : DO 1119 I=1,NSOUS 264 : IMODEL=KMODEL(I) 265 : SEGACT IMODEL 266 : IF(CMOT.EQ.'FORM') THEN 267 : NFOR=FORMOD(/2) 268 : IF(NFOR.NE.INFOR) GO TO 1119 269 : IF(NFOR.EQ.1) THEN 270 : IF(MOFORM(1).EQ.FORMOD(1)) GO TO 1118 271 : ELSE IF(NFOR.EQ.2) THEN 272 : IF(((MOFORM(1).EQ.FORMOD(1)).AND.(MOFORM(2).EQ.FORMOD(2))). 273 : . OR.((MOFORM(1).EQ.FORMOD(2)).AND.(MOFORM(2).EQ.FORMOD(1)))) 274 : . GO TO 1118 275 : ENDIF 276 : ELSE IF (CMOT.EQ.'CONS') THEN 277 : DO 425 IJ=1,INFOR 278 : IF(MOFORM(IJ).EQ.CONMOD) GO TO 1118 279 : 425 CONTINUE 280 : ELSE IF (CMOT.EQ.'ELEM') THEN 281 : DO 426 IJ=1,INFOR 282 : IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GO TO 1118 283 : 426 CONTINUE 284 : ELSE IF (CMOT.EQ.'MATE') THEN 285 : NMAT=MATMOD(/2) 286 : DO 427 IJ=1,INFOR 287 : IBOOL = .TRUE. 288 : DO 4275 JJ=1,NMAT 289 : IBOOL = (MATMOD(JJ).NE.MOFORM(IJ)).AND. IBOOL 290 : 4275 CONTINUE 291 : IF (IBOOL) GOTO 1119 292 : 427 CONTINUE 293 : GOTO 1118 294 : ENDIF 295 : SEGDES IMODEL 296 : 1119 continue 297 : * 298 : IRET=.FALSE. 299 : SEGSUP MMODEL 300 : segsup limode 301 : GO TO 100 302 : * 303 : 1118 continue 304 : IRET=.TRUE. 305 : SEGDES IMODEL 306 : SEGSUP MMODEL 307 : segsup limode 308 : GO TO 100 309 : ELSE 310 : MOTERR(1:4)=CMOT 310 : CALL ERREUR(7) 311 : RETURN 312 : ENDIF 313 : c 314 : c cas de l'objet chargeme 315 : c 316 : ELSE IF (MOTYP.EQ.'CHARGEME') THEN 316 : CALL LIRCHA(CMOT,0,IRETOU) 317 : IF (IRETOU.EQ.0) GOTO 122 318 : IRET = .FALSE. 319 : MCHARG = IVAL 320 : SEGACT MCHARG 321 : IDIM1 = KCHARG(/1) 322 : IF (CMOT.EQ.'LIBR'.OR.CMOT.EQ.'LIE ') THEN 323 : DO 302 I=1,IDIM1 324 : IF (CMOT.EQ.CHALIE(I)) THEN 325 : IRET = .TRUE. 326 : GOTO 301 327 : ENDIF 328 : 302 CONTINUE 329 : ELSE 330 : DO 300 I=1,IDIM1 331 : IF (CMOT.EQ.CHANOM(I)) THEN 332 : IRET = .TRUE. 333 : GOTO 301 334 : ENDIF 335 : 300 CONTINUE 336 : ENDIF 337 : 301 CONTINUE 338 : SEGDES MCHARG 339 : GOTO 100 340 : c 341 : c cas de l'objet nuage 342 : c 343 : ELSE 343 : CALL LIRCHA(MONU1,0,IRETOU) 344 : IF (IRETOU.EQ.0) GOTO 122 345 : IRET=.FALSE. 346 : MNUAGE=IVAL 347 : SEGACT MNUAGE 348 : IDIM1 = NUANOM(/2) 349 : DO 200 I=1,IDIM1 350 : IF (MONU1.EQ.NUANOM(I)) THEN 351 : IRET = .TRUE. 352 : GOTO 201 353 : ENDIF 354 : 200 CONTINUE 355 : 201 CONTINUE 356 : SEGDES MNUAGE 357 : GOTO 100 358 : ENDIF 359 : c 360 : 122 CONTINUE 361 : IRET=.TRUE. 362 : IF(MOTYP.NE.'ANNULE ') GOTO 100 363 : IRET=.FALSE. 364 : 100 CONTINUE 364 : CALL ECRLOG(IRET) 365 : RETURN 366 : END 367 : 368 : 369 : 370 : 371 : 372 : 373 :
© Cast3M 2003 - All rights reserved.
Disclaimer