Télécharger lirres.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRRES SOURCE GF238795 18/02/01 21:15:57 9724
  2. SUBROUTINE LIRRES(ILCHP1,ICODE1,ITYPE1,NOM1,NCHPO1,ITEMP1,ILREE1)
  3. ************************************************************************
  4. * NOM : LIRRES
  5. * DESCRIPTION : Cherche a lire un "signal instationnaire" dans la pile
  6. * des objets sous la forme generique d'un LISTCHPO ou
  7. * a partir de tables resultats de calculs (PASAPAS, EXEC,
  8. * DYNAMIC...)
  9. ************************************************************************
  10. * APPELE PAR : pod.eso ; evpjba.eso ; pjblch.eso
  11. ************************************************************************
  12. * ENTREES : ICODE1 = entier valant 1 si la lecture est obligatoire ou
  13. * 0 si la lecture est facultative
  14. * ITYPE1 = type d'objet recherche :
  15. * 0 pour chercher tous les types
  16. * 1 pour chercher un LISTCHPO
  17. * 2 pour chercher une table PASAPAS
  18. * 3 pour chercher une DYNAMIC
  19. * 4 pour chercher une EXEC
  20. * ITEMP1 = entier valant 1 si la liste des temps doit etre
  21. * renvoyee dans ILREE1
  22. * SORTIES : ILCHP1 = pointeur vers l'objet LISTCHPO contenant le signal
  23. * instationnaire
  24. * ITYPE1 = code de sortie valant :
  25. * 0 si aucun objet trouve
  26. * 1 si objet LISTCHPO trouve
  27. * 2 si table PASAPAS trouvee
  28. * 3 si table DYNAMIC trouvee
  29. * 4 si table EXEC trouvee
  30. * NOM1 = nom de l'inconnue, si definie
  31. * NCHPO1 = nombre d'objets CHPOINT (= pas de temps) contenus
  32. * dans ILCHP1 (forcement positif, sinon erreur)
  33. * ILREE1 = pointeur vers l'objet LISTREEL contenant le temps
  34. * (vaut 0 si ITEMP1=0)
  35. *
  36. ************************************************************************
  37. * SYNTAXE (GIBIANE) :
  38. *
  39. * (...) = ???? | LCHPO1 LREEL1 | (LIPDT1) (...) ;
  40. * | TAB1 (MOT1) |
  41. *
  42. * (LREEL1 n'est pas requis dans le cas ou ITEMP1=0)
  43. *
  44. ************************************************************************
  45. IMPLICIT INTEGER(I-N)
  46. IMPLICIT REAL*8 (A-H,O-Z)
  47. -INC CCOPTIO
  48. -INC SMTABLE
  49. -INC SMLCHPO
  50. -INC SMLENTI
  51. -INC SMLREEL
  52. *
  53. PARAMETER (NTYP=3)
  54. CHARACTER*8 MTYP(NTYP)
  55. DATA MTYP/'PASAPAS','DYNAMIC','EQEX'/
  56. *
  57. CHARACTER*8 CHA8,CHB8
  58. LOGICAL ZLOGI
  59. *
  60. CHARACTER*32 NOM1
  61. *
  62. * IIDX = LISTE DES NCH PAS DE TEMPS RETENUS DANS LE SIGNAL INITIAL
  63. SEGMENT/TIDX/(IIDX(NCH))
  64. *
  65. * TRAV1 = SEGMENT DE TRAVAIL UTILISE LORS D'UN APPEL A ORDO
  66. SEGMENT TRAV1
  67. INTEGER ITRA((NTRA+1)/2)
  68. ENDSEGMENT
  69. *
  70. ************************************************************************
  71. *
  72. *
  73. ITYPO1=ITYPE1
  74. cGF test de ITIPE1 >> remplacement ITYPE1, on soupconne une typo
  75. IF (ITYPE1.GT.0) THEN
  76. ICODE2=ICODE1
  77. ELSE
  78. ICODE2=0
  79. ENDIF
  80. *
  81. ILREE1=0
  82. I0=0
  83. NOM1=' '
  84. *
  85. *
  86. * ****************************************************************
  87. * SIGNAL D'ENTREE DEJA SOUS LA FORME D'UN COUPLE LISTCHPO/LISTREEL
  88. * ****************************************************************
  89. IF (ITYPO1.EQ.0.OR.ITYPO1.EQ.1) THEN
  90. CALL LIROBJ('LISTCHPO',ILCHP1,ICODE2,IRET)
  91. IF (IRET.EQ.0) GOTO 1
  92. MLCHPO=ILCHP1
  93. SEGACT,MLCHPO
  94. NCH=ICHPOI(/1)
  95. ITYPE1=1
  96. *
  97. * (+ recuperation de la liste temporelle)
  98. IF (ITEMP1.GT.0) THEN
  99. * Le LISTREEL doit etre juste derriere le LISTCHPO (car on
  100. * pourrait aussi en trouver un autre plus loin) => test QUETYP
  101. CALL QUETYP(CHA8,0,IRET)
  102. IF (IRET.EQ.0.OR.CHA8.NE.'LISTREEL') THEN
  103. MOTERR(1:8)='LISTREEL'
  104. CALL ERREUR(37)
  105. RETURN
  106. ENDIF
  107. CALL LIROBJ('LISTREEL',ILREE1,1,IRET)
  108. MLREEL=ILREE1
  109. SEGACT,MLREEL
  110. IF (PROG(/1).NE.NCH) THEN
  111. CALL ERREUR(212)
  112. RETURN
  113. ENDIF
  114. NCH=ICHPOI(/1)
  115. ENDIF
  116. *
  117. GOTO 2
  118. ENDIF
  119. *
  120. *
  121. * ****************************************************************
  122. * SI C'EST UNE TABLE : ON RECHERCHE L'INDICE CONTENANT LA VARIABLE
  123. * DEMANDEE PAR L'UTILISATEUR (PAR DEFAUT LE
  124. * DEPLACEMENT EN MECA. SOLIDE, LA VITESSE EN
  125. * MECA. FLUIDE)
  126. * ****************************************************************
  127. 1 CONTINUE
  128. IF (ITYPO1.EQ.1) GOTO 3
  129. CALL LIROBJ('TABLE',ITAB1,0,IRET)
  130. IF (IRET.EQ.0) GOTO 3
  131. *
  132. * RECHERCHE DU SOUS-TYPE DE LA TABLE
  133. ITYP=0
  134. CHA8=' '
  135. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  136. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  137. IF (CHA8.EQ.'MOT') CALL PLACE(MTYP,NTYP,ITYP,CHB8)
  138. IF (ITYP.EQ.0) THEN
  139. MOTERR(1:8)='TABLE'
  140. CALL ERREUR(302)
  141. RETURN
  142. ENDIF
  143. *
  144. ITYPE1=ITYP+1
  145. IF (ITYPO1.GT.0.AND.ITYPE1.NE.ITYPO1) GOTO 3
  146. *
  147. * RECUPERATION EVENTUELLE DU NOM DE L'INDICE
  148. CALL QUETYP(CHA8,1,IRET)
  149. IF (IERR.NE.0) RETURN
  150. LNOM1=0
  151. IF (CHA8.EQ.'MOT') CALL LIRCHA(NOM1,1,LNOM1)
  152. *
  153. *
  154. * CAS D'UNE TABLE PASAPAS
  155. * =======================
  156. IF (ITYPE1.EQ.2) THEN
  157. IF (LNOM1.EQ.0) NOM1='DEPLACEMENTS'
  158. I0=1
  159. *
  160. CHA8=' '
  161. CALL ACCTAB(ITAB1,'MOT',0,0.D0,NOM1,.TRUE.,0,
  162. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  163. IF (CHA8.NE.'TABLE') GOTO 9
  164. MTABLE=ITAB2
  165. SEGACT,MTABLE
  166. NCH=MLOTAB
  167. *
  168. * (+ recuperation de la liste temporelle)
  169. IF (ITEMP1.GT.0) THEN
  170. CHA8=' '
  171. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'TEMPS',.TRUE.,0,
  172. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  173. IF (CHA8.NE.'TABLE') GOTO 9
  174. MTAB2=ITAB2
  175. SEGACT,MTAB2
  176. ENDIF
  177. *
  178. * CAS D'UNE TABLE DYNAMIC
  179. * =======================
  180. ELSEIF (ITYPE1.EQ.3) THEN
  181. IF (LNOM1.EQ.0) NOM1='DEPL'
  182. *
  183. CHA8=' '
  184. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'RESULTATS',.TRUE.,0,
  185. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  186. IF (CHA8.NE.'TABLE') GOTO 9
  187. MTABLE=ITAB2
  188. SEGACT,MTABLE
  189. NCH=MLOTAB
  190. *
  191. * (+ recuperation de la liste temporelle)
  192. IF (ITEMP1.GT.0) THEN
  193. CHA8=' '
  194. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'TEMPS_CALCULES',.TRUE.,0,
  195. & CHA8,IVAL,XVAL,CHB8,ZLOGI,IOBJ2)
  196. IF (CHA8.NE.'LISTREEL') GOTO 9
  197. MLREEL=IOBJ2
  198. SEGACT,MLREEL
  199. ENDIF
  200. *
  201. * CAS D'UNE TABLE EXEC
  202. * ====================
  203. ELSEIF (ITYPE1.EQ.4) THEN
  204. IF (LNOM1.EQ.0) NOM1='UN'
  205. *
  206. CHA8=' '
  207. CALL ACMO(ITAB1,'INCO',CHA8,ITAB2)
  208. IF (CHA8.NE.'TABLE') GOTO 9
  209. CHA8=' '
  210. CALL ACMO(ITAB2,'HIST',CHA8,ITAB3)
  211. IF (CHA8.NE.'TABLE') GOTO 9
  212. CHA8=' '
  213. CALL ACMO(ITAB3,NOM1,CHA8,ILCHP1)
  214. IF (CHA8.NE.'LISTCHPO') GOTO 9
  215. MLCHPO=ILCHP1
  216. SEGACT,MLCHPO
  217. NCH=ICHPOI(/1)
  218. *
  219. * (+ recuperation de la liste temporelle)
  220. IF (ITEMP1.GT.0) THEN
  221. CHA8=' '
  222. CALL ACCTAB(ITAB2,'MOT',0,0.D0,'TPS',.TRUE.,0,
  223. & CHA8,IVAL,XVAL,CHB8,ZLOGI,IOBJ2)
  224. IF (CHA8.NE.'LISTREEL') GOTO 9
  225. MLREEL=IOBJ2
  226. SEGACT,MLREEL
  227. ENDIF
  228. *
  229. ENDIF
  230. *
  231. GOTO 2
  232. *
  233. * ERREUR : LA TABLE N'A PAS LE FORMAT ATTENDU
  234. 9 CONTINUE
  235. CALL ERREUR(647)
  236. RETURN
  237. *
  238. *
  239. * *************************************************************
  240. * RECUPERATION EVENTUELLE D'UNE LISTE D'INDICES DE PAS DE TEMPS
  241. * *************************************************************
  242. 2 CONTINUE
  243. *
  244. * Le LISTENTI doit etre place precisement ici (car on pourrait
  245. * aussi en trouver un autre plus loin) => test QUETYP
  246. CALL QUETYP(CHA8,0,IRET)
  247. IZIDX=0
  248. IF (IRET.NE.0.AND.CHA8.EQ.'LISTENTI') THEN
  249. IZIDX=1
  250. CALL LIROBJ('LISTENTI',MLENT1,1,IRET)
  251. IF (IERR.NE.0) RETURN
  252. ENDIF
  253. *
  254. * PAR DEFAUT, ON RETIENT TOUS LES INSTANTS DISPONIBLES
  255. IF (IZIDX.EQ.0) THEN
  256. SEGINI,TIDX
  257. DO I=1,NCH
  258. IIDX(I)=I-I0
  259. ENDDO
  260. ELSE
  261. NCH1=NCH
  262. *
  263. SEGACT,MLENT1
  264. NCH=MLENT1.LECT(/1)
  265. SEGINI,TIDX
  266. *
  267. * VALIDATION DES VALEURS FOURNIES DANS MLENT1
  268. NCH=0
  269. DO I=1,MLENT1.LECT(/1)
  270. IVAL=MLENT1.LECT(I)
  271. IF (IVAL.GE.1.AND.IVAL.LE.NCH1) THEN
  272. NCH=NCH+1
  273. IIDX(NCH)=IVAL
  274. ENDIF
  275. ENDDO
  276. SEGDES,MLENT1
  277. *
  278. * TRI PAR ORDRE CROISSANT
  279. NTRA=NCH
  280. SEGINI,TRAV1
  281. CALL ORDM02(IIDX(1),NCH,ITRA(1),.TRUE.)
  282. SEGSUP,TRAV1
  283. *
  284. * SUPPRESSION DES DOUBLONS
  285. NDOUB=0
  286. DO I=2,NCH
  287. IF (IIDX(I-1).NE.IIDX(I)) THEN
  288. IF (NDOUB.GT.0) IIDX(I-NDOUB)=IIDX(I)
  289. ELSE
  290. NDOUB=NDOUB+1
  291. ENDIF
  292. ENDDO
  293. NCH=NCH-NDOUB
  294. SEGADJ,TIDX
  295. ENDIF
  296. *
  297. IF (NCH.EQ.0) THEN
  298. WRITE(IOIMP,*) 'Le signal fourni est vide'
  299. CALL ERREUR(21)
  300. RETURN
  301. ENDIF
  302. *
  303. *
  304. * ********************************************************
  305. * OBTENTION DES OBJETS LISTREEL ET LISTCHPO RESTREINTS AUX
  306. * INSTANTS DE IIDX
  307. * ********************************************************
  308. *
  309. * SYNTAXES 1 (LISTCHPO/LISTREEL) ET 4 (PROCEDURE "EXEC")
  310. * ======================================================
  311. IF (IZIDX.NE.0.AND.(ITYPE1.EQ.1.OR.ITYPE1.EQ.4)) THEN
  312. *
  313. MLCHP1=MLCHPO
  314. N1=NCH
  315. SEGINI,MLCHPO
  316. DO I=1,NCH
  317. ICHPOI(I)=MLCHP1.ICHPOI(IIDX(I))
  318. ENDDO
  319. SEGDES,MLCHP1
  320. *
  321. IF (ITEMP1.GT.0) THEN
  322. MLREE1=MLREEL
  323. JG=NCH
  324. SEGINI,MLREEL
  325. DO I=1,NCH
  326. PROG(I)=MLREE1.PROG(IIDX(I))
  327. ENDDO
  328. ENDIF
  329. SEGDES,MLREE1
  330. *
  331. * SYNTAXE 2 (PROCEDURE "PASAPAS")
  332. * ===============================
  333. ELSEIF (ITYPE1.EQ.2) THEN
  334. *
  335. N1=NCH
  336. SEGINI,MLCHPO
  337. DO I=1,NCH
  338. IDX1=IIDX(I)
  339. CALL ACCTAB(MTABLE,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0,
  340. & 'CHPOINT',IVAL,XVAL,CHA8,ZLOGI,ICHP1)
  341. IF (IERR.NE.0) RETURN
  342. ICHPOI(I)=ICHP1
  343. ENDDO
  344. SEGDES,MTABLE
  345. *
  346. IF (ITEMP1.GT.0) THEN
  347. JG=NCH
  348. SEGINI,MLREEL
  349. DO I=1,NCH
  350. IDX1=IIDX(I)
  351. CALL ACCTAB(MTAB2,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0,
  352. & 'FLOTTANT',IVAL,XT1,CHA8,ZLOGI,IP1)
  353. IF (IERR.NE.0) RETURN
  354. PROG(I)=XT1
  355. ENDDO
  356. SEGDES,MTAB2
  357. ENDIF
  358. *
  359. * SYNTAXE 3 (PROCEDURE "DYNAMIC")
  360. * ===============================
  361. ELSEIF (ITYPE1.EQ.3) THEN
  362. *
  363. N1=NCH
  364. SEGINI,MLCHPO
  365. DO I=1,NCH
  366. IDX1=IIDX(I)
  367. CALL ACCTAB(MTABLE,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0,
  368. & 'TABLE',IVAL,XVAL,CHA8,ZLOGI,ITAB1)
  369. IF (IERR.NE.0) RETURN
  370. CHA8='CHPOINT'
  371. CALL ACMO(ITAB1,NOM1,CHA8,ICHP1)
  372. IF (IERR.NE.0) RETURN
  373. ICHPOI(I)=ICHP1
  374. ENDDO
  375. SEGDES,MTABLE
  376. *
  377. IF (ITEMP1.GT.0.AND.IZIDX.NE.0) THEN
  378. MLREE1=MLREEL
  379. JG=NCH
  380. SEGINI,MLREEL
  381. DO I=1,NCH
  382. PROG(I)=MLREE1.PROG(IIDX(I))
  383. ENDDO
  384. SEGDES,MLREE1
  385. ENDIF
  386. *
  387. ENDIF
  388. *
  389. *
  390. SEGSUP,TIDX
  391. ILCHP1=MLCHPO
  392. IF (ITEMP1.GT.0) ILREE1=MLREEL
  393. *
  394. NCHPO1=NCH
  395. RETURN
  396. *
  397. *
  398. * *********************************
  399. * AUCUN OBJET COMPATIBLE N'A ETE LU
  400. * *********************************
  401. 3 CONTINUE
  402. *
  403. ILCHP1=0
  404. ITYPE1=0
  405. *
  406. IF (ICODE1.GT.0) THEN
  407. WRITE(IOIMP,*) 'Il manque un objet compatible pour definir ',
  408. & 'le signal d entree'
  409. CALL ERREUR(880)
  410. ENDIF
  411. *
  412. RETURN
  413. *
  414. END
  415. *
  416. *
  417.  
  418.  

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