Télécharger exis.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales