Télécharger la plaquette Cast3M


fr en

Télécharger genmct.eso

Retour à la liste

Numérotation des lignes : 

genmct

  1. C GENMCT    SOURCE    CHAT      05/01/13    00:17:25     5004
  2.       SUBROUTINE GENMCT(MCTP0,MCTD0,MCT)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC SMELEME
  6.       POINTEUR MCTP.MELEME,MCTD.MELEME,MCT.MELEME
  7.       POINTEUR MCTP0.MELEME,MCTD0.MELEME
  8.  
  9.  
  10.       SEGACT MCTP0,MCTD0
  11.       NBSOUP=MCTP0.LISOUS(/1)
  12.       NBSOUD=MCTD0.LISOUS(/1)
  13.       IF(NBSOUP.EQ.0)NBSOUP=1
  14.       IF(NBSOUD.EQ.0)NBSOUD=1
  15.  
  16.       NBSOUS=0
  17.       NBREF=0
  18.       NBNN=0
  19.       NBELEM=0
  20.       SEGINI MELEME
  21. C     write(6,*)' MELEME=',MELEME
  22.  
  23.       IX1=0
  24.       IX2=0
  25.  
  26.       NBSOU0=0
  27.       DO 40 L=1,NBSOUP
  28.       IPT1=MCTP0
  29.       IF(NBSOUP.NE.1)IPT1=MCTP0.LISOUS(L)
  30.       SEGACT IPT1
  31.       NP1=IPT1.NUM(/1)
  32.       NBEL1=IPT1.NUM(/2)
  33.       IF(IX1.EQ.0)THEN
  34.       N1D=1
  35.       N1A=NBEL1
  36.       LG1=NBEL1
  37.       K1=0
  38.       ENDIF
  39.  
  40.       DO 50 M=1,NBSOUD
  41.       IPT2=MCTD0
  42.       IF(NBSOUD.NE.1)IPT1=MCTD0.LISOUS(M)
  43.       SEGACT IPT2
  44.       NP2=IPT2.NUM(/1)
  45.       NBEL2=IPT2.NUM(/2)
  46.       IF(IX2.EQ.0)THEN
  47.       N2D=1
  48.       N2A=NBEL2
  49.       LG2=NBEL2
  50.       K2=0
  51.       ENDIF
  52.  
  53.       NBELEM=0
  54.       NBNN=0
  55.       NBREF=0
  56.       NBSOU0=NBSOU0+1
  57.       NBSOUS=NBSOU0
  58.  
  59. C     write(6,*)' NBSOUS=',nbsous
  60.       SEGADJ MELEME
  61.  
  62.       NBELEM=MIN(LG1,LG2)
  63.       NBNN=NP1+NP2
  64.       NBREF=0
  65.       NBSOUS=0
  66.       SEGINI IPT3
  67.       LISOUS(NBSOU0)=IPT3
  68.       IPT3.ITYPEL=28
  69. C     write(6,*)' NBELEM,NBNN,NP1,NP2,K1,K2=',
  70. C    & NBELEM,NBNN,NP1,NP2,K1,K2
  71.       DO 61 K=1,NBELEM
  72.       K1=K1+1
  73.       K2=K2+1
  74.       DO 62 I=1,NP1
  75.       IPT3.NUM(I,K)=IPT1.NUM(I,K1)
  76.  62   CONTINUE
  77.       DO 63 I=1,NP2
  78.       IPT3.NUM(I+NP1,K)=IPT2.NUM(I,K2)
  79.  63   CONTINUE
  80.  61   CONTINUE
  81.  
  82.       IF(K1.EQ.NBEL1)THEN
  83.       IX2=1
  84.       GO TO 40
  85.       ELSEIF(K2.EQ.NBEL2)THEN
  86.       IX1=1
  87.       GO TO 50
  88.       ENDIF
  89.  
  90.  50   CONTINUE
  91.  40   CONTINUE
  92.  
  93.  
  94.       IF(NBSOU0.EQ.1)THEN
  95.       SEGSUP MELEME
  96.       MELEME=IPT3
  97.       ENDIF
  98.       MCT=MELEME
  99.       RETURN
  100.       END
  101.  
  102.  
  103.  

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