Télécharger exis.eso

Retour à la liste

Numérotation des lignes :

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

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