Télécharger la plaquette Cast3M


fr en

Télécharger xmng6.eso

Retour à la liste

Numérotation des lignes : 

xmng6

  1. C XMNG6     SOURCE    PV        20/09/26    21:20:33     10724          
  2.       SUBROUTINE XMNG6(ILISSE,ITLACC,ISLIS)
  3. *
  4.       IMPLICIT INTEGER(I-N)
  5.       DIMENSION LIDMAT(10),LKMMT(10)
  6. *
  7. *
  8.       SEGMENT ISLIS(NP)
  9. *      SEGMENT IBLIS(ISLIS(/1))
  10. *                     SEGMENT BIDON POUR REMPLACER LES TROP NOMBREUSES
  11. *                     DECLARATION
  12. *      SEGMENT ISEG(0)
  13. *
  14. *      POINTEUR PTR.MATRAK
  15. *
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. *-INC CCNOYAU
  19. -INC TMCOLAC
  21. *
  22. *     CAS DES MATRIK
  23. *
  24. *
  25. C     WRITE(IOIMP,*)' ON FAIT LE MENAGE DES MATRIK '
  26.  
  27.       IF (ITLAC(/1).EQ.0) RETURN
  28.       DO 421 I=1,ITLAC(/1)
  29.          MATRIK=ITLAC(I)
  30.          ISLIS((MATRIK-1)/npgcd)=1
  31. C       WRITE(IOIMP,*)' MATRIK=',MATRIK
  32.          SEGACT MATRIK
  33. C       WRITE(IOIMP,*)' liste : ksym,kminc,kmincp,kmincd,kizm=',
  34. C    &ksym,kminc,kmincp,kmincd,kizm
  35. C       WRITE(IOIMP,*)' liste : kispgt,kispgp,kispgd=',
  36. C    &kispgt,kispgp,kispgd
  37. C       WRITE(IOIMP,*)' liste : knttt,knttp,knttd=',
  38. C    &knttt,knttp,knttd
  39. C       WRITE(IOIMP,*)' KIDMAT :',(kidmat(i1),i1=1,9)
  40. C       WRITE(IOIMP,*)' KKMMT  :',(kkmmt (i1),i1=1,7)
  41.  
  42.  
  43.  
  44.  
  45.          NMATRI=IRIGEL(/2)
  46.          DO 422 N=1,NMATRI
  47. C      WRITE(IOIMP,*)' N=',N
  48. C      WRITE(IOIMP,*)' IRIGEL(i1,n)=',(IRIGEL(i1,n),i1=1,7)
  49.             IMATRI=IRIGEL(4,N)
  50.             IF (IMATRI.NE.0) THEN
  51.                SEGACT IMATRI
  52.                ISLIS((IMATRI-1)/npgcd)=1
  53. C       WRITE(IOIMP,*)' IMATRI=',IMATRI
  54.                NBSOUS=LIZAFM(/1)
  55.                NBME  =LIZAFM(/2)
  56.                DO 423 L=1,NBSOUS
  57.                   DO 4231 M=1,NBME
  58.                      IZAFM=LIZAFM(L,M)
  59.                      IF (IZAFM.NE.0) THEN
  60.                         ISLIS((IZAFM-1)/npgcd)=1
  61. C       WRITE(IOIMP,*)' IZAFM=',IZAFM
  62.                         SEGDES IZAFM
  63.                      ENDIF
  64.  4231             CONTINUE
  65.  423           CONTINUE
  66. C       WRITE(IOIMP,*)' KSPGP,KSPGD=',KSPGP,KSPGD
  67.                SEGDES IMATRI
  68.             ENDIF
  69.  422     CONTINUE
  70.  
  71.          IF(KMINC.NE.0)THEN
  72.             MINC=KMINC
  73.             ISLIS((MINC-1)/npgcd)=1
  74. C       WRITE(IOIMP,*)' KMINC=',MINC
  75.             SEGDES MINC
  76.          ENDIF
  77.          IF(KMINCP.NE.0)THEN
  78.             MINC=KMINCP
  79.             ISLIS((MINC-1)/npgcd)=1
  80. C       WRITE(IOIMP,*)' KMINCP=',MINC
  81.             SEGDES MINC
  82.          ENDIF
  83.          IF(KMINCD.NE.0)THEN
  84.             MINC=KMINCD
  85.             ISLIS((MINC-1)/npgcd)=1
  86. C       WRITE(IOIMP,*)' KMINCD=',MINC
  87.             SEGDES MINC
  88.          ENDIF
  89.  
  90.          N1=7
  91.          LIDMAT(1)=1
  92.          LIDMAT(2)=2
  93.          LIDMAT(3)=3
  94.          LIDMAT(4)=4
  95.          LIDMAT(5)=5
  96.          LIDMAT(6)=6
  97.          LIDMAT(7)=7
  98.  
  99.          DO 425 I1=1,N1
  100.             II=LIDMAT(I1)
  101.             IF(KIDMAT(II).NE.0)THEN
  102.                MINC=KIDMAT(II)
  103.                ISLIS((MINC-1)/npgcd)=1
  104.                SEGDES MINC
  105.             ENDIF
  106.  425     CONTINUE
  107.  
  108.  
  109.          N1=4
  110.          LKMMT(1)=4
  111.          LKMMT(2)=5
  112.          LKMMT(3)=6
  113.          LKMMT(4)=7
  114.  
  115.          DO 424 I1=1,N1
  116.             II=LKMMT(I1)
  117.             IF(KKMMT(II).NE.0)THEN
  118.                MINC=KKMMT(II)
  119.                ISLIS((MINC-1)/npgcd)=1
  120.                SEGDES MINC
  121.             ENDIF
  122.  424     CONTINUE
  123.  
  124.          IF(KIDMAT(1).NE.0)THEN
  125.             IDMAT=KIDMAT(1)
  126.             SEGACT IDMAT
  127.             IF (IDIAG.NE.0) THEN
  128.                MINC=IDIAG
  129.                ISLIS((MINC-1)/npgcd)=1
  130.                SEGDES MINC
  131.             ENDIF
  132.             NBLK=IDESCL(/1)
  133.             DO 426 I1=1,NBLK
  134.                MINC=IDESCL(I1)
  135.                ISLIS((MINC-1)/npgcd)=1
  136.                SEGDES MINC
  137.                IF(KSYM.NE.2)GO TO 426
  138.                MINC=IDESCU(I1)
  139.                ISLIS((MINC-1)/npgcd)=1
  140.                SEGDES MINC
  141.  426        CONTINUE
  142.             SEGDES IDMAT
  143.          ENDIF
  144.  
  145.          IF(KIDMAT(2).NE.0)THEN
  146.             IDMAT=KIDMAT(2)
  147.             SEGACT IDMAT
  148.             IF (IDIAG.NE.0) THEN
  149.                MINC=IDIAG
  150.                ISLIS((MINC-1)/npgcd)=1
  151.                SEGDES MINC
  152.             ENDIF
  153.             NBLK=IDESCL(/1)
  154.             DO 427 I1=1,NBLK
  155.                MINC=IDESCL(I1)
  156.                ISLIS((MINC-1)/npgcd)=1
  157.                SEGDES MINC
  158.                IF(KSYM.NE.2)GO TO 427
  159.                MINC=IDESCU(I1)
  160.                ISLIS((MINC-1)/npgcd)=1
  161.                SEGDES MINC
  162.  427        CONTINUE
  163.             SEGDES IDMAT
  164.          ENDIF
  165.  
  166.  
  167.  
  168.          SEGDES MATRIK
  169.  
  170.  421  CONTINUE
  171.  
  172.  
  173. *
  174.       RETURN
  175.       END
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  

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