Esope source files

   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 :