Télécharger la plaquette Cast3M


fr en

Télécharger restpi.eso

Retour à la liste

Numérotation des lignes : 

restpi

  1. C RESTPI    SOURCE    GOUNAND   25/07/16    21:15:05     12325          
  2.  
  3. C=======================================================================
  4. C   RESTAURATION DES POINTEURS
  5. C
  6. C   PROGRAMME PAR FARVACQUE
  7. C   APPELE PAR SAUV
  8. C   APPELLE : ERREUR
  9. C
  10. C   HISTORIQUE : ajout des objets de type MATRAK et MATRIK par
  11. C                GOUNAND (15/07/98)
  12. C=======================================================================
  13. C  TABLEAU KCOLA: VOIR LE SOUS-PROGRAMME TYPFIL
  14. C=======================================================================
  15.  
  16.       SUBROUTINE RESTPI (ICOLAC)
  17.  
  18.       IMPLICIT INTEGER(I-N)
  19.       IMPLICIT REAL*8 (A-H,O-Z)
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC CCNOYAU
  24. -INC CCASSIS
  25.  
  26. -INC SMBASEM
  27. -INC SMMATRI
  28. -INC SMELSTR
  29. -INC SMCLSTR
  30. -INC SMSTRUC
  31. -INC SMATTAC
  32. -INC SMSOLUT
  33. -INC SMLENTI
  34. -INC SMLREEL
  35. -INC SMDEFOR
  36. -INC SMCHARG
  37. -INC SMEVOLL
  38. -INC SMTABLE
  39. -INC SMSUPER
  40. -INC SMVECTE
  41. -INC SMLCHPO
  42. -INC SMINTE
  43. -INC SMLOBJE
  44. -INC SMANNOT
  45. -INC TMCOLAC
  46.  
  47.       POINTEUR ITLAC7.ITLACC
  48.       CHARACTER*(8) ITYPE
  49.  
  50.       SEGACT ICOLAC
  51.       NITLAC=ICOLA(/1)
  52. C
  53. C****** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC******************
  54. C
  55.       DO 1099 IFILE=1,NITLAC
  56.          ITLACC=KCOLA(IFILE)
  57.          IMAX1=ITLAC(/1)
  58.          IDEB=KCOLAC(IFILE)+1
  59.          IF (IMAX1.EQ.0.OR.IDEB.GT.IMAX1) GO TO 1099
  60.          GOTO (6001,6002,6003,1099,1099,6006,6007,6008, 509, 510,
  61.      &         1099, 512,6013,6014,6015,6016,6017,6018,6019,6020,
  62.      &         1099,6022,6023,6024,6025,6026,6027,6028,6029,6030,
  63.      &         6031,6032,6033, 534,6035,1098,1098,6038,6039,6040,
  64.      &         6041,6042,6043, 510,1099,1099,1099,1099,6049,6050,
  65.      &         6051), IFILE
  66. C     ----
  67.  1001    ITYPE='        '
  68.          CALL TYPFIL(ITYPE,IFILE)
  69.          MOTERR(1:8)=ITYPE
  70.          CALL ERREUR(336)
  71.          GO TO 1099
  72. C     ****************************** MELEME ****************************
  73.  6001    CONTINUE
  74.          CALL RESTME(ITLACC,IMAX1,ICOLAC,IDEB)
  75.          GOTO 1098
  76. C     **************************CHPOINT*********************************
  77.  6002    CONTINUE
  78.          CALL RESTCH(ICOLAC,ITLACC,IMAX1,IDEB)
  79.          GOTO 1098
  80. C     ***********************MRIGID*************************************
  81.  6003    CONTINUE
  82.          CALL RESTRI(ICOLAC,ITLACC,IMAX1,IDEB)
  83.          GOTO 1098
  84. C     ***************************        *******************************
  85.  6004    CONTINUE
  86.          GOTO 1098
  87. C     ***************************        *******************************
  88.  6005    CONTINUE
  89.          GOTO 1098
  90. C     **************************** MCLSTR ******************************
  91.  6006    CONTINUE
  92.          ITLAC1=KCOLA(12)
  93.          ITLAC3=KCOLA(3)
  94.          DO 614 IEL=IDEB,IMAX1
  95.             MCLSTR=ITLAC(IEL)
  96.             IF (MCLSTR.EQ.0) GO TO 614
  97.             SEGACT MCLSTR*MOD
  98.             N=ISOSTR(/1)
  99.             DO 615 I=1,N
  100.                IVA=ISOSTR(I)
  101.                IF (IVA.NE.0) ISOSTR(I) = ITLAC1.ITLAC(IVA)
  102.                IVA=IRIGCL(I)
  103.                IF (IVA.NE.0) IRIGCL(I) = ITLAC3.ITLAC(I)
  104.  615        CONTINUE
  105.             SEGDES MCLSTR
  106.  614     CONTINUE
  107.          GO TO 1098
  108. C     **************************** MELSTR ******************************
  109.  6007    CONTINUE
  110.          ITLAC2=KCOLA(12)
  111.          ITLAC1=KCOLA(1)
  112.          DO 616 IEL=IDEB,IMAX1
  113.             MELSTR=ITLAC(IEL)
  114.             IF (MELSTR.EQ.0) GO TO 616
  115.             SEGACT MELSTR*MOD
  116.             N=ISOSTU(/1)
  117.             DO 617 I=1,N
  118.                IVA=ISOSTU(I)
  119.                IF(IVA.NE.0)ISOSTU(I)=ITLAC2.ITLAC(I)
  120.                IVA=IMELEM(I)
  121.                IF(IVA.NE.0)IMELEM(I)=ITLAC1.ITLAC(IVA)
  122.  617        CONTINUE
  123.             SEGDES MELSTR
  124.  616     CONTINUE
  125.          GO TO 1098
  126. C     ****************************MSOLUT********************************
  127.  6008    CONTINUE
  128.          DO 1800 IEL=IDEB,IMAX1
  129.             MSOLUT=ITLAC(IEL)
  130.             IF (MSOLUT.EQ.0) GO TO 1800
  131.             SEGACT MSOLUT*MOD
  132.             IF (IONIVE.GE.3) GO TO 818
  133. C ANCIEN NIVEAU------------------
  134.             IF(MSOLIS(3).LE.0) GOTO 1802
  135.             ITLAC1=KCOLA(1)
  136.             IVA=MSOLIS(3)
  137.             IF (IVA.NE.0) MSOLIS(3)=ITLAC1.ITLAC(IVA)
  138.             GOTO 1803
  139.  1802       CONTINUE
  140.             MSOLIS(3)=-MSOLIS(3)
  141.  1803       CONTINUE
  142.             GO TO 817
  143. C  FIN ANCIEN NIVEAU------------------
  144.  818        NIPO=MSOLIS(/1)
  145.             DO 620 II=1,NIPO
  146.                IF(MSOLIS(II).EQ.0) GOTO 620
  147.                IF(II.EQ.3) THEN
  148.                   IVA=MSOLIS(3)
  149.                   ITLAC1= KCOLA(1)
  150.                   IF(IVA.NE.0) MSOLIS(3)=ITLAC1.ITLAC(IVA)
  151.                   GOTO 620
  152.                ENDIF
  153.                IF(II.LE.4) GOTO 620
  154.                ITLAC2=KCOLA(MSOLIT(II))
  155.                MSOLEN=MSOLIS(II)
  156.                SEGACT MSOLEN*MOD
  157.                LTAB=ISOLEN(/1)
  158.                DO 619 I=1,LTAB
  159.                   IVA=ISOLEN(I)
  160.                   IF (IVA.NE.0) ISOLEN(I)=ITLAC2.ITLAC(IVA)
  161.  619           CONTINUE
  162.                SEGDES MSOLEN
  163.  620        CONTINUE
  164.  817        SEGDES MSOLUT
  165.  1800    CONTINUE
  166.          GOTO 1098
  167. C     ************************** MSTRUC ********************************
  168.  509     CONTINUE
  169.          ITLAC1=KCOLA(12)
  170.          DO 621 IEL=IDEB,IMAX1
  171.             MSTRUC=ITLAC(IEL)
  172.             IF (MSTRUC.EQ.0) GO TO 621
  173.             SEGACT MSTRUC*MOD
  174.             N=LISTRU(/1)
  175.             DO 622 I=1,N
  176.                IVA = LISTRU(I)
  177.                IF (IVA.LT.0) LISTRU(I) = ITLAC1.ITLAC(ABS(IVA))
  178.  622        CONTINUE
  179.             SEGDES MSTRUC
  180.  621     CONTINUE
  181.          GOTO 1098
  182. C     ******************************* MTABLE **************************
  183.  510     CONTINUE
  184.          ITLAC2=KCOLA(27)
  185.          NTOTO=6
  186.          if(nbesc.ne.0) segact ipiloc
  187.          DO 710 IEL=IDEB,IMAX1
  188.             MTABLE=ITLAC(IEL)
  189.             IF (MTABLE.EQ.0) GO TO 710
  190.             SEGACT MTABLE*MOD
  191.             L6=MLOTAB
  192.             L=L6
  193.             IF (L.EQ.0) GO TO 713
  194.             DO 711 K=1,L
  195.                ITYPE=MTABTI(K)
  196.                IVA  =MTABII(K)
  197.                CALL TYPFIL (ITYPE,J)
  198.                IF(J.LE.0) GO TO 711
  199.                ITLAC1=KCOLA(J)
  200. C CB215821 : Les procedures ne sont pas sauvees on met un TYPE 'ANNULE'
  201.                IF    (MTABTI(K).EQ.'PROCEDUR') THEN
  202.                  MTABTI(K)='ANNULE'
  203.                ELSEIF(MTABTI(K).EQ.'METHODE ') THEN
  204.                  MTABII(K)=ITLAC2.ITLAC(MTABII(K))
  205.                ELSEIF(j.ne.26.or.ionive.le.20) THEN
  206.                  MTABII(K)=ITLAC1.ITLAC(IVA)
  207.                ENDIF
  208.  
  209.                IF (ITYPE.EQ.'FLOTTANT') RMTABI(K)=XIFLOT(MTABII(K))
  210. C-----SI ON POINTE SUR UNE TABLE IL NE FAUT PAS DESACTIVER
  211.                ITYPE=MTABTV(K)
  212.                IVA  =MTABIV(K)
  213.                CALL  TYPFIL (ITYPE,J)
  214.                IF(J.LE.0 ) GO TO 711
  215.                IF(J.eq.47) GO TO 711
  216.                ITLAC1=KCOLA(J)
  217.                if (j.ne.26.or.ionive.le.20) MTABIV(K)=ITLAC1.ITLAC(IVA)
  218.                IF (ITYPE.EQ.'FLOTTANT') RMTABV(K)=XIFLOT(MTABIV(K))
  219. C-----SI ON POINTE SUR UNE TABLE IL NE FAUT PAS DESACTIVER
  220.  711        CONTINUE
  221.  713        SEGDES MTABLE
  222.  710     CONTINUE
  223.          if(nbesc.ne.0) SEGDES,IPILOC
  224.          GO TO 1098
  225.  715     CONTINUE
  226.          MOTERR(1:8)=ITYPE
  227.          CALL ERREUR (336)
  228.          GO TO 1098
  229. C     *****************************        *****************************
  230.  6011    CONTINUE
  231.          GOTO 1098
  232. C     ******************************** MSOSTU **************************
  233.  512     CONTINUE
  234.          ITLAC1=KCOLA(5)
  235.          ITLAC3=KCOLA(3)
  236.          DO 630 IEL=IDEB,IMAX1
  237.             MSOSTU=ITLAC(IEL)
  238.             IF (MSOSTU.EQ.0) GO TO 630
  239.             SEGACT MSOSTU*MOD
  240.             IVA=ISRAID
  241.             IF(IVA.NE.0)ISRAID=ITLAC3.ITLAC(IVA)
  242.             IVA=ISMASS
  243.             IF(IVA.NE.0)ISMASS=ITLAC3.ITLAC(IVA)
  244.             NS=ISCHAM(/1)
  245.             DO 121 I=1,NS
  246.                IVA= ISCHAM(I)
  247.                IF (IVA.NE.0)ISCHAM(I)= ITLAC1.ITLAC(IVA)
  248.  121        CONTINUE
  249.             SEGDES MSOSTU
  250.  630     CONTINUE
  251.          GO TO 1098
  252. C     ***************************** IMATRI *****************************
  253.  6013    CONTINUE
  254.          GOTO 1098
  255. C     ***************************** MJONCT *****************************
  256.  6014    CONTINUE
  257.          ITLAC1=KCOLA(1)
  258.          ITLAC2=KCOLA(2)
  259.          ITLAC3=KCOLA(12)
  260.          DO 631 IEL=IDEB,IMAX1
  261.             MJONCT=ITLAC(IEL)
  262.             IF (MJONCT.EQ.0) GO TO 631
  263.             SEGACT MJONCT*MOD
  264.             IVA=MJOPOI
  265. CCCC  MJOPOI=ITLAC1.ITLAC(IVA)
  266.             IF(MJOTYP.EQ.'CHOC') THEN
  267.                IF(IVA.NE.0)  MJOPOI=ITLAC2.ITLAC(IVA)
  268.             ELSE
  269.                IF(IVA.NE.0)  MJOPOI=ITLAC1.ITLAC(IVA)
  270.             ENDIF
  271.             DO 632 I=1,ISTRJO(/1)
  272.                IVA=ISTRJO(I)
  273.                IF (IVA.NE.0)ISTRJO(I)= ITLAC3.ITLAC(IVA)
  274.                IVA=IPCHJO(I)
  275.                IF (IVA.NE.0)IPCHJO(I)=ITLAC2.ITLAC(IVA)
  276.                IVA=IPOSJO(I)
  277.                IF (IVA.NE.0) IPOSJO(I)= ITLAC1.ITLAC(IVA)
  278.  632        CONTINUE
  279.             SEGDES MJONCT
  280.  631     CONTINUE
  281.          GO TO 1098
  282. C     ************************ MATTAC **********************************
  283.  6015    CONTINUE
  284.          ITLAC1=KCOLA(1)
  285.          ITLAC3=KCOLA(3)
  286.          ITLAC4=KCOLA(14)
  287.          DO 150 IEL=IDEB,IMAX1
  288.             MATTAC =ITLAC(IEL)
  289.             IF (MATTAC.EQ.0) GO TO 150
  290.             SEGACT MATTAC*MOD
  291.             NN=LISATT(/1)
  292.             DO 151 I=1,NN
  293.                MSOUMA=LISATT(I)
  294.                SEGACT MSOUMA*MOD
  295.                N=IPMATK(/1)
  296.                DO 152 J=1,N
  297.                   IVA=IPMATK(J)
  298.                   IF (IVA.NE.0)IPMATK(J)= ITLAC3.ITLAC(IVA)
  299.  152           CONTINUE
  300.                N=IATREL(/1)
  301.                DO 153 J=1,N
  302.                   IVA=IATREL(J)
  303.                   IF (IVA.NE.0)IATREL(J)=ITLAC4.ITLAC(IVA)
  304.  153           CONTINUE
  305.                IF(IGEOCH.EQ.0) GO TO 156
  306.                MGEOCH=IGEOCH
  307.                SEGACT MGEOCH*MOD
  308.                NI=INORCH(/1)
  309.                DO 154 J=1,NI
  310.                   IVA=INORCH(J)
  311.                   IF (IVA.NE.0)INORCH(J)= ITLAC1.ITLAC(IVA)
  312.  154           CONTINUE
  313.                N1=IMAPRO(/1)
  314.                DO 155 J=1,N1
  315.                   IVA=IMAPRO(J)
  316.                   IF (IVA.NE.0)IMAPRO(J)= ITLAC1.ITLAC(IVA)
  317.  155           CONTINUE
  318.                SEGDES MGEOCH
  319.  156           CONTINUE
  320.                SEGDES MSOUMA
  321.  151        CONTINUE
  322.             SEGDES MATTAC
  323.  150     CONTINUE
  324.          GOTO 1098
  325. C     ***************************** MMATRI *****************************
  326.  6016    CONTINUE
  327.          ITLAC1=KCOLA(1)
  328.          DO 2600 IEL=IDEB,IMAX1
  329.             MMATRI=ITLAC(IEL)
  330.             IF (MMATRI.EQ.0) GO TO 2600
  331.             SEGACT MMATRI*MOD
  332.             IVA=IGEOMA
  333.             IGEOMA=ITLAC1.ITLAC(IVA)
  334.             SEGDES MMATRI
  335.  2600    CONTINUE
  336.          GOTO 1098
  337. C     ************************* MDEFOR*******************************
  338.  6017    CONTINUE
  339.          ITLAC1=KCOLA(1)
  340.          ITLAC2=KCOLA(2)
  341.          ITLAC3=KCOLA(30)
  342.          ITLAC4=KCOLA(38)
  343.          ITLAC5=KCOLA(39)
  344.          DO 2700 IEL=IDEB,IMAX1
  345.             MDEFOR=ITLAC(IEL)
  346.             IF (MDEFOR.EQ.0) GO TO 2700
  347.             SEGACT MDEFOR*MOD
  348.             NDEF=IELDEF(/1)
  349.             DO 2701 I=1,NDEF
  350.                IVA=IELDEF(I)
  351.                IELDEF(I)=ITLAC1.ITLAC(IVA)
  352.                IVA=ICHDEF(I)
  353.                ICHDEF(I)=ITLAC2.ITLAC(IVA)
  354.                IVA=MTVECT(I)
  355.                IF (IVA.NE.0) MTVECT(I)=ITLAC3.ITLAC(IVA)
  356.                IVA=MDCHP(I)
  357.                IF (IVA.NE.0) MDCHP(I)=ITLAC2.ITLAC(IVA)
  358.                IVA=MDCHEL(I)
  359.                IF (IVA.NE.0) MDCHEL(I)=ITLAC5.ITLAC(IVA)
  360.                IVA=MDMODE(I)
  361.                IF (IVA.NE.0) MDMODE(I)=ITLAC4.ITLAC(IVA)
  362.  2701       CONTINUE
  363.             SEGDES MDEFOR
  364.  2700    CONTINUE
  365.          GOTO 1098
  366. C     ***************************MLREEL******************************
  367.  6018    CONTINUE
  368.          GOTO 1098
  369. C     *****************************MLENTI***************************
  370.  6019    CONTINUE
  371.          GOTO 1098
  372. C     ****************************MCHARG*****************************
  373.  6020    CONTINUE
  374.          ITLAC1=KCOLA(2)
  375.          ITLAC2=KCOLA(18)
  376.          ITLAC3=KCOLA(39)
  377.          ITLAC4=KCOLA(10)
  378.          ITLAC5=KCOLA(32)
  379.          ITLAC6=KCOLA(1)
  380.          ITLAC7=KCOLA(50)
  381.          DO 3000 IEL=IDEB,IMAX1
  382.             MCHARG=ITLAC(IEL)
  383.             SEGACT MCHARG
  384.             IF (MCHARG.EQ.0) GO TO 3000
  385.             N=KCHARG(/1)
  386.             DO 3001 I=1,N
  387.                ICHARG=KCHARG(I)
  388.                SEGACT ICHARG*MOD
  389.                IF(CHATYP.EQ.'CHPOINT ') THEN
  390.                   IVA=ABS(ICHPO1)
  391.                   IF(ICHPO1.LT.0) ICHPO1=ITLAC1.ITLAC(IVA)
  392.                   IVA=ABS(ICHPO2)
  393.                   IF(ICHPO2.LT.0) ICHPO2=ITLAC2.ITLAC(IVA)
  394.                   IVA=ABS(ICHPO3)
  395.                   IF(ICHPO3.LT.0) ICHPO3=ITLAC2.ITLAC(IVA)
  396.                ELSE IF (CHATYP.EQ.'MCHAML  ') THEN
  397.                   IVA=ABS(ICHPO1)
  398.                   IF(ICHPO1.LT.0) ICHPO1=ITLAC3.ITLAC(IVA)
  399.                   IVA=ABS(ICHPO2)
  400.                   IF(ICHPO2.LT.0) ICHPO2=ITLAC2.ITLAC(IVA)
  401.                   IVA=ABS(ICHPO3)
  402.                   IF(ICHPO3.LT.0) ICHPO3=ITLAC2.ITLAC(IVA)
  403.                ELSE IF (CHATYP.EQ.'TABLE   ') THEN
  404.                   IVA=ABS(ICHPO1)
  405.                   IF(ICHPO1.LT.0) ICHPO1=ITLAC4.ITLAC(IVA)
  406.                   IVA=ABS(ICHPO2)
  407.                   IF(ICHPO2.LT.0) ICHPO2=ITLAC4.ITLAC(IVA)
  408.                ELSE IF (CHATYP.EQ.'LISTOBJE') THEN
  409.                   IVA=ABS(ICHPO1)
  410.                   IF(ICHPO1.LT.0) ICHPO1=ITLAC7.ITLAC(IVA)
  411.                   IVA=ABS(ICHPO2)
  412.                   IF(ICHPO2.LT.0) ICHPO2=ITLAC2.ITLAC(IVA)
  413.                ENDIF
  414.                IF(CHAMOB(I).EQ.'TRAN') THEN
  415.                   IVA=ABS(ICHPO4)
  416.                   IF(ICHPO4.LT.0) ICHPO4=ITLAC5.ITLAC(IVA)
  417.                   IVA=ABS(ICHPO6)
  418.                   IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA)
  419.                   IVA=ABS(ICHPO7)
  420.                   IF(ICHPO7.LT.0) ICHPO7=ITLAC2.ITLAC(IVA)
  421.                ELSEIF(CHAMOB(I).EQ.'ROTA') THEN
  422.                   IVA=ABS(ICHPO4)
  423.                   IF(ICHPO4.LT.0) ICHPO4=ITLAC5.ITLAC(IVA)
  424.                   IVA=ABS(ICHPO5)
  425.                   IF(ICHPO5.LT.0.AND.IDIM.GT.2) ICHPO5=ITLAC5.ITLAC(IVA)
  426.                   IVA=ABS(ICHPO6)
  427.                   IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA)
  428.                   IVA=ABS(ICHPO7)
  429.                   IF(ICHPO7.LT.0) ICHPO7=ITLAC2.ITLAC(IVA)
  430.                ELSEIF(CHAMOB(I).EQ.'TRAJ') THEN
  431.                   IVA=ABS(ICHPO4)
  432.                   IF(ICHPO4.LT.0) ICHPO4=ITLAC1.ITLAC(IVA)
  433.                   IVA=ABS(ICHPO5)
  434.                   IF(ICHPO5.LT.0) ICHPO5=ITLAC6.ITLAC(IVA)
  435.                   IVA=ABS(ICHPO6)
  436.                   IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA)
  437.                ENDIF
  438.                SEGDES ICHARG
  439.  3001       CONTINUE
  440.             SEGDES MCHARG
  441.  3000    CONTINUE
  442.          GOTO 1098
  443. C     ************************        *****************************
  444.  6021    CONTINUE
  445.          GOTO 1098
  446. C     *********************MEVOLL************************************
  447.  6022    CONTINUE
  448.          ITLACR=KCOLA(18)
  449.          ITLACE=KCOLA(19)
  450.          ITLACM=KCOLA(29)
  451.          DO 3200 IEL=IDEB,IMAX1
  452.             MEVOLL=ITLAC(IEL)
  453.             IF (MEVOLL.EQ.0) GO TO 3200
  454.             SEGACT MEVOLL
  455.             N=IEVOLL(/1)
  456.             DO 3201 I=1,N
  457.                KEVOLL=IEVOLL(I)
  458.                SEGACT KEVOLL*MOD
  459.                IVA=ABS(IPROGX)
  460.                IF(IONIVE.GE.3) THEN
  461.                   IF(TYPX.EQ.'LISTMOTS') THEN
  462.                      ITLAC2=ITLACM
  463.                   ELSEIF(TYPX.EQ.'LISTREEL') THEN
  464.                      ITLAC2=ITLACR
  465.                   ELSEIF(TYPX.EQ.'LISTENTI') THEN
  466.                      ITLAC2=ITLACE
  467.                   ELSE
  468.                      WRITE(IOIMP,*) 'TYPX=',TYPX,' ???'
  469.                      MOTERR(1:8)='restpi'
  470.                      CALL ERREUR(1039)
  471.                   ENDIF
  472.                ELSE
  473.                   ITLAC2=ITLACR
  474.                ENDIF
  475.                IF(IPROGX.LT.0) IPROGX=ITLAC2.ITLAC(IVA)
  476.                IVA=ABS(IPROGY)
  477.                IF(IONIVE.GE.3) THEN
  478.                   IF(TYPY.EQ.'LISTMOTS') THEN
  479.                      ITLAC2=ITLACM
  480.                   ELSEIF(TYPY.EQ.'LISTREEL') THEN
  481.                      ITLAC2=ITLACR
  482.                   ELSEIF(TYPY.EQ.'LISTENTI') THEN
  483.                      ITLAC2=ITLACE
  484.                   ELSE
  485.                      WRITE(IOIMP,*) 'TYPY=',TYPY,' ???'
  486.                      MOTERR(1:8)='restpi'
  487.                      CALL ERREUR(1039)
  488.                   ENDIF
  489.                ELSE
  490.                   ITLAC2=ITLACR
  491.                ENDIF
  492.                IF(IPROGY.LT.0) IPROGY=ITLAC2.ITLAC(IVA)
  493.                SEGDES KEVOLL
  494.  3201       CONTINUE
  495.             SEGDES MEVOLL
  496.  3200    CONTINUE
  497.          GOTO 1098
  498. C     **********************SUPERELE************************************
  499.  6023    CONTINUE
  500.          ITLAC1=KCOLA(1)
  501.          ITLAC3=KCOLA(3)
  502.          ITLAC2=KCOLA( 2)
  503.          ITLAC4=KCOLA(16)
  504.          DO 5230 IEL=IDEB,IMAX1
  505.             MSUPER=ITLAC(IEL)
  506.             IF (MSUPER.EQ.0) GO TO 5230
  507.             SEGACT MSUPER*MOD
  508.             IVA=MRIGTO
  509.             MRIGTO=ITLAC3.ITLAC(IVA)
  510.             IVA=MSUPEL
  511.             MSUPEL=ITLAC1.ITLAC(IVA)
  512.             IVA=MSURAI
  513.             MSURAI=ITLAC3.ITLAC(IVA)
  514.             IVA=MCROUT
  515.             if (iva.le.ITLAC4.ITLAC(/1)) then
  516.               MCROUT=ITLAC4.ITLAC(IVA)
  517.             else
  518.               MCROUT=0
  519.              endif
  520.             IVA=MSUMAS
  521.             IF (IVA.NE.0) MSUMAS=ITLAC3.ITLAC(IVA)
  522.             SEGDES MSUPER
  523.  5230    CONTINUE
  524.          GOTO 1098
  525. C     **********************LOGIQUE***********************************
  526.  6024    CONTINUE
  527.          GOTO 1098
  528. C     **********************FLOTTANT**********************************
  529.  6025    CONTINUE
  530.          GOTO 1098
  531. C     ********************** ENTIER **********************************
  532.  6026    CONTINUE
  533.          GOTO 1098
  534. C     ********************** MOT   ***********************************
  535.  6027    CONTINUE
  536.          GOTO 1098
  537. C     ********************** TEXTE ***********************************
  538.  6028    CONTINUE
  539.          GOTO 1098
  540. C     ********************** LISTMOTS*********************************
  541.  6029    CONTINUE
  542.          GOTO 1098
  543. C     ********************** VECTEUR**********************************
  544.  6030    CONTINUE
  545.          ITLAC1=KCOLA(1)
  546.          ITLAC2=KCOLA( 2)
  547.          DO 5300 IEL=IDEB,IMAX1
  548.             MVECTE=ITLAC(IEL)
  549.             IF (MVECTE.EQ.0) GO TO 5300
  550.             SEGACT MVECTE*MOD
  551.             NVEC=ICHPO(/1)
  552.             DO 5301 I=1,NVEC
  553. *  PAS UTILISE ACTUELLEMENT
  554. *     IVA=IGEOV(I)
  555. *     IGEOV(I)=ITLAC1.ITLAC(IVA)
  556.                IVA=ICHPO(I)
  557.                ICHPO(I)=ITLAC2.ITLAC(IVA)
  558.  5301       CONTINUE
  559.             SEGDES MVECTE
  560.  5300    CONTINUE
  561.          GOTO 1098
  562. C     ********************** VECTDOUB*********************************
  563.  6031    CONTINUE
  564.          GOTO 1098
  565. C     ********************** POINT   *********************************
  566.  6032    CONTINUE
  567.          GOTO 1098
  568. C     ********************** CONFIG  *********************************
  569.  6033    CONTINUE
  570.          GOTO 1098
  571. C     *********************** LISTCHPO ******************************
  572.  534     CONTINUE
  573.          ITLAC2=KCOLA(2)
  574.          DO 340 IEL=IDEB,IMAX1
  575.             MLCHPO =ITLAC(IEL)
  576.             IF (MLCHPO.EQ.0) GO TO 340
  577.             SEGACT MLCHPO*MOD
  578.             N1=ICHPOI(/1)
  579.             DO 341 I=1,N1
  580.                IVA=ICHPOI(I)
  581.                ICHPOI(I)=ITLAC2.ITLAC(IVA)
  582.  341        CONTINUE
  583.             SEGDES MLCHPO
  584.  340     CONTINUE
  585.          GO TO 1098
  586. C     ************************** BASEM ********************************
  587.  6035    CONTINUE
  588.          ITLAC1=KCOLA(12)
  589.          ITLAC2=KCOLA(8 )
  590.          ITLAC3=KCOLA(15)
  591.          DO 350 IEL=IDEB,IMAX1
  592.             MBASEM=ITLAC(IEL)
  593.             IF (MBASEM.EQ.0) GO TO 350
  594.             SEGACT MBASEM
  595.             N=LISBAS(/1)
  596.             IF (N.EQ.0) GO TO 352
  597.             DO 351 I=1,N
  598.                MSOBAS=LISBAS(I)
  599.                SEGACT MSOBAS*MOD
  600.                IVA=ABS(IBSTRM(1))
  601. *      IBSTRM(1)=ITLAC1.ITLAC(IVA)            MILL 3 / 9 /92
  602.                IF(IBSTRM(1).LT.0) IBSTRM(1)=ITLAC1.ITLAC(IVA)
  603.                IVA=ABS(IBSTRM(2))
  604. *      IBSTRM(2)=ITLAC2.ITLAC(IVA)
  605.                IF(IBSTRM(2).LT.0) IBSTRM(2)=ITLAC2.ITLAC(IVA)
  606.                IVA=ABS(IBSTRM(3))
  607. *      IBSTRM(3)=ITLAC2.ITLAC(IVA)
  608.                IF(IBSTRM(3).LT.0) IBSTRM(3)=ITLAC2.ITLAC(IVA)
  609.  353           CONTINUE
  610.                IVA=ABS(IBSTRM(4))
  611. *      IBSTRM(4)=ITLAC3.ITLAC(IVA)
  612.                IF(IBSTRM(4).LT.0) IBSTRM(4)=ITLAC3.ITLAC(IVA)
  613.  354           CONTINUE
  614.                IVA=ABS(IBSTRM(5))
  615. *      IBSTRM(5)=ITLAC2.ITLAC(IVA)
  616.                IF(IBSTRM(5).LT.0) IBSTRM(5)=ITLAC2.ITLAC(IVA)
  617.  355           CONTINUE
  618.                SEGDES MSOBAS
  619.  351        CONTINUE
  620.  352        SEGDES MBASEM
  621.  350     CONTINUE
  622.          GOTO 1098
  623. C     ************************ MMODEL **********************************
  624.  6038    CONTINUE
  625.          CALL RESMMO(ICOLAC,ITLACC,IDEB,IMAX1,IONIVE)
  626.          GOTO 1098
  627. C     ************************ MCHAML **********************************
  628.  6039    CONTINUE
  629.          CALL RESCHA(ICOLAC,ITLACC,IMAX1,IDEB)
  630.          GOTO 1098
  631. C     ************************ MINTE  **********************************
  632.  6040    CONTINUE
  633.          GOTO 1098
  634. C     ************************ MNUAGE  ******************************
  635.  6041    CONTINUE
  636.          CALL RESNUA(ICOLAC,ITLACC,IMAX1)
  637.          GOTO 1098
  638. C     ************************* MATRAK *********************************
  639.  6042    CONTINUE
  640.          CALL RESMAK(ICOLAC,ITLACC,IMAX1,IDEB)
  641.          GOTO 1098
  642. C     ************************* MATRIK ********************************
  643.  6043    CONTINUE
  644.          CALL RESMIK(ICOLAC,ITLACC,IMAX1,IDEB)
  645.          GOTO 1098
  646. C     ************************        ******************************
  647.  6045    CONTINUE
  648.          GO TO 1098
  649. C     ************************ ANNOTATI ****************************
  650.  6049    CONTINUE
  651.          DO 450 IEL=IDEB,IMAX1
  652.            ITLAC2=KCOLA(1)
  653.            MANNOT=itlac(iel)
  654.            SEGACT,MANNOT
  655.            NBANNO = MANNOT.ICLAS(/1)
  656.            DO IANO=1,NBANNO
  657.              IF(MANNOT.ICLAS(IANO) .EQ. 2)THEN
  658.                METIQU = MANNOT.ISEGT(IANO)
  659.                SEGACT,METIQU*MOD
  660.                iva2 = METIQU.INUPT
  661.                IF (iva2.LT.0) METIQU.INUPT =ITLAC2.ITLAC(ABS(iva2))
  662.                SEGDES,METIQU
  663.              ENDIF
  664.            ENDDO
  665.            SEGDES,MANNOT
  666.  450     CONTINUE
  667.          GOTO 1098
  668. C     ************************ LISTOBJE ****************************
  669.  6050    CONTINUE
  670.          DO 460 IEL=IDEB,IMAX1
  671.             MLOBJE=ITLAC(IEL)
  672.             IF (MLOBJE.EQ.0) GOTO 460
  673.             SEGACT, MLOBJE*MOD
  674.             N1=LISOBJ(/1)
  675.             IF (N1.LE.0) GOTO 460
  676.             ITYPE = TYPOBJ
  677.             CALL TYPFIL(ITYPE,J)
  678.             ITLAC2 = KCOLA(J)
  679.             DO 461 IL=1,N1
  680.               IVA = LISOBJ(IL)
  681.               IF (IVA.NE.0) LISOBJ(IL) = ITLAC2.ITLAC(IVA)
  682.  461        CONTINUE
  683.             SEGDES, MLOBJE
  684.  460     CONTINUE
  685.          GOTO 1098
  686. C     ************************ IMODEL **********************************
  687.  6051    CONTINUE
  688.          DO IEL = IDEB, IMAX1
  689.            IIMODL = itlacc.ITLAC(IEL)
  690.            IF (IIMODL.NE.0) CALL RESIMO(ICOLAC,IIMODL,IONIVE)
  691.          ENDDO
  692.          GOTO 1098
  693. C     ******************************************************************
  694.  1098    CONTINUE
  695. C*********************************************************************
  696.  1099 CONTINUE
  697.       SEGDES ICOLAC
  698.  
  699.       RETURN
  700.       END
  701.  
  702.  

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