Télécharger lirres.eso

Retour à la liste

Numérotation des lignes :

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

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