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    OF166741  24/12/18    21:15:11     12092          
  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.       ICOM=KCOLA(29)
  605.       DO 660 IEL=M1,M2
  606.          MEVOLL=ITLAC(IEL)
  607.          IF (MEVOLL.EQ.0) GO TO 660
  608.          SEGACT MEVOLL
  609.          DO 661 I=1,IEVOLL(/1)
  610.             KEVOLL=IEVOLL(I)
  611.             SEGACT KEVOLL*MOD
  612.             IVA=IPROGX
  613.             ICO2=ICOR
  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.                ENDIF
  620.             ENDIF
  621.             IF(IVA.GT.0) THEN
  622.                CALL AJOUN(ICO2,IVA,ILISSE,iun)
  623.                IF(IIICHA.EQ.1) IPROGX=-IVA
  624.             ENDIF
  625.             IVA=IPROGY
  626.             IF(IONIVE.GE.3) THEN
  627.                IF(TYPY.EQ.'LISTMOTS') THEN
  628.                   ICO2=ICOM
  629.                ELSEIF(TYPY.EQ.'LISTREEL')THEN
  630.                   ICO2=ICOR
  631.                ENDIF
  632.             ENDIF
  633.             IF(IVA.GT.0) THEN
  634.                CALL AJOUN(ICO2,IVA,ILISSE,iun)
  635.                IF(IIICHA.EQ.1) IPROGY=-IVA
  636.             ENDIF
  637.             SEGDES KEVOLL
  638.  661     CONTINUE
  639.          SEGDES MEVOLL
  640.  660  CONTINUE
  641.       GOTO 599
  642. C     **********************SUPERELE************************************
  643.  523  CONTINUE
  644.       ICO1=KCOLA(1)
  645.       ICO3=KCOLA(3)
  646.       ICO2=KCOLA( 2)
  647.       ICO16=KCOLA(16)
  648.       DO 5230 IEL=M1,M2
  649.          MSUPER=ITLAC(IEL)
  650.          IF (MSUPER.EQ.0) GO TO 5230
  651.          SEGACT MSUPER*MOD
  652.          IVA=MRIGTO
  653.          CALL AJOUN(ICO3,IVA,ILISSE,iun)
  654.          IF(IIICHA.EQ.1)MRIGTO=IVA
  655.          IVA=MSUPEL
  656.          CALL AJOUN(ICO1,IVA,ILISSE,iun)
  657.          IF(IIICHA.EQ.1)MSUPEL=IVA
  658.          IVA=MSURAI
  659.          CALL AJOUN(ICO3,IVA,ILISSE,iun)
  660.          IF(IIICHA.EQ.1)MSURAI=IVA
  661.          IVA=MSUMAS
  662.          IF(IVA.NE.0) CALL AJOUN(ICO3,IVA,ILISSE,iun)
  663.          IF(IIICHA.EQ.1)MSUMAS=IVA
  664.          IVA=MCROUT
  665.          if (mcrout.ne.0) then
  666.            CALL AJOUN(ICO16,IVA,ILISSE,iun)
  667.            IF(IIICHA.EQ.1)MCROUT=IVA
  668.          endif
  669. c      NBINMA=MSUPCH(/1)
  670. c      DO 5231 I=1,NBINMA
  671. c      IVA=MSUPCH(I)
  672. c      CALL AJOUN(ICO2,IVA)
  673. c                            IF(IIICHA.EQ.1)MSUPCH(I)=IVA
  674. c 5231 CONTINUE
  675.          SEGDES MSUPER
  676.  5230 CONTINUE
  677.       GOTO 599
  678. C     **********************LOGIQUE***********************************
  679.  524  CONTINUE
  680.       GOTO 599
  681. C     **********************FLOTTANT**********************************
  682.  525  CONTINUE
  683.       GOTO 599
  684. C     ********************** ENTIER **********************************
  685.  526  CONTINUE
  686.       GOTO 599
  687. C     ********************** MOT   ***********************************
  688.  527  CONTINUE
  689.       GOTO 599
  690. C     ********************** TEXTE ***********************************
  691.  528  CONTINUE
  692.       GOTO 599
  693. C     ********************** LISTMOTS*********************************
  694.  529  CONTINUE
  695.       GOTO 599
  696. C     ********************** VECTEUR**********************************
  697.  530  CONTINUE
  698.       ICO1=KCOLA(1)
  699.       ICO2=KCOLA( 2)
  700.       DO 5300 IEL=M1,M2
  701.          MVECTE=ITLAC(IEL)
  702.          IF (MVECTE.EQ.0) GO TO 5300
  703.          SEGACT MVECTE*MOD
  704.          NVEC=ICHPO(/1)
  705.          DO 5301 I=1,NVEC
  706. *  CE POINTEUR N'EST PAS ACTUELLEMENT REMPLI
  707. *     IVA=IGEOV(I)
  708. *     CALL AJOUN(ICO1,IVA)
  709. *                           IF(IIICHA.EQ.1)IGEOV(I)=IVA
  710.             IVA=ICHPO(I)
  711.             CALL AJOUN(ICO2,IVA,ILISSE,iun)
  712.             IF(IIICHA.EQ.1)ICHPO(I)=IVA
  713.  5301    CONTINUE
  714.          SEGDES MVECTE
  715.  5300 CONTINUE
  716.       GOTO 599
  717. C     ********************** VECTDOUB*********************************
  718.  531  CONTINUE
  719.       GOTO 599
  720. C     ********************** POINT   *********************************
  721.  532  CONTINUE
  722.       GOTO 599
  723. C     ********************** CONFIG  *********************************
  724.  533  CONTINUE
  725.       GOTO 599
  726. C     *********************** LISTCHPO ******************************
  727.  534  CONTINUE
  728.       ICO2=KCOLA(2)
  729.       DO 340 IEL=M1,M2
  730.          MLCHPO =ITLAC(IEL)
  731.          IF (MLCHPO.EQ.0) GO TO 340
  732.          SEGACT MLCHPO*MOD
  733.          N1=ICHPOI(/1)
  734.          DO 341 I=1,N1
  735.             IVA=ICHPOI(I)
  736.             CALL AJOUN(ICO2,IVA,ILISSE,iun)
  737.             IF(IIICHA.EQ.1)ICHPOI(I)=IVA
  738.  341     CONTINUE
  739.          SEGDES MLCHPO
  740.  340  CONTINUE
  741.       GO TO 599
  742. C     ************************** BASEM ********************************
  743.  535  CONTINUE
  744.       ICO12=KCOLA(12)
  745.       ICO8=KCOLA(8 )
  746.       ICO15=KCOLA(15)
  747.       DO 350 IEL=M1,M2
  748.          MBASEM=ITLAC(IEL)
  749.          IF (MBASEM.EQ.0) GO TO 350
  750.          SEGACT MBASEM
  751.          DO 351 I=1,LISBAS(/1)
  752.             MSOBAS=LISBAS(I)
  753.             SEGACT MSOBAS*MOD
  754.             IVA=IBSTRM(1)
  755.             IF(IVA.GT.0) THEN
  756.                CALL AJOUN(ICO12,IVA,ILISSE,iun)
  757.                IF(IIICHA.EQ.1) IBSTRM(1)=-IVA
  758.             ENDIF
  759.             IVA=IBSTRM(2)
  760.             IF(IVA.GT.0) THEN
  761.                CALL AJOUN(ICO8,IVA,ILISSE,iun)
  762.                IF(IIICHA.EQ.1) IBSTRM(2)=-IVA
  763.             ENDIF
  764.             IVA=IBSTRM(3)
  765.             IF (IVA.EQ.0) GOTO 352
  766.             IF(IVA.GT.0) THEN
  767.                CALL AJOUN(ICO8,IVA,ILISSE,iun)
  768.                IF(IIICHA.EQ.1) IBSTRM(3)=-IVA
  769.             ENDIF
  770.  352        CONTINUE
  771.             IVA=IBSTRM(4)
  772.             IF (IVA.EQ.0) GOTO 353
  773.             IF(IVA.GT.0) THEN
  774.                CALL AJOUN(ICO15,IVA,ILISSE,iun)
  775.                IF(IIICHA.EQ.1) IBSTRM(4)=-IVA
  776.             ENDIF
  777.  353        CONTINUE
  778.             IVA=IBSTRM(5)
  779.             IF (IVA.EQ.0) GOTO 354
  780.             IF(IVA.GT.0) THEN
  781.                CALL AJOUN(ICO8,IVA,ILISSE,iun)
  782.                IF(IIICHA.EQ.1) IBSTRM(5)=-IVA
  783.             ENDIF
  784.  354        CONTINUE
  785.             SEGDES MSOBAS
  786.  351     CONTINUE
  787.          SEGDES MBASEM
  788.  350  CONTINUE
  789.       GOTO 599
  790. C ************************* PROCEDURE ****************************
  791. *  On ajoute les objets en cours de retour (entre respro et finpro)
  792. *  on va les chercher dans les segments de resultats du  bloc 
  793. *  sous jacent a la procedure
  794. *
  795.  536  CONTINUE
  796. **    write(6,*) ' exploration bloc ',m1,m2
  797.        MTTRY=MTXBL
  798.       ITLACC=KCOLA(36)
  799.       ITLAC1=KCOLA(37)
  800.        IF (ITLAC(/1).EQ.0) GOTO 599
  801.       DO 5270 IEL=M1,M2
  802.         MBLA1=ITLAC(IEL)
  803.         MBLO1=IPIPR1(MBLA1)
  804.          IF (MBLO1.LE.0) GO TO 5270
  805. **       write(6,*) ' bloc dans procedur ',mblo1
  806.          SEGACT MBLO1   
  807.  5270 CONTINUE
  808.       GO TO 599
  809.  
  810. C     ************************ BLOC   ********************************
  811.  537  CONTINUE
  812.       ICO50=KCOLA(50)
  813.        IF (ITLAC(/1).EQ.0) GOTO 599
  814.       DO 5370 IEL=M1,M2
  815.         MBLO1=ITLAC(IEL)
  816.         IF(MBLO1.LE.0) goto 5370
  817.         segact mblo1*mod
  818.          if (mblo1.mbenum.ne.0) then
  819.           iva=mblo1.mbenum
  820. **        write(6,*) 'ajout de iva ',iva
  821.                if (iva.gt.0) then
  822.                   CALL AJOUN(ICO50,IVA,ILISSE,iun)
  823.                IF (IIICHA.EQ.1) mblo1.mbenum  =-IVA
  824.                endif
  825.          endif
  826.          mtresu=mblo1.itresu
  827.          if (mtresu.eq.0) goto 5370
  828.          segact mtresu
  829.          do 5371 ires=1,NRESI
  830.            ityp1=mtyres(ires)
  831.            iva  =ivares(ires)
  832.            call typfil(ityp1,j)
  833.            if (j.le.0) goto 5371
  834.             ICO2=KCOLA(J)
  835.             NUMLIS=1
  836.             ilissd=ilissg
  837.             IF(J.EQ.24) NUMLIS=6
  838.             IF(J.EQ.25) then
  839.               NUMLIS=3
  840.               ilissd=ilissf
  841.             ENDIF
  842.             IF(J.EQ.26) then
  843.              if (ionive.le.20) then
  844.                NUMLIS=2
  845.              else
  846.                goto 5371
  847.              endif
  848.             ENDIF
  849.             IF(J.EQ.27) NUMLIS=5
  850.             IF(J.EQ.32) then
  851.              NUMLIS=3
  852.              ilissd=ilissp 
  853.             endif
  854.             IF(J.EQ.36) NUMLIS=7
  855.             IF(J.EQ.45) NUMLIS=5
  856.             CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  857.  5371    CONTINUE
  858.  5370 continue
  859.       goto 599
  860. C     ************************ MMODEL ********************************
  861.  538  CONTINUE
  862.       CALL EXAMDL(ICOLAC,ITLACC,M1,M2,IIICHA,IONIVE)
  863.       GOTO 599
  864. C     ************************ MCHAML ********************************
  865.  539  CONTINUE
  866.       CALL EXCHAM(ICOLAC,ITLACC,M1,M2,IIICHA)
  867.       GOTO 599
  868. C     ************************ MINTE  ********************************
  869.  540  CONTINUE
  870.       GOTO 599
  871. C     ************************ NUAGE  ********************************
  872.  541  CONTINUE
  873.       DO 810 IEL=M1,M2
  874.          MNUAGE=ITLAC(IEL)
  875.          IF (MNUAGE.EQ.0) GO TO 810
  876.          SEGACT MNUAGE
  877.          L6=NUAPOI(/1)
  878.          IF (L6.EQ.0) GO TO 813
  879.          DO 811 K=1,L6
  880.             ITYP1=NUATYP(K)
  881.             ISIN=NUAPOI(K)
  882.             J=0
  883.             IF(ITYP1.EQ.'FLOTTANT'.OR.ITYP1.EQ.'ENTIER  '.OR.
  884.      $           ITYP1.EQ.'MOT     '.OR.ITYP1.EQ.'LOGIQUE ') GO TO 811
  885.             CALL  TYPFIL (ITYP1,J)
  886.             IF(J.LE.0) GO TO 811
  887.             ICO2=KCOLA(J)
  888.             NUMLIS=1
  889.                      ilissd=ilissg
  890.                      IF(J.EQ.32) then
  891.                       NUMLIS=3
  892.                       ilissd=ilissp 
  893.                      endif
  894.             IF(J.EQ.36) NUMLIS=7
  895.             IF(J.EQ.45) NUMLIS=5
  896.             NUAVIN=ISIN
  897.             SEGACT NUAVIN*MOD
  898.             DO 816 LL =1,NUAINT(/1)
  899.                IVA=NUAINT(LL)
  900.                CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  901.                IF(IIICHA.EQ.1) NUAINT(LL)=IVA
  902.  816        CONTINUE
  903.             SEGDES NUAVIN
  904.  811     CONTINUE
  905.  813     SEGDES MNUAGE
  906.  810  CONTINUE
  907.       GO TO 599
  908. C     **************************** MATRAK ******************************
  909.  542  CONTINUE
  910. C     ICO1=KCOLA(1)
  911.       CALL EXAMTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  912.       GO TO 599
  913. C     **************************** MATRIK ******************************
  914.  543  CONTINUE
  915. C     ICO1=KCOLA(1)
  916.       CALL EXANTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  917.       GO TO 599
  918. C  ****************************** METHODE ***************************
  919.  545  CONTINUE
  920.       ICO1=KCOLA(27)
  921.       DO 5450 IEL=M1,M2
  922.          IVA = ITLAC(IEL)
  923.          CALL AJOUN(ICO1,IVA,ILISSE,icinq)
  924.          IF(IIICHA.EQ.1) ITLAC (IEL) = IVA
  925.  5450 CONTINUE
  926.       GO TO 599
  927. C  ****************************** ESCLAVE ***************************
  928.  546  CONTINUE
  929.       DO 5460 IEL=M1,M2
  930.        mesres=itlac(iel)
  931.        segact mesres
  932.        if (.not.loremp) goto 5460
  933.        ityp1=esrety
  934.        k=0
  935.        call typfil(ityp1,k)
  936.        if (k.le.0) goto 5460
  937.        if (k.eq.24) goto 5460
  938.        if (k.eq.25) goto 5460
  939.        if (k.eq.26) goto 5460
  940.        if (k.eq.27) goto 5460
  941.        ico1=kcola(k)
  942.        iva=esreva
  943.             NUMLIS=1
  944.                      ilissd=ilissg
  945.                      IF(J.EQ.32) then
  946.                       NUMLIS=3
  947.                       ilissd=ilissp 
  948.                      endif
  949.             IF(k.EQ.36) NUMLIS=7
  950.             IF(K.EQ.45) NUMLIS=5
  951. *      write (6,*) ' expill esclave renvoie sur ',ityp1,iva
  952.        call ajoun(ico1,iva,ilissd,numlis)
  953.        segdes mesres
  954.  5460  continue
  955. C JYY        print*, ' passage ESCLAVE dans expil'
  956.       GO TO 599
  957. C     ***************************** FANTOME ****************************
  958.  547  CONTINUE
  959.       GO TO 599
  960. C     ***************************** IELVAL *****************************
  961.  548  CONTINUE
  962.       GO TO 599
  963. C     ***************************** ANNOTATI ***************************
  964.  549  CONTINUE
  965.       ico49=kcola(49)
  966.       ico1 =kcola(1)
  967.       DO 5490 IEL=M1,M2
  968.        iva=itlac(iel)
  969.        call ajoun(ico49,iva,ilisse,iun)
  970.        MANNOT=itlac(iel)
  971.        SEGACT,MANNOT
  972.        NBANNO = MANNOT.ICLAS(/1)
  973.        DO IANO=1,NBANNO
  974.          IF(MANNOT.ICLAS(IANO) .EQ. 2)THEN
  975.            METIQU = MANNOT.ISEGT(IANO)
  976.            SEGACT,METIQU*MOD
  977.            iva2 = METIQU.INUPT
  978.            IF(iva2.GT.0) THEN
  979.              CALL AJOUN(ico1,iva2,ILISSE,iun)
  980.              IF (IIICHA.EQ.1) METIQU.INUPT =-iva2
  981.            ENDIF
  982.            SEGDES,METIQU
  983.          ENDIF
  984.        ENDDO
  985.  5490 continue
  986.       GO TO 599
  987. C     ***************************** LISTOBJE ***************************
  988.  550  CONTINUE
  989.       DO 5500 IEL=M1,M2
  990.         MLOBJE = ITLAC(IEL)
  991.         IF (MLOBJE.EQ.0) GOTO 5500
  992.         SEGACT, MLOBJE*MOD
  993.         NBOB1 = LISOBJ(/1)
  994.         IF (NBOB1.LE.0) GOTO 5500
  995.         IF (TYPOBJ.EQ.'ESCLAVE') THEN
  996. C         write(6,*) 'EXPIL : traitement listobje esclave'
  997.           LOTEMP=lodesl
  998.           lodesl=.false.
  999.           CALL ECROBJ('LISTOBJE',MLOBJE)
  1000.           CALL LIRABJ('LISTOBJE',IPLOBJ,1,IRET)
  1001.           lodesl=LOTEMP
  1002.           IF (IERR.NE.0) RETURN
  1003. C         write(6,*) 'EXPIL : MLOBJE,IPLOBJ=',MLOBJE,IPLOBJ
  1004.           IF (IPLOBJ.NE.MLOBJE) THEN
  1005.             CALL ERREUR(5)
  1006.             RETURN
  1007.           ENDIF
  1008. **        IF (TYPOBJ.EQ.'ESCLAVE') THEN
  1009. **          CALL ERREUR(5)
  1010. **          RETURN
  1011. **        ENDIF
  1012.           SEGACT MLOBJE*MOD
  1013.         ENDIF
  1014.         ITYP1 = TYPOBJ
  1015.         CALL TYPFIL(ITYP1,J)
  1016.         IF (J.LE.0) GOTO 5500
  1017.         ICO1 = KCOLA(J)
  1018.         DO 5501 IL=1,NBOB1
  1019.           IVA = LISOBJ(IL)
  1020.           NUMLIS = 1
  1021.           ILISSD = ILISSG
  1022.           IF (J.EQ.24) NUMLIS=6
  1023.           IF (J.EQ.25) THEN
  1024.             NUMLIS = 3
  1025.             ILISSD = ILISSF
  1026.           ENDIF
  1027.           IF (J.EQ.26) THEN
  1028.             NUMLIS = 2
  1029.           ENDIF
  1030.           IF (J.EQ.27) NUMLIS=5
  1031.           IF (J.EQ.32) THEN
  1032.             NUMLIS = 3
  1033.             ILISSD = ILISSP
  1034.           ENDIF
  1035.           IF (J.EQ.36) NUMLIS = 7
  1036.           IF (J.EQ.45) NUMLIS = 5
  1037.           CALL AJOUN(ICO1,IVA,ILISSD,NUMLIS)
  1038.           IF(IIICHA.EQ.1) LISOBJ(IL) = IVA
  1039.  5501   CONTINUE
  1040.         SEGDES,MLOBJE
  1041.  5500 CONTINUE
  1042.       GO TO 599
  1043. C     ***************************** IMODEL *****************************
  1044.  551  CONTINUE
  1045.       DO IEL = M1, M2
  1046.         IPMODL = itlacc.ITLAC(IEL)
  1047.         IF (IPMODL.NE.0) CALL EXIMOD(ICOLAC,IPMODL,IIICHA,IONIVE)
  1048.       ENDDO
  1049.       GOTO 599
  1050.  
  1051. C ==================== FIN DU TRAITEMENT DE LA PILE ====================
  1052.  599  CONTINUE
  1053.       SEGDES,ICOLAC
  1054.       iimpi = iimpi_z
  1055.  
  1056.       RETURN
  1057.       END
  1058.  
  1059.  
  1060.  

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