Télécharger la plaquette Cast3M


fr en

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