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

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