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

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