Télécharger la plaquette Cast3M


fr en

Télécharger expil.eso

Retour à la liste

Numérotation des lignes : 

expil

  1. C EXPIL     SOURCE    GOUNAND   25/07/15    21:15:03     12323          
  2.  
  3. C----------------------------------------------------------------------
  4. C
  5. C  BUT:  REMPLIT LES PILES A PARTIR DE L EXAMEN DE LA PILE
  6. C        SI IIICHA =1 ON  CHANGE  LES POINTEURS----
  7. C
  8. C     ENTREE IFILE NUMERO DE LA PILE EXAMINEE
  9. C            ICOLAC POINTEUR SUR LE CHAPEAU DES PILES
  10. C            M1     PREMIER INDICE D EXAMEN DANS LA PILE
  11. C            M2     DERNIER INDICE
  12. C            IIICHA =1 ON CHANGE LES POINTEURS
  13. C-----------------------------------------------------------------------
  14. C   REMARQUE :  ICOLAC EST UN SEGMENT ACTIF EN ENTREE ET EN SORTIE
  15. C                      PAS DE CHANGEMENT DE STATUT AU COURS DU SP
  16. C-----------------------------------------------------------------------
  17. C   PROGRAMME PAR FARVACQUE- REPRIS PAR LENA
  18. C   APPELE PAR FILLPI
  19. C   APPELLE AJOUN  TYPFIL
  20. C=======================================================================
  21. C  TABLEAU KCOLA : VOIR LE SOUS-PROGRAMME TYPFIL
  22. C=======================================================================
  23.       SUBROUTINE EXPIL (IFILE,ICOLAC,M1,M2,IIICHA)
  24.  
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8(A-H,O-Z)
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCASSIS
  31. -INC CCNOYAU
  32.  
  33. -INC SMBLOC
  34. -INC SMBASEM
  35. -INC SMMATRI
  36. -INC SMCLSTR
  37. -INC SMELSTR
  38. -INC SMSOLUT
  39. -INC SMDEFOR
  40. -INC SMSTRUC
  41. -INC SMATTAC
  42. -INC SMCHARG
  43. -INC SMEVOLL
  44. -INC SMTABLE
  45. -INC SMSUPER
  46. -INC SMTEXTE
  47. -INC SMVECTE
  48. -INC SMLCHPO
  49. -INC SMINTE
  50. -INC SMNUAGE
  51. -INC SMANNOT
  52. -INC SMLOBJE
  53. -INC TMCOLAC
  54.  
  55. *INC SMELEME
  56. *INC SMCHPOI
  57. *INC SMMODEL
  58. *INC SMRIGID
  59.  
  60.       LOGICAL LOTEMP
  61.       SEGMENT ITRAVV(NITLAC)
  62.       CHARACTER*(8) ITYP1
  63.       CHARACTER*(1) CHAVAL
  64.       CHARACTER*(16) MOTYP
  65. C=======================================================================
  66. C  ICOLAC :  KCOLA : POINTEUR SUR LA PILE ITLACC
  67. C            MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  68. C            ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  69. C            KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A SORT
  70. C=======================================================================
  71.       IF (M1.GT.M2) RETURN
  72.       iimpi_z = iimpi
  73.       iun=1
  74.       icinq=5
  75.       IF (IIMPI.EQ.5) WRITE (IOIMP,8877) IFILE,M1,M2
  76.  8877 FORMAT (' EXAMEN DE LA PILE ',I5,'  DE',I5,'  A',I5)
  77.       SEGACT ICOLAC
  78.       ILISSE = icolac.ILISSP
  79.       SEGACT,ILISSE*MOD
  80.       ILISSE = icolac.ILISSF
  81.       SEGACT,ILISSE*MOD
  82.       ILISSE = icolac.ILISSG
  83.       SEGACT,ILISSE*MOD
  84.       ITLACC = KCOLA(IFILE)
  85.       GOTO (501,502,503,599,599,506,507,508,509,510,
  86.      1      599,512,599,514,515,516,517,599,599,520,
  87.      1      599,522,523,524,525,526,527,528,529,530,
  88.      1      531,532,533,534,535,536,537,538,539,540,
  89.      1      541,542,543,510,545,546,547,548,549,550,
  90.      &      551),IFILE
  91.       CALL TYPFIL(MOTERR,IFILE)
  92.       CALL ERREUR (336)
  93.       CALL GINT2
  94.       GO TO 599
  95.  
  96. C     ******************************* MELEME****************************
  97.  501  CONTINUE
  98.       CALL EXAMEL (ICOLAC,ITLACC,M1,M2,IIICHA)
  99.       GO TO 599
  100. C     **************************** MCHPOI ******************************
  101.  502  CONTINUE
  102.       CALL EXACHP (ICOLAC,ITLACC,M1,M2,IIICHA)
  103.       GO TO 599
  104. C     **************************** MRIGID ******************************
  105.  503  CONTINUE
  106.       CALL EXARIG (ICOLAC,ITLACC,M1,M2,IIICHA)
  107.       GO TO 599
  108. C     ***************************        *******************************
  109.  504  CONTINUE
  110.       GO TO 599
  111. C     ***************************        *******************************
  112.  505  CONTINUE
  113.       GO TO 599
  114. C     **************************** MCLSTR ******************************
  115.  506  CONTINUE
  116.       ICO1=KCOLA(12)
  117.       ICO2=KCOLA(3)
  118.       DO 614 IEL=M1,M2
  119.          MCLSTR=ITLAC(IEL)
  120.          IF (MCLSTR.EQ.0) GO TO 614
  121.          SEGACT MCLSTR*MOD
  122.          DO 615 I=1,ISOSTR(/1)
  123.             IVA=ISOSTR(I)
  124.             IF(IVA.NE.0)CALL AJOUN(ICO1,IVA,ILISSE,iun)
  125.             IF(IIICHA.EQ.1)ISOSTR(I)=IVA
  126.             IVA=IRIGCL(I)
  127.             IF (IVA.NE.0)CALL AJOUN(ICO2,IVA,ILISSE,iun)
  128.             IF(IIICHA.EQ.1)IRIGCL(I)=IVA
  129.  615     CONTINUE
  130.          SEGDES MCLSTR
  131.  614  CONTINUE
  132.       GO TO 599
  133. C     **************************** MELSTR ******************************
  134.  507  CONTINUE
  135.       ICO1=KCOLA(12)
  136.       ICO2=KCOLA(1)
  137.       DO 616 IEL=M1,M2
  138.          MELSTR=ITLAC(IEL)
  139.          IF (MELSTR.EQ.0) GO TO 616
  140.          SEGACT MELSTR*MOD
  141.          DO 617 I=1,ISOSTU(/1)
  142.             IVA=ISOSTU(I)
  143.             IF(IVA.NE.0)CALL AJOUN(ICO1,IVA,ILISSE,iun)
  144.             IF(IIICHA.EQ.1)ISOSTU(I)=IVA
  145.             IVA=IMELEM(I)
  146.             IF (IVA.NE.0)CALL AJOUN(ICO2,IVA,ILISSE,iun)
  147.             IF(IIICHA.EQ.1)IMELEM(I)=IVA
  148.  617     CONTINUE
  149.          SEGDES MELSTR
  150.  616  CONTINUE
  151.       GO TO 599
  152. C     *************************** MSOLUT *******************************
  153.  508  CONTINUE
  154.       ICO1=KCOLA(1)
  155.       DO 618 IEL=M1,M2
  156.          MSOLUT=ITLAC(IEL)
  157.          IF (MSOLUT.EQ.0) GO TO 618
  158.          SEGACT MSOLUT*MOD
  159.          NIPO=MSOLIS(/1)
  160.          DO 620 II=1,NIPO
  161.             IF(MSOLIS(II).EQ.0) GOTO 620
  162.             IF(II.EQ.3) THEN
  163.                IVA=MSOLIS(3)
  164.                CALL AJOUN(ICO1,IVA,ILISSE,iun)
  165. CCC   IF (IONIVE.LT.3) GO TO 620
  166.                IF(IIICHA.EQ.1) MSOLIS(3)=IVA
  167.                GOTO 620
  168.             ENDIF
  169.             IF(II.LE.4) GOTO 620
  170.             ICO2=KCOLA(MSOLIT(II))
  171.             MSOLEN=MSOLIS(II)
  172.             SEGACT MSOLEN*MOD
  173.             LTAB=ISOLEN(/1)
  174.             DO 619 I=1,LTAB
  175.                IVA=ISOLEN(I)
  176.                IF(IVA.EQ.0)GOTO 619
  177.                CALL AJOUN(ICO2,IVA,ILISSE,iun)
  178.                IF (IONIVE.LT.3) GO TO 619
  179.                IF(IIICHA.EQ.1) ISOLEN(I)=IVA
  180.  619        CONTINUE
  181.             SEGDES MSOLEN
  182.  620     CONTINUE
  183.          SEGDES MSOLUT
  184.  618  CONTINUE
  185.       GOTO 599
  186. C     ************************** MSTRUC ********************************
  187.  509  CONTINUE
  188.       ICO1=KCOLA(12)
  189.       DO 621 IEL=M1,M2
  190.          MSTRUC=ITLAC(IEL)
  191.          IF (MSTRUC.EQ.0) GO TO 621
  192.          SEGACT MSTRUC*MOD
  193.          DO 622 I=1,LISTRU(/1)
  194.             IVA=LISTRU(I)
  195.             IF(IVA.EQ.0) GO TO 622
  196.             IF(IVA.GT.0) THEN
  197.                CALL AJOUN(ICO1,IVA,ILISSE,iun)
  198.                IF(IIICHA.EQ.1) LISTRU(I)=-IVA
  199.             ENDIF
  200.  622     CONTINUE
  201.          SEGDES MSTRUC
  202.  621  CONTINUE
  203.       GOTO 599
  204. C     ******************************* MTABLE **************************
  205. *  POUR LES TABLES ON COMMENCE PAR METTRE DANS LA PILE DES REELS
  206. *  LES VALEURS REELLES ON ON PREND LEUR INDICE
  207. *  CECI NOUS PERMET D'ETRE COMPATIBLE AVEC LES VERSIONS ANTERIEURES
  208. *  PV  28 DECEMBRE 1988
  209. *  a partir du niveau 21 on n'utilise plus la pile d'entiers. On les sauve directement
  210. *
  211.  510  CONTINUE
  212.       DO 710 IEL=M1,M2
  213.  
  214.          MTABLE=ITLAC(IEL)
  215.          IF (MTABLE.EQ.0) GO TO 710
  216.          SEGACT MTABLE*MOD
  217.          L6=MLOTAB
  218.          IF (L6.EQ.0) GO TO 713
  219.          DO 711 K=1,L6
  220.             ITYP1=MTABTI(K)
  221.             IF (IIICHA.NE.1.AND.ITYP1.EQ.'FLOTTANT') THEN
  222.                XVA=RMTABI(K)
  223.                CALL QUERAN(IVA,'FLOTTANT',0,XVA,' ',.TRUE.,0)
  224.                MTABII(K)=IVA
  225.             ENDIF
  226.             IVA=MTABII(K)
  227.             J=0
  228.             CALL TYPFIL(ITYP1,J)
  229.             IF (J.LE.0) GO TO 711
  230.             ICO2=KCOLA(J)
  231.             NUMLIS=1
  232.             ilissd=ilissg
  233.             IF(J.EQ.24) NUMLIS=6
  234.             IF(J.EQ.25) then
  235.               NUMLIS=3
  236.               ilissd=ilissf
  237.             ENDIF
  238.             IF(J.EQ.26) then
  239.               if (ionive.le.20) then
  240.                 NUMLIS=2
  241.               else
  242.                 goto 716
  243.               endif
  244.             ENDIF
  245.             IF(J.EQ.27) NUMLIS=5
  246.             IF(J.EQ.32) then
  247.               NUMLIS=3
  248.               ilissd=ilissp
  249.             endif
  250.             IF(J.EQ.36) NUMLIS=7
  251.             IF(J.EQ.45) NUMLIS=5
  252.             CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  253.             IF(IIICHA.EQ.1) MTABII(K)=IVA
  254.  716        CONTINUE
  255.             ITYP1=MTABTV(K)
  256.             IF (IIICHA.NE.1.AND.ITYP1.EQ.'FLOTTANT') THEN
  257.                XVA=RMTABV(K)
  258.                CALL QUERAN(IVA,'FLOTTANT',0,XVA,' ',.TRUE.,0)
  259.                MTABIV(K)=IVA
  260.             ENDIF
  261.             IVA=MTABIV(K)
  262.             CALL  TYPFIL (ITYP1,J)
  263.             IF(J.LE.0) GO TO 711
  264.             IF (J.EQ.47) GO TO 711
  265.             ICO2=KCOLA(J)
  266.             NUMLIS=1
  267.             ilissd=ilissg
  268.             IF(J.EQ.24) NUMLIS=6
  269.             IF(J.EQ.25) then
  270.               NUMLIS=3
  271.               ilissd=ilissf
  272.             ENDIF
  273.             IF(J.EQ.26) then
  274.               if (ionive.le.20) then
  275.                 NUMLIS=2
  276.               else
  277.                 goto 711
  278.               endif
  279.             ENDIF
  280.             IF(J.EQ.27) NUMLIS=5
  281.             IF(J.EQ.32) then
  282.               NUMLIS=3
  283.               ilissd=ilissp
  284.             endif
  285.             IF(J.EQ.36) NUMLIS=7
  286.             IF(J.EQ.45) NUMLIS=5
  287.             CALL AJOUN (ICO2,IVA,ILISSD,NUMLIS)
  288.             IF(IIICHA.EQ.1) MTABIV(K)=IVA
  289.  711     CONTINUE
  290.  713     SEGDES MTABLE
  291.  710  CONTINUE
  292.       GO TO 599
  293.  715  CONTINUE
  294.       MOTERR(1:8)=ITYP1
  295.       CALL ERREUR (336)
  296.       GO TO 599
  297. C     *******************************        *************************
  298.  511  CONTINUE
  299.       GO TO 599
  300. C     ******************************** MSOSTU **************************
  301.  512  CONTINUE
  302.       ICO5=KCOLA(5)
  303.       ICO3=KCOLA(3)
  304.       DO 630 IEL=M1,M2
  305.          MSOSTU=ITLAC(IEL)
  306.          IF (MSOSTU.EQ.0) GO TO 630
  307.          SEGACT MSOSTU*MOD
  308.          IVA=ISRAID
  309.          IF (IVA.NE.0)CALL AJOUN(ICO3,IVA,ILISSE,iun)
  310.          IF(IIICHA.EQ.1)ISRAID=IVA
  311.          IVA=ISMASS
  312.          IF (IVA.NE.0)CALL AJOUN(ICO3,IVA,ILISSE,iun)
  313.          IF(IIICHA.EQ.1)ISMASS=IVA
  314.          NS=ISCHAM(/1)
  315.          IF (NS.EQ.0) GO TO   122
  316.          DO 121 I=1,NS
  317.             IVA= ISCHAM(I)
  318.             IF (IVA.NE.0)CALL AJOUN (ICO5,IVA,ILISSE,iun)
  319.             IF(IIICHA.EQ.1) ISCHAM(I)=IVA
  320.  121     CONTINUE
  321.  122     SEGDES MSOSTU
  322.  630  CONTINUE
  323.       GO TO 599
  324. C     ***************************** IMATRI *****************************
  325.  513  CONTINUE
  326.       GO TO 599
  327. C     ***************************** MJONCT *****************************
  328.  514  CONTINUE
  329.       ICO1=KCOLA(1)
  330.       ICO12=KCOLA(12)
  331.       ICO2=KCOLA(2)
  332.       DO 631 IEL=M1,M2
  333.          MJONCT=ITLAC(IEL)
  334.          IF (MJONCT.EQ.0) GO TO 631
  335.          SEGACT MJONCT*MOD
  336.          IVA=MJOPOI
  337.          IF(MJOTYP.EQ.'CHOC')THEN
  338.             IF(IVA.NE.0) CALL AJOUN(ICO2,IVA,ILISSE,iun)
  339.          ELSE
  340.             IF(IVA.NE.0) CALL AJOUN(ICO1,IVA,ILISSE,iun)
  341.          ENDIF
  342. CCC   CALL AJOUN(ICO1,IVA)
  343.          IF(IIICHA.EQ.1)MJOPOI=IVA
  344.          DO 632 I=1,ISTRJO(/1)
  345.             IVA=ISTRJO(I)
  346.             IF (IVA.NE.0)CALL AJOUN(ICO12,IVA,ILISSE,iun)
  347.             IF(IIICHA.EQ.1)ISTRJO(I)=IVA
  348.             IVA=IPCHJO(I)
  349.             IF (IVA.NE.0)CALL AJOUN(ICO2,IVA,ILISSE,iun)
  350.             IF(IIICHA.EQ.1)IPCHJO(I)=IVA
  351.             IVA=IPOSJO(I)
  352.             IF (IVA.NE.0) CALL AJOUN(ICO1,IVA,ILISSE,iun)
  353.             IF(IIICHA.EQ.1)IPOSJO(I)=IVA
  354.  632     CONTINUE
  355.          SEGDES MJONCT
  356.  631  CONTINUE
  357.       GO TO 599
  358. C     ************************ MATTAC **********************************
  359.  515  CONTINUE
  360.       ICO1=KCOLA(1)
  361.       ICO3=KCOLA(3)
  362.       ICO14=KCOLA(14)
  363.       DO 150 IEL=M1,M2
  364.          MATTAC =ITLAC(IEL)
  365.          IF (MATTAC.EQ.0) GO TO 150
  366.          SEGACT MATTAC*MOD
  367.          NN=LISATT(/1)
  368.          DO 151 I=1,NN
  369.             MSOUMA=LISATT(I)
  370.             IF (MSOUMA.EQ.0) GO TO 151
  371.             SEGACT MSOUMA*MOD
  372.             M=IPMATK(/1)
  373.             DO 152 J=1,M
  374.                IVA=IPMATK(J)
  375.                IF (IVA.NE.0)CALL AJOUN (ICO3,IVA,ILISSE,iun)
  376.                IF(IIICHA.EQ.1) IPMATK(J)=IVA
  377.  152        CONTINUE
  378.             N=IATREL(/1)
  379.             DO 153 J=1,N
  380.                IVA=IATREL(J)
  381.                IF (IVA.NE.0)CALL AJOUN (ICO14,IVA,ILISSE,iun)
  382.                IF(IIICHA.EQ.1) IATREL(J)=IVA
  383.  153        CONTINUE
  384.             IF(IGEOCH.EQ.0) GO TO 156
  385.             MGEOCH=IGEOCH
  386.             SEGACT MGEOCH*MOD
  387.             NI=INORCH(/1)
  388.             DO 154 J=1,NI
  389.                IVA=INORCH(J)
  390.                IF (IVA.NE.0)CALL AJOUN (ICO1 ,IVA,ILISSE,iun)
  391.                IF(IIICHA.EQ.1) INORCH(J)=IVA
  392.  154        CONTINUE
  393.             N1=IMAPRO(/1)
  394.             DO 155 J=1,N1
  395.                IVA=IMAPRO(J)
  396.                IF (IVA.NE.0)CALL AJOUN (ICO1 ,IVA,ILISSE,iun)
  397.                IF(IIICHA.EQ.1) IMAPRO(J)=IVA
  398.  155        CONTINUE
  399.             SEGDES MGEOCH
  400.  156        CONTINUE
  401.             SEGDES MSOUMA
  402.  151     CONTINUE
  403.          SEGDES MATTAC
  404.  150  CONTINUE
  405.       GO TO 599
  406. C     ************************ MMATRI **********************************
  407.  516  CONTINUE
  408.       ICO1=KCOLA(1)
  409.       DO 633 IEL=M1,M2
  410.          MMATRI=ITLAC(IEL)
  411.          IF (MMATRI.EQ.0) GO TO 633
  412.          SEGACT MMATRI*MOD
  413.          IVA=IGEOMA
  414.          if (igeoma.eq.0) goto 633
  415.          CALL AJOUN(ICO1,IVA,ILISSE,iun)
  416.          IF(IIICHA.EQ.1)IGEOMA=IVA
  417.          SEGDES MMATRI
  418.  633  CONTINUE
  419.       GOTO 599
  420. C     *************************MDEFOR***********************************
  421.  517  CONTINUE
  422.       ICO1=KCOLA(1)
  423.       ICO2=KCOLA(2)
  424.       ICO30=KCOLA(30)
  425.       ICO38=KCOLA(38)
  426.       ICO39=KCOLA(39)
  427.       DO 634 IEL=M1,M2
  428.          MDEFOR=ITLAC(IEL)
  429.          IF (MDEFOR.EQ.0) GO TO 634
  430.          SEGACT MDEFOR*MOD
  431.          NDEF=IELDEF(/1)
  432.          DO 635 I=1,NDEF
  433.             IVA=IELDEF(I)
  434.             CALL AJOUN(ICO1,IVA,ILISSE,iun)
  435.             IF(IIICHA.EQ.1)IELDEF(I)=IVA
  436.             IVA=ICHDEF(I)
  437.             CALL AJOUN(ICO2,IVA,ILISSE,iun)
  438.             IF(IIICHA.EQ.1)ICHDEF(I)=IVA
  439.             IVA=MTVECT(I)
  440.             IF (IVA.NE.0) THEN
  441.                CALL AJOUN(ICO30,IVA,ILISSE,iun)
  442.                IF(IIICHA.EQ.1)MTVECT(I)=IVA
  443.             ENDIF
  444.             IVA=MDCHP(I)
  445.             IF (IVA.NE.0) THEN
  446.                CALL AJOUN(ICO2,IVA,ILISSE,iun)
  447.                IF(IIICHA.EQ.1)MDCHP(I)=IVA
  448.             ENDIF
  449.             IVA=MDCHEL(I)
  450.             IF (IVA.NE.0) THEN
  451.                CALL AJOUN(ICO39,IVA,ILISSE,iun)
  452.                IF(IIICHA.EQ.1)MDCHEL(I)=IVA
  453.             ENDIF
  454.             IVA=MDMODE(I)
  455.             IF (IVA.NE.0) THEN
  456.                CALL AJOUN(ICO38,IVA,ILISSE,iun)
  457.                IF(IIICHA.EQ.1)MDMODE(I)=IVA
  458.             ENDIF
  459.  635     CONTINUE
  460.          SEGDES MDEFOR
  461.  634  CONTINUE
  462.       GOTO 599
  463. C     ****************************MLREEL*******************************
  464.  518  CONTINUE
  465.       GOTO 599
  466. C     ****************************MLENTI******************************
  467.  519  CONTINUE
  468.       GOTO 599
  469. C     ****************************MCHARG*****************************
  470.  520  CONTINUE
  471.       ICO1=KCOLA(2)
  472.       ICO2=KCOLA(18)
  473.       ICO3=KCOLA(39)
  474.       ICO4=KCOLA(10)
  475.       ICO5=KCOLA(1)
  476.       ICO6=KCOLA(50)
  477.       DO 650 IEL=M1,M2
  478.          MCHARG=ITLAC(IEL)
  479.          IF (MCHARG.EQ.0) GO TO 650
  480.          SEGACT MCHARG
  481.          DO 651 I=1,KCHARG(/1)
  482.             ICHARG=KCHARG(I)
  483.             SEGACT ICHARG*MOD
  484.             IF(CHATYP.EQ.'CHPOINT ') THEN
  485.                IVA=ICHPO1
  486.                IF(IVA.GT.0) THEN
  487.                   CALL AJOUN(ICO1,IVA,ILISSE,iun)
  488.                   IF(IIICHA.EQ.1) ICHPO1=-IVA
  489.                ENDIF
  490.                IVA=ICHPO2
  491.                IF(IVA.GT.0) THEN
  492.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  493.                   IF(IIICHA.EQ.1) ICHPO2=-IVA
  494.                ENDIF
  495.                IVA=ICHPO3
  496.                IF(IVA.GT.0) THEN
  497.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  498.                   IF(IIICHA.EQ.1) ICHPO3=-IVA
  499.                ENDIF
  500.             ELSEIF(CHATYP.EQ.'MCHAML  ') THEN
  501.                IVA=ICHPO1
  502.                IF(IVA.GT.0) THEN
  503.                   CALL AJOUN(ICO3,IVA,ILISSE,iun)
  504.                   IF(IIICHA.EQ.1) ICHPO1=-IVA
  505.                ENDIF
  506.                IVA=ICHPO2
  507.                IF(IVA.GT.0) THEN
  508.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  509.                   IF(IIICHA.EQ.1) ICHPO2=-IVA
  510.                ENDIF
  511.                IVA=ICHPO3
  512.                IF(IVA.GT.0) THEN
  513.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  514.                   IF(IIICHA.EQ.1) ICHPO3=-IVA
  515.                ENDIF
  516.             ELSEIF(CHATYP.EQ.'TABLE   ') THEN
  517.                IVA=ICHPO1
  518.                IF(IVA.GT.0) THEN
  519.                   CALL AJOUN(ICO4,IVA,ILISSE,iun)
  520.                   IF(IIICHA.EQ.1) ICHPO1=-IVA
  521.                ENDIF
  522.                IVA=ICHPO2
  523.                IF(IVA.GT.0) THEN
  524.                   CALL AJOUN(ICO4,IVA,ILISSE,iun)
  525.                   IF(IIICHA.EQ.1) ICHPO2=-IVA
  526.                ENDIF
  527.             ELSEIF(CHATYP.EQ.'LISTOBJE') THEN
  528.                IVA=ICHPO1
  529.                IF(IVA.GT.0) THEN
  530.                   CALL AJOUN(ICO6,IVA,ILISSE,iun)
  531.                   IF(IIICHA.EQ.1) ICHPO1=-IVA
  532.                ENDIF
  533.                IVA=ICHPO2
  534.                IF(IVA.GT.0) THEN
  535.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  536.                   IF(IIICHA.EQ.1) ICHPO2=-IVA
  537.                ENDIF
  538.             ENDIF
  539.             IF(CHAMOB(I).EQ.'TRAN') THEN
  540.                IVA=ICHPO4
  541.                IF(IVA.GT.0) THEN
  542.                   CALL AJOUN(ICO5,IVA,ILISSE,iun)
  543.                   IF(IIICHA.EQ.1) ICHPO4=-IVA
  544.                ENDIF
  545.                IVA=ICHPO6
  546.                IF(IVA.GT.0) THEN
  547.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  548.                   IF(IIICHA.EQ.1) ICHPO6=-IVA
  549.                ENDIF
  550.                IVA=ICHPO7
  551.                IF(IVA.GT.0) THEN
  552.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  553.                   IF(IIICHA.EQ.1) ICHPO7=-IVA
  554.                ENDIF
  555.             ELSEIF(CHAMOB(I).EQ.'ROTA') THEN
  556.                IVA=ICHPO4
  557.                IF(IVA.GT.0) THEN
  558.                   CALL AJOUN(ICO5,IVA,ILISSE,iun)
  559.                   IF(IIICHA.EQ.1) ICHPO4=-IVA
  560.                ENDIF
  561.                IVA=ICHPO5
  562.                IF(IVA.GT.0.AND.IDIM.GT.2) THEN
  563.                   CALL AJOUN(ICO5,IVA,ILISSE,iun)
  564.                   IF(IIICHA.EQ.1) ICHPO5=-IVA
  565.                ENDIF
  566.                IVA=ICHPO6
  567.                IF(IVA.GT.0) THEN
  568.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  569.                   IF(IIICHA.EQ.1) ICHPO6=-IVA
  570.                ENDIF
  571.                IVA=ICHPO7
  572.                IF(IVA.GT.0) THEN
  573.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  574.                   IF(IIICHA.EQ.1) ICHPO7=-IVA
  575.                ENDIF
  576.             ELSEIF(CHAMOB(I).EQ.'TRAJ') THEN
  577.                IVA=ICHPO4
  578.                IF(IVA.GT.0) THEN
  579.                   CALL AJOUN(ICO1,IVA,ILISSE,iun)
  580.                   IF(IIICHA.EQ.1) ICHPO4=-IVA
  581.                ENDIF
  582.                IVA=ICHPO5
  583.                IF(IVA.GT.0) THEN
  584.                   CALL AJOUN(ICO5,IVA,ILISSE,iun)
  585.                   IF(IIICHA.EQ.1) ICHPO5=-IVA
  586.                ENDIF
  587.                IVA=ICHPO6
  588.                IF(IVA.GT.0) THEN
  589.                   CALL AJOUN(ICO2,IVA,ILISSE,iun)
  590.                   IF(IIICHA.EQ.1) ICHPO6=-IVA
  591.                ENDIF
  592.             ENDIF
  593.             SEGDES ICHARG
  594.  651     CONTINUE
  595.          SEGDES MCHARG
  596.  650  CONTINUE
  597.       GOTO 599
  598. C     ***************************        *****************************
  599.  521  CONTINUE
  600.       GOTO 599
  601. C     ****************************MEVOLL******************************
  602.  522  CONTINUE
  603.       ICOR=KCOLA(18)
  604.       ICOE=KCOLA(19)
  605.       ICOM=KCOLA(29)
  606.       DO 660 IEL=M1,M2
  607.          MEVOLL=ITLAC(IEL)
  608.          IF (MEVOLL.EQ.0) GO TO 660
  609.          SEGACT MEVOLL
  610.          DO 661 I=1,IEVOLL(/1)
  611.             KEVOLL=IEVOLL(I)
  612.             SEGACT KEVOLL*MOD
  613.             IVA=IPROGX
  614.             IF(IONIVE.GE.3) THEN
  615.                IF(TYPX.EQ.'LISTMOTS') THEN
  616.                   ICO2=ICOM
  617.                ELSEIF(TYPX.EQ.'LISTREEL')THEN
  618.                   ICO2=ICOR
  619.                ELSEIF(TYPX.EQ.'LISTENTI')THEN
  620.                   ICO2=ICOE
  621.                ELSE
  622.                   WRITE(IOIMP,*) 'TYPX=',TYPX,' ???'
  623.                   MOTERR(1:8)='expil'
  624.                   CALL ERREUR(1039)
  625.                ENDIF
  626.             ELSE
  627.                ICO2=ICOR
  628.             ENDIF
  629.             IF(IVA.GT.0) THEN
  630.                CALL AJOUN(ICO2,IVA,ILISSE,iun)
  631.                IF(IIICHA.EQ.1) IPROGX=-IVA
  632.             ENDIF
  633.             IVA=IPROGY
  634.             IF(IONIVE.GE.3) THEN
  635.                IF(TYPY.EQ.'LISTMOTS') THEN
  636.                   ICO2=ICOM
  637.                ELSEIF(TYPY.EQ.'LISTREEL')THEN
  638.                   ICO2=ICOR
  639.                ELSEIF(TYPY.EQ.'LISTENTI')THEN
  640.                   ICO2=ICOE
  641.                ELSE
  642.                   WRITE(IOIMP,*) 'TYPY=',TYPY,' ???'
  643.                   MOTERR(1:8)='expil'
  644.                   CALL ERREUR(1039)
  645.                ENDIF
  646.             ELSE
  647.                ICO2=ICOR
  648.             ENDIF
  649.             IF(IVA.GT.0) THEN
  650.                CALL AJOUN(ICO2,IVA,ILISSE,iun)
  651.                IF(IIICHA.EQ.1) IPROGY=-IVA
  652.             ENDIF
  653.             SEGDES KEVOLL
  654.  661     CONTINUE
  655.          SEGDES MEVOLL
  656.  660  CONTINUE
  657.       GOTO 599
  658. C     **********************SUPERELE************************************
  659.  523  CONTINUE
  660.       ICO1=KCOLA(1)
  661.       ICO3=KCOLA(3)
  662.       ICO2=KCOLA( 2)
  663.       ICO16=KCOLA(16)
  664.       DO 5230 IEL=M1,M2
  665.          MSUPER=ITLAC(IEL)
  666.          IF (MSUPER.EQ.0) GO TO 5230
  667.          SEGACT MSUPER*MOD
  668.          IVA=MRIGTO
  669.          CALL AJOUN(ICO3,IVA,ILISSE,iun)
  670.          IF(IIICHA.EQ.1)MRIGTO=IVA
  671.          IVA=MSUPEL
  672.          CALL AJOUN(ICO1,IVA,ILISSE,iun)
  673.          IF(IIICHA.EQ.1)MSUPEL=IVA
  674.          IVA=MSURAI
  675.          CALL AJOUN(ICO3,IVA,ILISSE,iun)
  676.          IF(IIICHA.EQ.1)MSURAI=IVA
  677.          IVA=MSUMAS
  678.          IF(IVA.NE.0) CALL AJOUN(ICO3,IVA,ILISSE,iun)
  679.          IF(IIICHA.EQ.1)MSUMAS=IVA
  680.          IVA=MCROUT
  681.          if (mcrout.ne.0) then
  682.            CALL AJOUN(ICO16,IVA,ILISSE,iun)
  683.            IF(IIICHA.EQ.1)MCROUT=IVA
  684.          endif
  685. c      NBINMA=MSUPCH(/1)
  686. c      DO 5231 I=1,NBINMA
  687. c      IVA=MSUPCH(I)
  688. c      CALL AJOUN(ICO2,IVA)
  689. c                            IF(IIICHA.EQ.1)MSUPCH(I)=IVA
  690. c 5231 CONTINUE
  691.          SEGDES MSUPER
  692.  5230 CONTINUE
  693.       GOTO 599
  694. C     **********************LOGIQUE***********************************
  695.  524  CONTINUE
  696.       GOTO 599
  697. C     **********************FLOTTANT**********************************
  698.  525  CONTINUE
  699.       GOTO 599
  700. C     ********************** ENTIER **********************************
  701.  526  CONTINUE
  702.       GOTO 599
  703. C     ********************** MOT   ***********************************
  704.  527  CONTINUE
  705.       GOTO 599
  706. C     ********************** TEXTE ***********************************
  707.  528  CONTINUE
  708.       GOTO 599
  709. C     ********************** LISTMOTS*********************************
  710.  529  CONTINUE
  711.       GOTO 599
  712. C     ********************** VECTEUR**********************************
  713.  530  CONTINUE
  714.       ICO1=KCOLA(1)
  715.       ICO2=KCOLA( 2)
  716.       DO 5300 IEL=M1,M2
  717.          MVECTE=ITLAC(IEL)
  718.          IF (MVECTE.EQ.0) GO TO 5300
  719.          SEGACT MVECTE*MOD
  720.          NVEC=ICHPO(/1)
  721.          DO 5301 I=1,NVEC
  722. *  CE POINTEUR N'EST PAS ACTUELLEMENT REMPLI
  723. *     IVA=IGEOV(I)
  724. *     CALL AJOUN(ICO1,IVA)
  725. *                           IF(IIICHA.EQ.1)IGEOV(I)=IVA
  726.             IVA=ICHPO(I)
  727.             CALL AJOUN(ICO2,IVA,ILISSE,iun)
  728.             IF(IIICHA.EQ.1)ICHPO(I)=IVA
  729.  5301    CONTINUE
  730.          SEGDES MVECTE
  731.  5300 CONTINUE
  732.       GOTO 599
  733. C     ********************** VECTDOUB*********************************
  734.  531  CONTINUE
  735.       GOTO 599
  736. C     ********************** POINT   *********************************
  737.  532  CONTINUE
  738.       GOTO 599
  739. C     ********************** CONFIG  *********************************
  740.  533  CONTINUE
  741.       GOTO 599
  742. C     *********************** LISTCHPO ******************************
  743.  534  CONTINUE
  744.       ICO2=KCOLA(2)
  745.       DO 340 IEL=M1,M2
  746.          MLCHPO =ITLAC(IEL)
  747.          IF (MLCHPO.EQ.0) GO TO 340
  748.          SEGACT MLCHPO*MOD
  749.          N1=ICHPOI(/1)
  750.          DO 341 I=1,N1
  751.             IVA=ICHPOI(I)
  752.             CALL AJOUN(ICO2,IVA,ILISSE,iun)
  753.             IF(IIICHA.EQ.1)ICHPOI(I)=IVA
  754.  341     CONTINUE
  755.          SEGDES MLCHPO
  756.  340  CONTINUE
  757.       GO TO 599
  758. C     ************************** BASEM ********************************
  759.  535  CONTINUE
  760.       ICO12=KCOLA(12)
  761.       ICO8=KCOLA(8 )
  762.       ICO15=KCOLA(15)
  763.       DO 350 IEL=M1,M2
  764.          MBASEM=ITLAC(IEL)
  765.          IF (MBASEM.EQ.0) GO TO 350
  766.          SEGACT MBASEM
  767.          DO 351 I=1,LISBAS(/1)
  768.             MSOBAS=LISBAS(I)
  769.             SEGACT MSOBAS*MOD
  770.             IVA=IBSTRM(1)
  771.             IF(IVA.GT.0) THEN
  772.                CALL AJOUN(ICO12,IVA,ILISSE,iun)
  773.                IF(IIICHA.EQ.1) IBSTRM(1)=-IVA
  774.             ENDIF
  775.             IVA=IBSTRM(2)
  776.             IF(IVA.GT.0) THEN
  777.                CALL AJOUN(ICO8,IVA,ILISSE,iun)
  778.                IF(IIICHA.EQ.1) IBSTRM(2)=-IVA
  779.             ENDIF
  780.             IVA=IBSTRM(3)
  781.             IF (IVA.EQ.0) GOTO 352
  782.             IF(IVA.GT.0) THEN
  783.                CALL AJOUN(ICO8,IVA,ILISSE,iun)
  784.                IF(IIICHA.EQ.1) IBSTRM(3)=-IVA
  785.             ENDIF
  786.  352        CONTINUE
  787.             IVA=IBSTRM(4)
  788.             IF (IVA.EQ.0) GOTO 353
  789.             IF(IVA.GT.0) THEN
  790.                CALL AJOUN(ICO15,IVA,ILISSE,iun)
  791.                IF(IIICHA.EQ.1) IBSTRM(4)=-IVA
  792.             ENDIF
  793.  353        CONTINUE
  794.             IVA=IBSTRM(5)
  795.             IF (IVA.EQ.0) GOTO 354
  796.             IF(IVA.GT.0) THEN
  797.                CALL AJOUN(ICO8,IVA,ILISSE,iun)
  798.                IF(IIICHA.EQ.1) IBSTRM(5)=-IVA
  799.             ENDIF
  800.  354        CONTINUE
  801.             SEGDES MSOBAS
  802.  351     CONTINUE
  803.          SEGDES MBASEM
  804.  350  CONTINUE
  805.       GOTO 599
  806. C ************************* PROCEDURE ****************************
  807. *  On ajoute les objets en cours de retour (entre respro et finpro)
  808. *  on va les chercher dans les segments de resultats du  bloc
  809. *  sous jacent a la procedure
  810. *
  811.  536  CONTINUE
  812. **    write(6,*) ' exploration bloc ',m1,m2
  813.        MTTRY=MTXBL
  814.       ITLACC=KCOLA(36)
  815.       ITLAC1=KCOLA(37)
  816.        IF (ITLAC(/1).EQ.0) GOTO 599
  817.       DO 5270 IEL=M1,M2
  818.         MBLA1=ITLAC(IEL)
  819.         MBLO1=IPIPR1(MBLA1)
  820.          IF (MBLO1.LE.0) GO TO 5270
  821. **       write(6,*) ' bloc dans procedur ',mblo1
  822.          SEGACT MBLO1
  823.  5270 CONTINUE
  824.       GO TO 599
  825.  
  826. C     ************************ BLOC   ********************************
  827.  537  CONTINUE
  828.       ICO50=KCOLA(50)
  829.        IF (ITLAC(/1).EQ.0) GOTO 599
  830.       DO 5370 IEL=M1,M2
  831.         MBLO1=ITLAC(IEL)
  832.         IF(MBLO1.LE.0) goto 5370
  833.         segact mblo1*mod
  834.          if (mblo1.mbenum.ne.0) then
  835.           iva=mblo1.mbenum
  836. **        write(6,*) 'ajout de iva ',iva
  837.                if (iva.gt.0) then
  838.                   CALL AJOUN(ICO50,IVA,ILISSE,iun)
  839.                IF (IIICHA.EQ.1) mblo1.mbenum  =-IVA
  840.                endif
  841.          endif
  842.          mtresu=mblo1.itresu
  843.          if (mtresu.eq.0) goto 5370
  844.          segact mtresu
  845.          do 5371 ires=1,NRESI
  846.            ityp1=mtyres(ires)
  847.            iva  =ivares(ires)
  848.            call typfil(ityp1,j)
  849.            if (j.le.0) goto 5371
  850.             ICO2=KCOLA(J)
  851.             NUMLIS=1
  852.             ilissd=ilissg
  853.             IF(J.EQ.24) NUMLIS=6
  854.             IF(J.EQ.25) then
  855.               NUMLIS=3
  856.               ilissd=ilissf
  857.             ENDIF
  858.             IF(J.EQ.26) then
  859.              if (ionive.le.20) then
  860.                NUMLIS=2
  861.              else
  862.                goto 5371
  863.              endif
  864.             ENDIF
  865.             IF(J.EQ.27) NUMLIS=5
  866.             IF(J.EQ.32) then
  867.              NUMLIS=3
  868.              ilissd=ilissp
  869.             endif
  870.             IF(J.EQ.36) NUMLIS=7
  871.             IF(J.EQ.45) NUMLIS=5
  872.             CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  873.  5371    CONTINUE
  874.  5370 continue
  875.       goto 599
  876. C     ************************ MMODEL ********************************
  877.  538  CONTINUE
  878.       CALL EXAMDL(ICOLAC,ITLACC,M1,M2,IIICHA,IONIVE)
  879.       GOTO 599
  880. C     ************************ MCHAML ********************************
  881.  539  CONTINUE
  882.       CALL EXCHAM(ICOLAC,ITLACC,M1,M2,IIICHA)
  883.       GOTO 599
  884. C     ************************ MINTE  ********************************
  885.  540  CONTINUE
  886.       GOTO 599
  887. C     ************************ NUAGE  ********************************
  888.  541  CONTINUE
  889.       DO 810 IEL=M1,M2
  890.          MNUAGE=ITLAC(IEL)
  891.          IF (MNUAGE.EQ.0) GO TO 810
  892.          SEGACT MNUAGE
  893.          L6=NUAPOI(/1)
  894.          IF (L6.EQ.0) GO TO 813
  895.          DO 811 K=1,L6
  896.             ITYP1=NUATYP(K)
  897.             ISIN=NUAPOI(K)
  898.             J=0
  899.             IF(ITYP1.EQ.'FLOTTANT'.OR.ITYP1.EQ.'ENTIER  '.OR.
  900.      $           ITYP1.EQ.'MOT     '.OR.ITYP1.EQ.'LOGIQUE ') GO TO 811
  901.             CALL  TYPFIL (ITYP1,J)
  902.             IF(J.LE.0) GO TO 811
  903.             ICO2=KCOLA(J)
  904.             NUMLIS=1
  905.                      ilissd=ilissg
  906.                      IF(J.EQ.32) then
  907.                       NUMLIS=3
  908.                       ilissd=ilissp
  909.                      endif
  910.             IF(J.EQ.36) NUMLIS=7
  911.             IF(J.EQ.45) NUMLIS=5
  912.             NUAVIN=ISIN
  913.             SEGACT NUAVIN*MOD
  914.             DO 816 LL =1,NUAINT(/1)
  915.                IVA=NUAINT(LL)
  916.                CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  917.                IF(IIICHA.EQ.1) NUAINT(LL)=IVA
  918.  816        CONTINUE
  919.             SEGDES NUAVIN
  920.  811     CONTINUE
  921.  813     SEGDES MNUAGE
  922.  810  CONTINUE
  923.       GO TO 599
  924. C     **************************** MATRAK ******************************
  925.  542  CONTINUE
  926. C     ICO1=KCOLA(1)
  927.       CALL EXAMTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  928.       GO TO 599
  929. C     **************************** MATRIK ******************************
  930.  543  CONTINUE
  931. C     ICO1=KCOLA(1)
  932.       CALL EXANTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  933.       GO TO 599
  934. C  ****************************** METHODE ***************************
  935.  545  CONTINUE
  936.       ICO1=KCOLA(27)
  937.       DO 5450 IEL=M1,M2
  938.          IVA = ITLAC(IEL)
  939.          CALL AJOUN(ICO1,IVA,ILISSE,icinq)
  940.          IF(IIICHA.EQ.1) ITLAC (IEL) = IVA
  941.  5450 CONTINUE
  942.       GO TO 599
  943. C  ****************************** ESCLAVE ***************************
  944.  546  CONTINUE
  945.       DO 5460 IEL=M1,M2
  946.        mesres=itlac(iel)
  947.        segact mesres
  948.        if (.not.loremp) goto 5460
  949.        ityp1=esrety
  950.        k=0
  951.        call typfil(ityp1,k)
  952.        if (k.le.0) goto 5460
  953.        if (k.eq.24) goto 5460
  954.        if (k.eq.25) goto 5460
  955.        if (k.eq.26) goto 5460
  956.        if (k.eq.27) goto 5460
  957.        ico1=kcola(k)
  958.        iva=esreva
  959.             NUMLIS=1
  960.                      ilissd=ilissg
  961.                      IF(J.EQ.32) then
  962.                       NUMLIS=3
  963.                       ilissd=ilissp
  964.                      endif
  965.             IF(k.EQ.36) NUMLIS=7
  966.             IF(K.EQ.45) NUMLIS=5
  967. *      write (6,*) ' expill esclave renvoie sur ',ityp1,iva
  968.        call ajoun(ico1,iva,ilissd,numlis)
  969.        segdes mesres
  970.  5460  continue
  971. C JYY        print*, ' passage ESCLAVE dans expil'
  972.       GO TO 599
  973. C     ***************************** FANTOME ****************************
  974.  547  CONTINUE
  975.       GO TO 599
  976. C     ***************************** IELVAL *****************************
  977.  548  CONTINUE
  978.       GO TO 599
  979. C     ***************************** ANNOTATI ***************************
  980.  549  CONTINUE
  981.       ico49=kcola(49)
  982.       ico1 =kcola(1)
  983.       DO 5490 IEL=M1,M2
  984.        iva=itlac(iel)
  985.        call ajoun(ico49,iva,ilisse,iun)
  986.        MANNOT=itlac(iel)
  987.        SEGACT,MANNOT
  988.        NBANNO = MANNOT.ICLAS(/1)
  989.        DO IANO=1,NBANNO
  990.          IF(MANNOT.ICLAS(IANO) .EQ. 2)THEN
  991.            METIQU = MANNOT.ISEGT(IANO)
  992.            SEGACT,METIQU*MOD
  993.            iva2 = METIQU.INUPT
  994.            IF(iva2.GT.0) THEN
  995.              CALL AJOUN(ico1,iva2,ILISSE,iun)
  996.              IF (IIICHA.EQ.1) METIQU.INUPT =-iva2
  997.            ENDIF
  998.            SEGDES,METIQU
  999.          ENDIF
  1000.        ENDDO
  1001.  5490 continue
  1002.       GO TO 599
  1003. C     ***************************** LISTOBJE ***************************
  1004.  550  CONTINUE
  1005.       DO 5500 IEL=M1,M2
  1006.         MLOBJE = ITLAC(IEL)
  1007.         IF (MLOBJE.EQ.0) GOTO 5500
  1008.         SEGACT, MLOBJE*MOD
  1009.         NBOB1 = LISOBJ(/1)
  1010.         IF (NBOB1.LE.0) GOTO 5500
  1011.         IF (TYPOBJ.EQ.'ESCLAVE') THEN
  1012. C         write(6,*) 'EXPIL : traitement listobje esclave'
  1013.           LOTEMP=lodesl
  1014.           lodesl=.false.
  1015.           CALL ECROBJ('LISTOBJE',MLOBJE)
  1016.           CALL LIRABJ('LISTOBJE',IPLOBJ,1,IRET)
  1017.           lodesl=LOTEMP
  1018.           IF (IERR.NE.0) RETURN
  1019. C         write(6,*) 'EXPIL : MLOBJE,IPLOBJ=',MLOBJE,IPLOBJ
  1020.           IF (IPLOBJ.NE.MLOBJE) THEN
  1021.             CALL ERREUR(5)
  1022.             RETURN
  1023.           ENDIF
  1024. **        IF (TYPOBJ.EQ.'ESCLAVE') THEN
  1025. **          CALL ERREUR(5)
  1026. **          RETURN
  1027. **        ENDIF
  1028.           SEGACT MLOBJE*MOD
  1029.         ENDIF
  1030.         ITYP1 = TYPOBJ
  1031.         CALL TYPFIL(ITYP1,J)
  1032.         IF (J.LE.0) GOTO 5500
  1033.         ICO1 = KCOLA(J)
  1034.         DO 5501 IL=1,NBOB1
  1035.           IVA = LISOBJ(IL)
  1036.           NUMLIS = 1
  1037.           ILISSD = ILISSG
  1038.           IF (J.EQ.24) NUMLIS=6
  1039.           IF (J.EQ.25) THEN
  1040.             NUMLIS = 3
  1041.             ILISSD = ILISSF
  1042.           ENDIF
  1043.           IF (J.EQ.26) THEN
  1044.             NUMLIS = 2
  1045.           ENDIF
  1046.           IF (J.EQ.27) NUMLIS=5
  1047.           IF (J.EQ.32) THEN
  1048.             NUMLIS = 3
  1049.             ILISSD = ILISSP
  1050.           ENDIF
  1051.           IF (J.EQ.36) NUMLIS = 7
  1052.           IF (J.EQ.45) NUMLIS = 5
  1053.           CALL AJOUN(ICO1,IVA,ILISSD,NUMLIS)
  1054.           IF(IIICHA.EQ.1) LISOBJ(IL) = IVA
  1055.  5501   CONTINUE
  1056.         SEGDES,MLOBJE
  1057.  5500 CONTINUE
  1058.       GO TO 599
  1059. C     ***************************** IMODEL *****************************
  1060.  551  CONTINUE
  1061.       DO IEL = M1, M2
  1062.         IPMODL = itlacc.ITLAC(IEL)
  1063.         IF (IPMODL.NE.0) CALL EXIMOD(ICOLAC,IPMODL,IIICHA,IONIVE)
  1064.       ENDDO
  1065.       GOTO 599
  1066.  
  1067. C ==================== FIN DU TRAITEMENT DE LA PILE ====================
  1068.  599  CONTINUE
  1069.       SEGDES,ICOLAC
  1070.       iimpi = iimpi_z
  1071.  
  1072.       RETURN
  1073.       END
  1074.  
  1075.  

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