Télécharger exis.eso

Retour à la liste

Numérotation des lignes :

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

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