Télécharger lirres.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRRES SOURCE JC220346 16/04/25 21:15:09 8915
  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. IF (ITIPE1.GT.0) THEN
  75. ICODE2=ICODE1
  76. ELSE
  77. ICODE2=0
  78. ENDIF
  79. *
  80. ILREE1=0
  81. I0=0
  82. NOM1=' '
  83. *
  84. *
  85. * ****************************************************************
  86. * SIGNAL D'ENTREE DEJA SOUS LA FORME D'UN COUPLE LISTCHPO/LISTREEL
  87. * ****************************************************************
  88. IF (ITYPO1.EQ.0.OR.ITYPO1.EQ.1) THEN
  89. CALL LIROBJ('LISTCHPO',ILCHP1,ICODE2,IRET)
  90. IF (IRET.EQ.0) GOTO 1
  91. MLCHPO=ILCHP1
  92. SEGACT,MLCHPO
  93. NCH=ICHPOI(/1)
  94. ITYPE1=1
  95. *
  96. * (+ recuperation de la liste temporelle)
  97. IF (ITEMP1.GT.0) THEN
  98. * Le LISTREEL doit etre juste derriere le LISTCHPO (car on
  99. * pourrait aussi en trouver un autre plus loin) => test QUETYP
  100. CALL QUETYP(CHA8,0,IRET)
  101. IF (IRET.EQ.0.OR.CHA8.NE.'LISTREEL') THEN
  102. MOTERR(1:8)='LISTREEL'
  103. CALL ERREUR(37)
  104. RETURN
  105. ENDIF
  106. CALL LIROBJ('LISTREEL',ILREE1,1,IRET)
  107. MLREEL=ILREE1
  108. SEGACT,MLREEL
  109. IF (PROG(/1).NE.NCH) THEN
  110. CALL ERREUR(212)
  111. RETURN
  112. ENDIF
  113. NCH=ICHPOI(/1)
  114. ENDIF
  115. *
  116. GOTO 2
  117. ENDIF
  118. *
  119. *
  120. * ****************************************************************
  121. * SI C'EST UNE TABLE : ON RECHERCHE L'INDICE CONTENANT LA VARIABLE
  122. * DEMANDEE PAR L'UTILISATEUR (PAR DEFAUT LE
  123. * DEPLACEMENT EN MECA. SOLIDE, LA VITESSE EN
  124. * MECA. FLUIDE)
  125. * ****************************************************************
  126. 1 CONTINUE
  127. IF (ITYPO1.EQ.1) GOTO 3
  128. CALL LIROBJ('TABLE',ITAB1,0,IRET)
  129. IF (IRET.EQ.0) GOTO 3
  130. *
  131. * RECHERCHE DU SOUS-TYPE DE LA TABLE
  132. ITYP=0
  133. CHA8=' '
  134. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  135. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  136. IF (CHA8.EQ.'MOT') CALL PLACE(MTYP,NTYP,ITYP,CHB8)
  137. IF (ITYP.EQ.0) THEN
  138. MOTERR(1:8)='TABLE'
  139. CALL ERREUR(302)
  140. RETURN
  141. ENDIF
  142. *
  143. ITYPE1=ITYP+1
  144. IF (ITYPO1.GT.0.AND.ITYPE1.NE.ITYPO1) GOTO 3
  145. *
  146. * RECUPERATION EVENTUELLE DU NOM DE L'INDICE
  147. CALL QUETYP(CHA8,1,IRET)
  148. IF (IERR.NE.0) RETURN
  149. LNOM1=0
  150. IF (CHA8.EQ.'MOT') CALL LIRCHA(NOM1,1,LNOM1)
  151. *
  152. *
  153. * CAS D'UNE TABLE PASAPAS
  154. * =======================
  155. IF (ITYPE1.EQ.2) THEN
  156. IF (LNOM1.EQ.0) NOM1='DEPLACEMENTS'
  157. I0=1
  158. *
  159. CHA8=' '
  160. CALL ACCTAB(ITAB1,'MOT',0,0.D0,NOM1,.TRUE.,0,
  161. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  162. IF (CHA8.NE.'TABLE') GOTO 9
  163. MTABLE=ITAB2
  164. SEGACT,MTABLE
  165. NCH=MLOTAB
  166. *
  167. * (+ recuperation de la liste temporelle)
  168. IF (ITEMP1.GT.0) THEN
  169. CHA8=' '
  170. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'TEMPS',.TRUE.,0,
  171. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  172. IF (CHA8.NE.'TABLE') GOTO 9
  173. MTAB2=ITAB2
  174. SEGACT,MTAB2
  175. ENDIF
  176. *
  177. * CAS D'UNE TABLE DYNAMIC
  178. * =======================
  179. ELSEIF (ITYPE1.EQ.3) THEN
  180. IF (LNOM1.EQ.0) NOM1='DEPL'
  181. *
  182. CHA8=' '
  183. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'RESULTATS',.TRUE.,0,
  184. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  185. IF (CHA8.NE.'TABLE') GOTO 9
  186. MTABLE=ITAB2
  187. SEGACT,MTABLE
  188. NCH=MLOTAB
  189. *
  190. * (+ recuperation de la liste temporelle)
  191. IF (ITEMP1.GT.0) THEN
  192. CHA8=' '
  193. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'TEMPS_CALCULES',.TRUE.,0,
  194. & CHA8,IVAL,XVAL,CHB8,ZLOGI,IOBJ2)
  195. IF (CHA8.NE.'LISTREEL') GOTO 9
  196. MLREEL=IOBJ2
  197. SEGACT,MLREEL
  198. ENDIF
  199. *
  200. * CAS D'UNE TABLE EXEC
  201. * ====================
  202. ELSEIF (ITYPE1.EQ.4) THEN
  203. IF (LNOM1.EQ.0) NOM1='UN'
  204. *
  205. CHA8=' '
  206. CALL ACMO(ITAB1,'INCO',CHA8,ITAB2)
  207. IF (CHA8.NE.'TABLE') GOTO 9
  208. CHA8=' '
  209. CALL ACMO(ITAB2,'HIST',CHA8,ITAB3)
  210. IF (CHA8.NE.'TABLE') GOTO 9
  211. CHA8=' '
  212. CALL ACMO(ITAB3,NOM1,CHA8,ILCHP1)
  213. IF (CHA8.NE.'LISTCHPO') GOTO 9
  214. MLCHPO=ILCHP1
  215. SEGACT,MLCHPO
  216. NCH=ICHPOI(/1)
  217. *
  218. * (+ recuperation de la liste temporelle)
  219. IF (ITEMP1.GT.0) THEN
  220. CHA8=' '
  221. CALL ACCTAB(ITAB2,'MOT',0,0.D0,'TPS',.TRUE.,0,
  222. & CHA8,IVAL,XVAL,CHB8,ZLOGI,IOBJ2)
  223. IF (CHA8.NE.'LISTREEL') GOTO 9
  224. MLREEL=IOBJ2
  225. SEGACT,MLREEL
  226. ENDIF
  227. *
  228. ENDIF
  229. *
  230. GOTO 2
  231. *
  232. * ERREUR : LA TABLE N'A PAS LE FORMAT ATTENDU
  233. 9 CONTINUE
  234. CALL ERREUR(647)
  235. RETURN
  236. *
  237. *
  238. * *************************************************************
  239. * RECUPERATION EVENTUELLE D'UNE LISTE D'INDICES DE PAS DE TEMPS
  240. * *************************************************************
  241. 2 CONTINUE
  242. *
  243. * Le LISTENTI doit etre place precisement ici (car on pourrait
  244. * aussi en trouver un autre plus loin) => test QUETYP
  245. CALL QUETYP(CHA8,0,IRET)
  246. IZIDX=0
  247. IF (IRET.NE.0.AND.CHA8.EQ.'LISTENTI') THEN
  248. IZIDX=1
  249. CALL LIROBJ('LISTENTI',MLENT1,1,IRET)
  250. IF (IERR.NE.0) RETURN
  251. ENDIF
  252. *
  253. * PAR DEFAUT, ON RETIENT TOUS LES INSTANTS DISPONIBLES
  254. IF (IZIDX.EQ.0) THEN
  255. SEGINI,TIDX
  256. DO I=1,NCH
  257. IIDX(I)=I-I0
  258. ENDDO
  259. ELSE
  260. NCH1=NCH
  261. *
  262. SEGACT,MLENT1
  263. NCH=MLENT1.LECT(/1)
  264. SEGINI,TIDX
  265. *
  266. * VALIDATION DES VALEURS FOURNIES DANS MLENT1
  267. NCH=0
  268. DO I=1,MLENT1.LECT(/1)
  269. IVAL=MLENT1.LECT(I)
  270. IF (IVAL.GE.1.AND.IVAL.LE.NCH1) THEN
  271. NCH=NCH+1
  272. IIDX(NCH)=IVAL
  273. ENDIF
  274. ENDDO
  275. SEGDES,MLENT1
  276. *
  277. * TRI PAR ORDRE CROISSANT
  278. NTRA=NCH
  279. SEGINI,TRAV1
  280. CALL ORDM02(IIDX(1),NCH,ITRA(1),.TRUE.)
  281. SEGSUP,TRAV1
  282. *
  283. * SUPPRESSION DES DOUBLONS
  284. NDOUB=0
  285. DO I=2,NCH
  286. IF (IIDX(I-1).NE.IIDX(I)) THEN
  287. IF (NDOUB.GT.0) IIDX(I-NDOUB)=IIDX(I)
  288. ELSE
  289. NDOUB=NDOUB+1
  290. ENDIF
  291. ENDDO
  292. NCH=NCH-NDOUB
  293. SEGADJ,TIDX
  294. ENDIF
  295. *
  296. IF (NCH.EQ.0) THEN
  297. WRITE(IOIMP,*) 'Le signal fourni est vide'
  298. CALL ERREUR(21)
  299. RETURN
  300. ENDIF
  301. *
  302. *
  303. * ********************************************************
  304. * OBTENTION DES OBJETS LISTREEL ET LISTCHPO RESTREINTS AUX
  305. * INSTANTS DE IIDX
  306. * ********************************************************
  307. *
  308. * SYNTAXES 1 (LISTCHPO/LISTREEL) ET 4 (PROCEDURE "EXEC")
  309. * ======================================================
  310. IF (IZIDX.NE.0.AND.(ITYPE1.EQ.1.OR.ITYPE1.EQ.4)) THEN
  311. *
  312. MLCHP1=MLCHPO
  313. N1=NCH
  314. SEGINI,MLCHPO
  315. DO I=1,NCH
  316. ICHPOI(I)=MLCHP1.ICHPOI(IIDX(I))
  317. ENDDO
  318. SEGDES,MLCHP1
  319. *
  320. IF (ITEMP1.GT.0) THEN
  321. MLREE1=MLREEL
  322. JG=NCH
  323. SEGINI,MLREEL
  324. DO I=1,NCH
  325. PROG(I)=MLREE1.PROG(IIDX(I))
  326. ENDDO
  327. ENDIF
  328. SEGDES,MLREE1
  329. *
  330. * SYNTAXE 2 (PROCEDURE "PASAPAS")
  331. * ===============================
  332. ELSEIF (ITYPE1.EQ.2) THEN
  333. *
  334. N1=NCH
  335. SEGINI,MLCHPO
  336. DO I=1,NCH
  337. IDX1=IIDX(I)
  338. CALL ACCTAB(MTABLE,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0,
  339. & 'CHPOINT',IVAL,XVAL,CHA8,ZLOGI,ICHP1)
  340. IF (IERR.NE.0) RETURN
  341. ICHPOI(I)=ICHP1
  342. ENDDO
  343. SEGDES,MTABLE
  344. *
  345. IF (ITEMP1.GT.0) THEN
  346. JG=NCH
  347. SEGINI,MLREEL
  348. DO I=1,NCH
  349. IDX1=IIDX(I)
  350. CALL ACCTAB(MTAB2,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0,
  351. & 'FLOTTANT',IVAL,XT1,CHA8,ZLOGI,IP1)
  352. IF (IERR.NE.0) RETURN
  353. PROG(I)=XT1
  354. ENDDO
  355. SEGDES,MTAB2
  356. ENDIF
  357. *
  358. * SYNTAXE 3 (PROCEDURE "DYNAMIC")
  359. * ===============================
  360. ELSEIF (ITYPE1.EQ.3) THEN
  361. *
  362. N1=NCH
  363. SEGINI,MLCHPO
  364. DO I=1,NCH
  365. IDX1=IIDX(I)
  366. CALL ACCTAB(MTABLE,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0,
  367. & 'TABLE',IVAL,XVAL,CHA8,ZLOGI,ITAB1)
  368. IF (IERR.NE.0) RETURN
  369. CHA8='CHPOINT'
  370. CALL ACMO(ITAB1,NOM1,CHA8,ICHP1)
  371. IF (IERR.NE.0) RETURN
  372. ICHPOI(I)=ICHP1
  373. ENDDO
  374. SEGDES,MTABLE
  375. *
  376. IF (ITEMP1.GT.0.AND.IZIDX.NE.0) THEN
  377. MLREE1=MLREEL
  378. JG=NCH
  379. SEGINI,MLREEL
  380. DO I=1,NCH
  381. PROG(I)=MLREE1.PROG(IIDX(I))
  382. ENDDO
  383. SEGDES,MLREE1
  384. ENDIF
  385. *
  386. ENDIF
  387. *
  388. *
  389. SEGSUP,TIDX
  390. ILCHP1=MLCHPO
  391. IF (ITEMP1.GT.0) ILREE1=MLREEL
  392. *
  393. NCHPO1=NCH
  394. RETURN
  395. *
  396. *
  397. * *********************************
  398. * AUCUN OBJET COMPATIBLE N'A ETE LU
  399. * *********************************
  400. 3 CONTINUE
  401. *
  402. ILCHP1=0
  403. ITYPE1=0
  404. *
  405. IF (ICODE1.GT.0) THEN
  406. WRITE(IOIMP,*) 'Il manque un objet compatible pour definir ',
  407. & 'le signal d entree'
  408. CALL ERREUR(880)
  409. ENDIF
  410. *
  411. RETURN
  412. *
  413. END
  414. *
  415. *
  416.  

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