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

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