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    OF166741  25/02/20    21:17:33     12165          
  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.          ITLACM=KCOLA(29)
  450.          ITLAC2=ITLACR
  451.          ITLAC2=ITLACM
  452.          DO 3200 IEL=IDEB,IMAX1
  453.             MEVOLL=ITLAC(IEL)
  454.             IF (MEVOLL.EQ.0) GO TO 3200
  455.             SEGACT MEVOLL
  456.             N=IEVOLL(/1)
  457.             DO 3201 I=1,N
  458.                KEVOLL=IEVOLL(I)
  459.                SEGACT KEVOLL*MOD
  460.                IVA=ABS(IPROGX)
  461.                IF(IONIVE.GE.3) THEN
  462.                   IF(TYPX.EQ.'LISTMOTS') THEN
  463.                      ITLAC2=ITLACM
  464.                   ELSEIF(TYPX.EQ.'LISTREEL') THEN
  465.                      ITLAC2=ITLACR
  466.                   ENDIF
  467.                ENDIF
  468.                IF(IPROGX.LT.0) IPROGX=ITLAC2.ITLAC(IVA)
  469.                IVA=ABS(IPROGY)
  470.                IF(IONIVE.GE.3) THEN
  471.                   IF(TYPY.EQ.'LISTMOTS') THEN
  472.                      ITLAC2=ITLACM
  473.                   ELSEIF(TYPY.EQ.'LISTREEL') THEN
  474.                      ITLAC2=ITLACR
  475.                   ENDIF
  476.                ENDIF
  477.                IF(IPROGY.LT.0) IPROGY=ITLAC2.ITLAC(IVA)
  478.                SEGDES KEVOLL
  479.  3201       CONTINUE
  480.             SEGDES MEVOLL
  481.  3200    CONTINUE
  482.          ITLAC2=ITLACR
  483.          ITLAC2=ITLACM
  484.          GOTO 1098
  485. C     **********************SUPERELE************************************
  486.  6023    CONTINUE
  487.          ITLAC1=KCOLA(1)
  488.          ITLAC3=KCOLA(3)
  489.          ITLAC2=KCOLA( 2)
  490.          ITLAC4=KCOLA(16)
  491.          DO 5230 IEL=IDEB,IMAX1
  492.             MSUPER=ITLAC(IEL)
  493.             IF (MSUPER.EQ.0) GO TO 5230
  494.             SEGACT MSUPER*MOD
  495.             IVA=MRIGTO
  496.             MRIGTO=ITLAC3.ITLAC(IVA)
  497.             IVA=MSUPEL
  498.             MSUPEL=ITLAC1.ITLAC(IVA)
  499.             IVA=MSURAI
  500.             MSURAI=ITLAC3.ITLAC(IVA)
  501.             IVA=MCROUT
  502.             if (iva.le.ITLAC4.ITLAC(/1)) then
  503.               MCROUT=ITLAC4.ITLAC(IVA)
  504.             else
  505.               MCROUT=0
  506.              endif
  507.             IVA=MSUMAS
  508.             IF (IVA.NE.0) MSUMAS=ITLAC3.ITLAC(IVA)
  509.             SEGDES MSUPER
  510.  5230    CONTINUE
  511.          GOTO 1098
  512. C     **********************LOGIQUE***********************************
  513.  6024    CONTINUE
  514.          GOTO 1098
  515. C     **********************FLOTTANT**********************************
  516.  6025    CONTINUE
  517.          GOTO 1098
  518. C     ********************** ENTIER **********************************
  519.  6026    CONTINUE
  520.          GOTO 1098
  521. C     ********************** MOT   ***********************************
  522.  6027    CONTINUE
  523.          GOTO 1098
  524. C     ********************** TEXTE ***********************************
  525.  6028    CONTINUE
  526.          GOTO 1098
  527. C     ********************** LISTMOTS*********************************
  528.  6029    CONTINUE
  529.          GOTO 1098
  530. C     ********************** VECTEUR**********************************
  531.  6030    CONTINUE
  532.          ITLAC1=KCOLA(1)
  533.          ITLAC2=KCOLA( 2)
  534.          DO 5300 IEL=IDEB,IMAX1
  535.             MVECTE=ITLAC(IEL)
  536.             IF (MVECTE.EQ.0) GO TO 5300
  537.             SEGACT MVECTE*MOD
  538.             NVEC=ICHPO(/1)
  539.             DO 5301 I=1,NVEC
  540. *  PAS UTILISE ACTUELLEMENT
  541. *     IVA=IGEOV(I)
  542. *     IGEOV(I)=ITLAC1.ITLAC(IVA)
  543.                IVA=ICHPO(I)
  544.                ICHPO(I)=ITLAC2.ITLAC(IVA)
  545.  5301       CONTINUE
  546.             SEGDES MVECTE
  547.  5300    CONTINUE
  548.          GOTO 1098
  549. C     ********************** VECTDOUB*********************************
  550.  6031    CONTINUE
  551.          GOTO 1098
  552. C     ********************** POINT   *********************************
  553.  6032    CONTINUE
  554.          GOTO 1098
  555. C     ********************** CONFIG  *********************************
  556.  6033    CONTINUE
  557.          GOTO 1098
  558. C     *********************** LISTCHPO ******************************
  559.  534     CONTINUE
  560.          ITLAC2=KCOLA(2)
  561.          DO 340 IEL=IDEB,IMAX1
  562.             MLCHPO =ITLAC(IEL)
  563.             IF (MLCHPO.EQ.0) GO TO 340
  564.             SEGACT MLCHPO*MOD
  565.             N1=ICHPOI(/1)
  566.             DO 341 I=1,N1
  567.                IVA=ICHPOI(I)
  568.                ICHPOI(I)=ITLAC2.ITLAC(IVA)
  569.  341        CONTINUE
  570.             SEGDES MLCHPO
  571.  340     CONTINUE
  572.          GO TO 1098
  573. C     ************************** BASEM ********************************
  574.  6035    CONTINUE
  575.          ITLAC1=KCOLA(12)
  576.          ITLAC2=KCOLA(8 )
  577.          ITLAC3=KCOLA(15)
  578.          DO 350 IEL=IDEB,IMAX1
  579.             MBASEM=ITLAC(IEL)
  580.             IF (MBASEM.EQ.0) GO TO 350
  581.             SEGACT MBASEM
  582.             N=LISBAS(/1)
  583.             IF (N.EQ.0) GO TO 352
  584.             DO 351 I=1,N
  585.                MSOBAS=LISBAS(I)
  586.                SEGACT MSOBAS*MOD
  587.                IVA=ABS(IBSTRM(1))
  588. *      IBSTRM(1)=ITLAC1.ITLAC(IVA)            MILL 3 / 9 /92
  589.                IF(IBSTRM(1).LT.0) IBSTRM(1)=ITLAC1.ITLAC(IVA)
  590.                IVA=ABS(IBSTRM(2))
  591. *      IBSTRM(2)=ITLAC2.ITLAC(IVA)
  592.                IF(IBSTRM(2).LT.0) IBSTRM(2)=ITLAC2.ITLAC(IVA)
  593.                IVA=ABS(IBSTRM(3))
  594. *      IBSTRM(3)=ITLAC2.ITLAC(IVA)
  595.                IF(IBSTRM(3).LT.0) IBSTRM(3)=ITLAC2.ITLAC(IVA)
  596.  353           CONTINUE
  597.                IVA=ABS(IBSTRM(4))
  598. *      IBSTRM(4)=ITLAC3.ITLAC(IVA)
  599.                IF(IBSTRM(4).LT.0) IBSTRM(4)=ITLAC3.ITLAC(IVA)
  600.  354           CONTINUE
  601.                IVA=ABS(IBSTRM(5))
  602. *      IBSTRM(5)=ITLAC2.ITLAC(IVA)
  603.                IF(IBSTRM(5).LT.0) IBSTRM(5)=ITLAC2.ITLAC(IVA)
  604.  355           CONTINUE
  605.                SEGDES MSOBAS
  606.  351        CONTINUE
  607.  352        SEGDES MBASEM
  608.  350     CONTINUE
  609.          GOTO 1098
  610. C     ************************ MMODEL **********************************
  611.  6038    CONTINUE
  612.          CALL RESMMO(ICOLAC,ITLACC,IDEB,IMAX1,IONIVE)
  613.          GOTO 1098
  614. C     ************************ MCHAML **********************************
  615.  6039    CONTINUE
  616.          CALL RESCHA(ICOLAC,ITLACC,IMAX1,IDEB)
  617.          GOTO 1098
  618. C     ************************ MINTE  **********************************
  619.  6040    CONTINUE
  620.          GOTO 1098
  621. C     ************************ MNUAGE  ******************************
  622.  6041    CONTINUE
  623.          CALL RESNUA(ICOLAC,ITLACC,IMAX1)
  624.          GOTO 1098
  625. C     ************************* MATRAK *********************************
  626.  6042    CONTINUE
  627.          CALL RESMAK(ICOLAC,ITLACC,IMAX1,IDEB)
  628.          GOTO 1098
  629. C     ************************* MATRIK ********************************
  630.  6043    CONTINUE
  631.          CALL RESMIK(ICOLAC,ITLACC,IMAX1,IDEB)
  632.          GOTO 1098
  633. C     ************************        ******************************
  634.  6045    CONTINUE
  635.          GO TO 1098
  636. C     ************************ ANNOTATI ****************************
  637.  6049    CONTINUE
  638.          DO 450 IEL=IDEB,IMAX1
  639.            ITLAC2=KCOLA(1)
  640.            MANNOT=itlac(iel)
  641.            SEGACT,MANNOT
  642.            NBANNO = MANNOT.ICLAS(/1)
  643.            DO IANO=1,NBANNO
  644.              IF(MANNOT.ICLAS(IANO) .EQ. 2)THEN
  645.                METIQU = MANNOT.ISEGT(IANO)
  646.                SEGACT,METIQU*MOD
  647.                iva2 = METIQU.INUPT
  648.                IF (iva2.LT.0) METIQU.INUPT =ITLAC2.ITLAC(ABS(iva2))
  649.                SEGDES,METIQU
  650.              ENDIF
  651.            ENDDO
  652.            SEGDES,MANNOT
  653.  450     CONTINUE
  654.          GOTO 1098
  655. C     ************************ LISTOBJE ****************************
  656.  6050    CONTINUE
  657.          DO 460 IEL=IDEB,IMAX1
  658.             MLOBJE=ITLAC(IEL)
  659.             IF (MLOBJE.EQ.0) GOTO 460
  660.             SEGACT, MLOBJE*MOD
  661.             N1=LISOBJ(/1)
  662.             IF (N1.LE.0) GOTO 460
  663.             ITYPE = TYPOBJ
  664.             CALL TYPFIL(ITYPE,J)
  665.             ITLAC2 = KCOLA(J)
  666.             DO 461 IL=1,N1
  667.               IVA = LISOBJ(IL)
  668.               IF (IVA.NE.0) LISOBJ(IL) = ITLAC2.ITLAC(IVA)
  669.  461        CONTINUE
  670.             SEGDES, MLOBJE
  671.  460     CONTINUE
  672.          GOTO 1098
  673. C     ************************ IMODEL **********************************
  674.  6051    CONTINUE
  675.          DO IEL = IDEB, IMAX1
  676.            IIMODL = itlacc.ITLAC(IEL)
  677.            IF (IIMODL.NE.0) CALL RESIMO(ICOLAC,IIMODL,IONIVE)
  678.          ENDDO
  679.          GOTO 1098
  680. C     ******************************************************************
  681.  1098    CONTINUE
  682. C*********************************************************************
  683.  1099 CONTINUE
  684.       SEGDES ICOLAC
  685.  
  686.       RETURN
  687.       END
  688.  
  689.  
  690.  
  691.  

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