Télécharger exis.eso

Retour à la liste

Numérotation des lignes :

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

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