Télécharger exis.eso

Retour à la liste

Numérotation des lignes :

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

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