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    CB215821  24/04/12    21:15:51     11897          
  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.          iargum=mblo1.margum
  799.          segact iargum
  800.          mtresu=itresu
  801.          if (mtresu.eq.0) goto 5270
  802.          segact mtresu
  803.          do 5271 ires=1,NRESI
  804.            ityp1=mtyres(ires)
  805.            iva  =ivares(ires)
  806.            call typfil(ityp1,j)
  807.            if (j.le.0) goto 5271
  808.             ICO2=KCOLA(J)
  809.             NUMLIS=1
  810.             ilissd=ilissg
  811.             IF(J.EQ.24) NUMLIS=6
  812.             IF(J.EQ.25) then
  813.               NUMLIS=3
  814.               ilissd=ilissf
  815.             ENDIF
  816.             IF(J.EQ.26) then
  817.              if (ionive.le.20) then
  818.                NUMLIS=2
  819.              else
  820.                goto 5271
  821.              endif
  822.             ENDIF
  823.             IF(J.EQ.27) NUMLIS=5
  824.             IF(J.EQ.32) then
  825.              NUMLIS=3
  826.              ilissd=ilissp 
  827.             endif
  828.             IF(J.EQ.36) NUMLIS=7
  829.             IF(J.EQ.45) NUMLIS=5
  830.             CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  831.  5271    CONTINUE
  832.  5270 CONTINUE
  833.       GO TO 599
  834.  
  835. C     ************************ BLOC   ********************************
  836.  537  CONTINUE
  837.       ICO50=KCOLA(50)
  838.        IF (ITLAC(/1).EQ.0) GOTO 599
  839.       DO 5370 IEL=M1,M2
  840.         MBLO1=ITLAC(IEL)
  841.         IF(MBLO1.LE.0) goto 5370
  842.         segact mblo1*mod
  843.          if (mblo1.mbenum.ne.0) then
  844.           iva=mblo1.mbenum
  845. **        write(6,*) 'ajout de iva ',iva
  846.                if (iva.gt.0) then
  847.                   CALL AJOUN(ICO50,IVA,ILISSE,iun)
  848.                IF (IIICHA.EQ.1) mblo1.mbenum  =-IVA
  849.                endif
  850.          endif
  851.  5370 continue
  852.       goto 599
  853. C     ************************ MMODEL ********************************
  854.  538  CONTINUE
  855.       ICO1  = KCOLA( 1)
  856.       ICO10 = KCOLA(10)
  857.       ICO29 = KCOLA(29)
  858.       ICO40 = kcola(40)
  859.       DO 5380 IEL=M1,M2
  860.          MMODEL = ITLAC(IEL)
  861.          IF (MMODEL.EQ.0) GOTO 5380
  862.          SEGACT,MMODEL
  863.          DO 5385 I=1,KMODEL(/1)
  864.             IMODEL = KMODEL(I)
  865.             SEGACT,IMODEL*MOD
  866.             IVA = IMAMOD
  867.             IF(IVA.GT.0) THEN
  868.                CALL AJOUN(ICO1,IVA,ILISSE,iun)
  869.                IF (IIICHA.EQ.1) IMAMOD =-IVA
  870.             ENDIF
  871.             IVA = IPDPGE
  872.             IF(IVA.GT.0) THEN
  873.                CALL AJOUN(ICO1,IVA,ILISSE,iun)
  874.                IF (IIICHA.EQ.1) IPDPGE =-IVA
  875.             ENDIF
  876. C    cas 'NAVIER_STOKES' : INFMOD(2) contient une table
  877.             NFOR=FORMOD(/2)
  878.             IF (NFOR.GT.0) THEN
  879.                IF ((FORMOD(1).EQ.'NAVIER_STOKES').OR.
  880.      *             (FORMOD(1).EQ.'DARCY').OR.
  881.      *             (FORMOD(1).EQ.'EULER')) THEN
  882.                   MN3=INFMOD(/1)
  883.                   IF (MN3.GT.1) THEN
  884.                      IVA=INFMOD(2)
  885.                      IF(IVA.GT.0) THEN
  886.                         CALL AJOUN(ICO10,IVA,ILISSE,iun)
  887.                         IF (IIICHA.EQ.1) INFMOD(2) =-IVA
  888.                      ENDIF
  889.                   ENDIF
  890.                ENDIF
  891.             ENDIF
  892.             NM3=INFMOD(/1)
  893.             DO IOU=3,NM3
  894.               IVA=INFMOD(IOU)
  895.               IF(IVA.gt.0) then
  896.                  IF(IOU.EQ.14) THEN
  897.                    CALL AJOUN(ICO29,IVA,ilisse,iun)
  898.                  ELSE
  899.                    CALL AJOUN(ICO40,IVA,ilisse,iun)
  900.                  ENDIF
  901.                  IF(IIICHA.EQ.1) INFMOD(IOU)=-IVA
  902.               ENDIF
  903.             ENDDO
  904.             IF(tymode(/2). ne . 0) then
  905.                do 5387 ihy=1,tymode(/2)
  906.                  ITYP1=tymode(ihy)
  907.                  IVA=IVAMOD(ihy)
  908.                  J=0
  909.                  if( iva.lt.0) go to 5387
  910.                  CALL  TYPFIL (ITYP1,J)
  911.                  IF(J.LE.0) then 
  912.                       MOTERR(1:8)=ITYP1
  913.                       call erreur(336)                   
  914.                  ENDIF
  915.                  IF(j.le.0.or.j.eq.32) GO TO 5387
  916.                  ICO2=KCOLA(J)
  917.                  NUMLIS=1
  918.                  ilissd=ilissg
  919.                  IF(J.EQ.24) NUMLIS=6
  920.                  IF(J.EQ.25) then
  921.                        NUMLIS=3
  922.                        ilissd=ilissf
  923.                  ENDIF
  924.                  IF(J.EQ.26) NUMLIS=2
  925.                  IF(J.EQ.27) NUMLIS=5
  926.                  IF(J.EQ.32) then
  927.                     NUMLIS=3
  928.                     ilissd=ilissp
  929.                  endif
  930.                  IF(J.EQ.36) NUMLIS=7
  931.                  IF(J.EQ.45) NUMLIS=5
  932.                  CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  933.                  IF(IIICHA.EQ.1)IVAMOD(ihy) =-IVA
  934.  5387          continue
  935.             endif
  936.             SEGDES,IMODEL
  937.  5385    CONTINUE
  938.          SEGDES,MMODEL
  939.  5380 CONTINUE
  940.       GOTO 599
  941. C     ************************ MCHAML ********************************
  942.  539  CONTINUE
  943.       CALL EXCHAM(ICOLAC,ITLACC,M1,M2,IIICHA)
  944.       GOTO 599
  945. C     ************************ MINTE  ********************************
  946.  540  CONTINUE
  947.       GOTO 599
  948. C     ************************ NUAGE  ********************************
  949.  541  CONTINUE
  950.       DO 810 IEL=M1,M2
  951.          MNUAGE=ITLAC(IEL)
  952.          IF (MNUAGE.EQ.0) GO TO 810
  953.          SEGACT MNUAGE
  954.          L6=NUAPOI(/1)
  955.          IF (L6.EQ.0) GO TO 813
  956.          DO 811 K=1,L6
  957.             ITYP1=NUATYP(K)
  958.             ISIN=NUAPOI(K)
  959.             J=0
  960.             IF(ITYP1.EQ.'FLOTTANT'.OR.ITYP1.EQ.'ENTIER  '.OR.
  961.      $           ITYP1.EQ.'MOT     '.OR.ITYP1.EQ.'LOGIQUE ') GO TO 811
  962.             CALL  TYPFIL (ITYP1,J)
  963.             IF(J.LE.0) GO TO 811
  964.             ICO2=KCOLA(J)
  965.             NUMLIS=1
  966.                      ilissd=ilissg
  967.                      IF(J.EQ.32) then
  968.                       NUMLIS=3
  969.                       ilissd=ilissp 
  970.                      endif
  971.             IF(J.EQ.36) NUMLIS=7
  972.             IF(J.EQ.45) NUMLIS=5
  973.             NUAVIN=ISIN
  974.             SEGACT NUAVIN*MOD
  975.             DO 816 LL =1,NUAINT(/1)
  976.                IVA=NUAINT(LL)
  977.                CALL AJOUN (ICO2,IVA,ILISSd,NUMLIS)
  978.                IF(IIICHA.EQ.1) NUAINT(LL)=IVA
  979.  816        CONTINUE
  980.             SEGDES NUAVIN
  981.  811     CONTINUE
  982.  813     SEGDES MNUAGE
  983.  810  CONTINUE
  984.       GO TO 599
  985. C     **************************** MATRAK ******************************
  986.  542  CONTINUE
  987. C     ICO1=KCOLA(1)
  988.       CALL EXAMTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  989.       GO TO 599
  990. C     **************************** MATRIK ******************************
  991.  543  CONTINUE
  992. C     ICO1=KCOLA(1)
  993.       CALL EXANTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  994.       GO TO 599
  995. C  ****************************** METHODE ***************************
  996.  545  CONTINUE
  997.       ICO1=KCOLA(27)
  998.       DO 5450 IEL=M1,M2
  999.          IVA = ITLAC(IEL)
  1000.          CALL AJOUN(ICO1,IVA,ILISSE,icinq)
  1001.          IF(IIICHA.EQ.1) ITLAC (IEL) = IVA
  1002.  5450 CONTINUE
  1003.       GO TO 599
  1004. C  ****************************** ESCLAVE ***************************
  1005.  546  CONTINUE
  1006.       DO 5460 IEL=M1,M2
  1007.        mesres=itlac(iel)
  1008.        segact mesres
  1009.        if (.not.loremp) goto 5460
  1010.        ityp1=esrety
  1011.        k=0
  1012.        call typfil(ityp1,k)
  1013.        if (k.le.0) goto 5460
  1014.        if (k.eq.24) goto 5460
  1015.        if (k.eq.25) goto 5460
  1016.        if (k.eq.26) goto 5460
  1017.        if (k.eq.27) goto 5460
  1018.        ico1=kcola(k)
  1019.        iva=esreva
  1020.             NUMLIS=1
  1021.                      ilissd=ilissg
  1022.                      IF(J.EQ.32) then
  1023.                       NUMLIS=3
  1024.                       ilissd=ilissp 
  1025.                      endif
  1026.             IF(k.EQ.36) NUMLIS=7
  1027.             IF(K.EQ.45) NUMLIS=5
  1028. *      write (6,*) ' expill esclave renvoie sur ',ityp1,iva
  1029.        call ajoun(ico1,iva,ilissd,numlis)
  1030.        segdes mesres
  1031.  5460  continue
  1032. C JYY        print*, ' passage ESCLAVE dans expil'
  1033.       GO TO 599
  1034. C     ***************************** FANTOME ****************************
  1035.  547  CONTINUE
  1036.       GO TO 599
  1037. C     ***************************** IELVAL *****************************
  1038.  548  CONTINUE
  1039.       GO TO 599
  1040. C     ***************************** ANNOTATI ***************************
  1041.  549  CONTINUE
  1042.       ico49=kcola(49)
  1043.       ico1 =kcola(1)
  1044.       DO 5490 IEL=M1,M2
  1045.        iva=itlac(iel)
  1046.        call ajoun(ico49,iva,ilisse,iun)
  1047.        MANNOT=itlac(iel)
  1048.        SEGACT,MANNOT
  1049.        NBANNO = MANNOT.ICLAS(/1)
  1050.        DO IANO=1,NBANNO
  1051.          IF(MANNOT.ICLAS(IANO) .EQ. 2)THEN
  1052.            METIQU = MANNOT.ISEGT(IANO)
  1053.            SEGACT,METIQU*MOD
  1054.            iva2 = METIQU.INUPT
  1055.            IF(iva2.GT.0) THEN
  1056.              CALL AJOUN(ico1,iva2,ILISSE,iun)
  1057.              IF (IIICHA.EQ.1) METIQU.INUPT =-iva2
  1058.            ENDIF
  1059.            SEGDES,METIQU
  1060.          ENDIF
  1061.        ENDDO
  1062.  5490 continue
  1063.       GO TO 599
  1064. C     ***************************** LISTOBJE ***************************
  1065.  550  CONTINUE
  1066.       DO 5500 IEL=M1,M2
  1067.         MLOBJE = ITLAC(IEL)
  1068.         IF (MLOBJE.EQ.0) GOTO 5500
  1069.         SEGACT, MLOBJE*MOD
  1070.         NBOB1 = LISOBJ(/1)
  1071.         IF (NBOB1.LE.0) GOTO 5500
  1072.         IF (TYPOBJ.EQ.'ESCLAVE') THEN
  1073. C         write(6,*) 'EXPIL : traitement listobje esclave'
  1074.           lotemp=lodesl
  1075.           lodesl=.false.
  1076.           CALL ECROBJ('LISTOBJE',MLOBJE)
  1077.           CALL LIRABJ('LISTOBJE',IPLOBJ,1,IRET)
  1078.           lodesl=lotemp
  1079.           IF (IERR.NE.0) RETURN
  1080. C         write(6,*) 'EXPIL : MLOBJE,IPLOBJ=',MLOBJE,IPLOBJ
  1081.           IF (IPLOBJ.NE.MLOBJE) THEN
  1082.             CALL ERREUR(5)
  1083.             RETURN
  1084.           ENDIF
  1085. **        IF (TYPOBJ.EQ.'ESCLAVE') THEN
  1086. **          CALL ERREUR(5)
  1087. **          RETURN
  1088. **        ENDIF
  1089.           SEGACT MLOBJE*MOD
  1090.         ENDIF
  1091.         ITYP1 = TYPOBJ
  1092.         CALL TYPFIL(ITYP1,J)
  1093.         IF (J.LE.0) GOTO 5500
  1094.         ICO1 = KCOLA(J)
  1095.         DO 5501 IL=1,NBOB1
  1096.           IVA = LISOBJ(IL)
  1097.           NUMLIS = 1
  1098.           ILISSD = ILISSG
  1099.           IF (J.EQ.24) NUMLIS=6
  1100.           IF (J.EQ.25) THEN
  1101.             NUMLIS = 3
  1102.             ILISSD = ILISSF
  1103.           ENDIF
  1104.           IF (J.EQ.26) THEN
  1105.             NUMLIS = 2
  1106.           ENDIF
  1107.           IF (J.EQ.27) NUMLIS=5
  1108.           IF (J.EQ.32) THEN
  1109.             NUMLIS = 3
  1110.             ILISSD = ILISSP
  1111.           ENDIF
  1112.           IF (J.EQ.36) NUMLIS = 7
  1113.           IF (J.EQ.45) NUMLIS = 5
  1114.           CALL AJOUN(ICO1,IVA,ILISSD,NUMLIS)
  1115.           IF(IIICHA.EQ.1) LISOBJ(IL) = IVA
  1116.  5501   CONTINUE
  1117.         SEGDES, MLOBJE
  1118.  5500 CONTINUE
  1119.       GO TO 599
  1120.  
  1121.  
  1122.  599  CONTINUE
  1123.       SEGDES ICOLAC
  1124.       RETURN
  1125.       END
  1126.  
  1127.  
  1128.  
  1129.  
  1130.  
  1131.  
  1132.  
  1133.  
  1134.  
  1135.  
  1136.  

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