Télécharger la plaquette Cast3M


fr en

Télécharger sort5.eso

Retour à la liste

Numérotation des lignes : 

sort5

  1. C SORT5     SOURCE    CB215821  20/11/25    13:40:13     10792          
  2.       SUBROUTINE SORT5(ICOLAC)
  3. C=======================================================================
  4. C   RESTAURATION DE LA NUMEROTATION DANS LES PILES
  5. C
  6. C   PROGRAMME PAR FARVACQUE
  7. C   APPELE PAR REST RESTFO
  8. C   N'APPELLE RIEN
  9. C=======================================================================
  10. C  TABLEAU KCOLA :
  11. C    1  MELEME  2 CHPOIN  3 MRIGID  4         5         6 MCLSTR
  12. C    7  MELSTR  8 MSOLUT  9 MSTRUC 10        11        12 MSOSTU
  13. C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  14. C   19  MLENTI 20 MCHARG 21        22 MEVOLL
  15. C=======================================================================
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8(A-H,O-Z)
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMELEME
  22. -INC SMCHPOI
  23. -INC SMRIGID
  24. -INC SMMATRI
  25. -INC SMSOLUT
  26. -INC SMLENTI
  27. -INC SMLREEL
  28. -INC SMDEFOR
  29. -INC SMCHARG
  30. -INC SMEVOLL
  31. -INC TMCOLAC
  33. C
  34.       SEGMENT ILIST(ILL)
  35.       SEGMENT ISORTA(0)
  36.  
  37.       CHARACTER*(8) ITYPE
  38. C
  39.       SEGACT ICOLAC
  40.       NITLAC=ICOLA(/1)
  41. C
  42. C  **** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC
  43. C
  44.       DO 1099 IFILE=1,NITLAC
  45.       ITLACC=KCOLA(IFILE)
  46.       IMAX1=ITLAC(/1)
  47.       IF(IMAX1.EQ.0) GO TO 1099
  48.       IP1=ICOLA(IFILE)
  49.       GO TO (6001,6002,6003,1099,1099,1099,1099,6008,1099,1099,
  50.      &       1099,1099,6013,1099,1099,6016,6017,6018,6019,6020,
  51.      &       1099,6022),IFILE
  52. C Au cas où un ICOLAC plus grand serait passé en argument ...
  53.       GOTO 1099
  54. C     ****************************** MELEME ****************************
  55.  6001 CONTINUE
  56.       DO 20 I=1,IMAX1
  57.       MELEME=ITLAC(I)
  58.       SEGACT MELEME
  59.       IF (LISOUS(/1).EQ.0) GOTO 21
  60.       DO 1003 J=1,LISOUS(/1)
  61.       LISOUS(J)=ITLAC(LISOUS(J))
  62.  1003 CONTINUE
  63.   21  CONTINUE
  64.       IF (LISREF(/1).EQ.0) GOTO 25
  65.       DO 1004 J=1,LISREF(/1)
  66.       LISREF(J)=ITLAC(LISREF(J))
  67.  1004 CONTINUE
  68.   25  CONTINUE
  69.       SEGDES MELEME
  70.   20  CONTINUE
  71.       GOTO 1098
  72. C     **************************CHPOINT*********************************
  73.  6002 CONTINUE
  74.       ITLAC1=KCOLA(1)
  75.       DO 1101 IEL=1,IMAX1
  76.       MCHPOI=ITLAC(IEL)
  77.       SEGACT MCHPOI
  78.       NSOUPO=IPCHP(/1)
  79.       DO 1103 ISOU=1,NSOUPO
  80.       MSOUPO=IPCHP(ISOU)
  81.       SEGACT MSOUPO
  82.       IVA=IGEOC
  83.       IGEOC=ITLAC1.ITLAC(IVA)
  84.       SEGDES MSOUPO
  85.  1103 CONTINUE
  86.       SEGDES MCHPOI
  87.  1101 CONTINUE
  88.       GOTO 1098
  89. C     ***********************MRIGID*************************************
  90.  6003 CONTINUE
  91.       ITLAC1=KCOLA(1)
  92.       ITLAC2=KCOLA(13)
  93.       ITLAC3=KCOLA(16)
  94. *     ITLAC4=KCOLA(11)        ON REMPLACE PAR UN MELEME    AM 12/2/90
  95.       DO 1202 IEL=1,IMAX1
  96.       MRIGID=ITLAC(IEL)
  97.       SEGACT MRIGID
  98.       NRIGEL=IRIGEL(/2)
  99.       IF(IMGEO1.EQ.0) GOTO 1204
  100.       IMGEOD=IMGEO1
  101.       SEGACT IMGEOD
  102.       DO 1205 I=1,IMGEOR(/1)
  103.       IVA=IMGEOR(I)
  104.       IMGEOR(I)=ITLAC1.ITLAC(IVA)
  105.  1205 CONTINUE
  106.       SEGDES IMGEOD
  107.  1204 CONTINUE
  108.        IF(IMGEO1.EQ.0) GOTO 1208
  109.       MVECRI=IVECRI
  110.       SEGACT MVECRI*mod
  111.       DO 1209 I=1,MELZON(/1)
  112.       IVA=MELZON(I)
  113.       MELZON(I)=ITLAC1.ITLAC(IVA)
  114.  1209 CONTINUE
  115.       SEGDES MVECRI
  116.  1208 CONTINUE
  117.       IVA=ICHOLE
  118.       IF(IVA   .NE.0) ICHOLE=ITLAC3.ITLAC(IVA)
  119.       DO 1203 IR=1,NRIGEL
  120.       IVA=IRIGEL(1,IR)
  121.       IRIGEL(1,IR)=ITLAC1.ITLAC(IVA)
  122.       IVA=IRIGEL(2,IR)
  123.       IF(IVA.NE.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA)
  124. *      IVA=IRIGEL(4,IR)
  125. *      IRIGEL(4,IR)=ITLAC2.ITLAC(IVA)
  126.  1203 CONTINUE
  127.       SEGDES MRIGID
  128.  1202 CONTINUE
  129.       GOTO 1098
  130. C     ***************************        *******************************
  131.  6004 CONTINUE
  132.       GOTO 1098
  133. C     ***************************        *******************************
  134.  6005 CONTINUE
  135.       GOTO 1098
  136. C     ****************************MSOLUT********************************
  137.  6008 CONTINUE
  138.       DO 1800 IEL=1,IMAX1
  139.       MSOLUT=ITLAC(IEL)
  140.       SEGACT MSOLUT
  141.       IF(MSOLIS(3).LE.0) GOTO 1802
  142.       ITLAC1=KCOLA(1)
  143.       IVA=MSOLIS(3)
  144.       MSOLIS(3)=ITLAC1.ITLAC(IVA)
  145.       GOTO 1803
  146.  1802 CONTINUE
  147.       MSOLIS(3)=-MSOLIS(3)
  148.  1803 CONTINUE
  149.       SEGDES MSOLUT
  150.  1800 CONTINUE
  151.       GOTO 1098
  152. C     *****************************        *****************************
  153.  6011 CONTINUE
  154.       GOTO 1098
  155. C     ***************************** IMATRI *****************************
  156.  6013 CONTINUE
  157.       GOTO 1098
  158. C     ***************************** MMATRI *****************************
  159.  6016 CONTINUE
  160.       ITLAC1=KCOLA(1)
  161.       DO 2600 IEL=1,IMAX1
  162.       MMATRI=ITLAC(IEL)
  163.       SEGACT MMATRI
  164.       IVA=IGEOMA
  165.       IGEOMA=ITLAC1.ITLAC(IVA)
  166.       SEGDES MMATRI
  167.  2600 CONTINUE
  168.       GOTO 1098
  169. C     ************************* MDEFOR*******************************
  170.  6017 CONTINUE
  171.       ITLAC1=KCOLA(1)
  172.       ITLAC2=KCOLA(2)
  173.       ITLAC3=KCOLA(30)
  174.       ITLAC4=KCOLA(38)
  175.       ITLAC5=KCOLA(39)
  176.       DO 2700 IEL=1,IMAX1
  177.       MDEFOR=ITLAC(IEL)
  178.       SEGACT MDEFOR
  179.       NDEF=IELDEF(/1)
  180.       DO 2701 I=1,NDEF
  181.       IVA=IELDEF(I)
  182.       IELDEF(I)=ITLAC1.ITLAC(IVA)
  183.       IVA=ICHDEF(I)
  184.       ICHDEF(I)=ITLAC2.ITLAC(IVA)
  185.       IVA=MTVECT(I)
  186.       MTVECT(I)=ITLAC3.ITLAC(IVA)
  187.       IVA=MDCHP(I)
  188.       MDCHP(I)=ITLAC2.ITLAC(IVA)
  189.       IVA=MDCHEL(I)
  190.       MDCHEL(I)=ITLAC5.ITLAC(IVA)
  191.       IVA=MDMODE(I)
  192.       MDMODE(I)=ITLAC4.ITLAC(IVA)
  193.  2701 CONTINUE
  194.       SEGDES MDEFOR
  195.  2700 CONTINUE
  196.       GOTO 1098
  197. C     ***************************MLREEL******************************
  198.  6018 CONTINUE
  199.       GOTO 1098
  200. C     *****************************MLENTI***************************
  201.  6019 CONTINUE
  202.       GOTO 1098
  203. C     ****************************MCHARG*****************************
  204.  6020 CONTINUE
  205.       ITLAC1=KCOLA(2)
  206.       ITLAC2=KCOLA(18)
  207.       ITLAC3=KCOLA(39)
  208.       ITLAC4=KCOLA(10)
  209.       ITLAC5=KCOLA(32)
  210.       ITLAC6=KCOLA(1)
  211.       DO 3000 IEL=1,IMAX1
  212.          MCHARG=ITLAC(IEL)
  213.          SEGACT MCHARG
  214.          N=KCHARG(/1)
  215.          DO 3001 I=1,N
  216.             ICHARG=KCHARG(I)
  217.             SEGACT ICHARG
  218.             IF(CHATYP.EQ.'CHPOINT ') THEN
  219.                IVA=ICHPO1
  220.                ICHPO1=ITLAC1.ITLAC(IVA)
  221.                IVA=ICHPO2
  222.                ICHPO2=ITLAC2.ITLAC(IVA)
  223.                IVA=ICHPO3
  224.                ICHPO3=ITLAC2.ITLAC(IVA)
  225.             ELSE IF (CHATYP.EQ.'MCHAML  ') THEN
  226.                IVA=ICHPO1
  227.                IICHPO1=ITLAC3.ITLAC(IVA)
  228.                IVA=ICHPO2
  229.                ICHPO2=ITLAC2.ITLAC(IVA)
  230.                IVA=ICHPO3
  231.                ICHPO3=ITLAC2.ITLAC(IVA)
  232.             ELSE IF (CHATYP.EQ.'TABLE   ') THEN
  233.                IVA=ICHPO1
  234.                ICHPO1=ITLAC4.ITLAC(IVA)
  235.                IVA=ICHPO2
  236.                ICHPO2=ITLAC4.ITLAC(IVA)
  237.             ENDIF
  238.             IF(CHAMOB(I).EQ.'TRAN') THEN
  239.                IVA=ICHPO4
  240.                ICHPO4=ITLAC5.ITLAC(IVA)
  241.                IVA=ICHPO6
  242.                ICHPO6=ITLAC2.ITLAC(IVA)
  243.                IVA=ICHPO7
  244.                ICHPO7=ITLAC2.ITLAC(IVA)
  245.             ELSEIF(CHAMOB(I).EQ.'ROTA') THEN
  246.                IVA=ICHPO4
  247.                ICHPO4=ITLAC5.ITLAC(IVA)
  248.                IVA=ICHPO5
  249.                IF(IDIM.GT.2) ICHPO5=ITLAC5.ITLAC(IVA)
  250.                IVA=ICHPO6
  251.                ICHPO6=ITLAC2.ITLAC(IVA)
  252.                IVA=ICHPO7
  253.                ICHPO7=ITLAC2.ITLAC(IVA)
  254.             ELSEIF(CHAMOB(I).EQ.'TRAJ') THEN
  255.                IVA=ICHPO4
  256.                ICHPO4=ITLAC1.ITLAC(IVA)
  257.                IVA=ICHPO5
  258.                ICHPO5=ITLAC6.ITLAC(IVA)
  259.                IVA=ICHPO6
  260.                ICHPO6=ITLAC2.ITLAC(IVA)
  261.             ENDIF
  262.             SEGDES ICHARG
  263.  3001    CONTINUE
  264.          SEGDES MCHARG
  265.  3000 CONTINUE
  266.       GOTO 1098
  267. C     ************************        *****************************
  268.  6021 CONTINUE
  269.       GOTO 1098
  270. C     *********************MEVOLL************************************
  271.  6022 CONTINUE
  272.       ITLAC1=KCOLA(1)
  273.       ITLAC2=KCOLA(18)
  274.       DO 3200 IEL=1,IMAX1
  275.       MEVOLL=ITLAC(IEL)
  276.       SEGACT MEVOLL
  277.       N=IEVOLL(/1)
  278.       DO 3201 I=1,N
  279.       KEVOLL=IEVOLL(I)
  280.       SEGACT KEVOLL
  281.       IVA=IPROGX
  282.       IPROGX=ITLAC2.ITLAC(IVA)
  283.       IVA=IPROGY
  284.       IPROGY=ITLAC2.ITLAC(IVA)
  285.       SEGDES KEVOLL
  286.  3201 CONTINUE
  287.       SEGDES MEVOLL
  288.  3200 CONTINUE
  289.       GOTO 1098
  290. C     ******************************************************************
  291.  1098 CONTINUE
  292. C
  293.  1099 CONTINUE
  294.       SEGDES ICOLAC
  295. C
  296.       RETURN
  297.       END
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  

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