Esope source files

   1 : C CQF2MC    SOURCE    CHAT      05/01/12    22:27:30     5004           
   2 :       SUBROUTINE CQF2MC(MELEME,MACRO1)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C************************************************************************
   6 : C Ce sp transforme des éléments QUAF pris
   7 : C dans la liste ci-dessous
   8 : C SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19
   9 : C  3    7    11   33   34   35   36
  10 : C
  11 : C en les éléments correspondant MACRO (iso p2 ou q2) de la liste
  12 : C ci-dessous
  13 : C
  14 : C SEG3 TRI6 QUA9 CU27 PR18 TE10 PY14
  15 : C  3    6    11   33   40   24   ??
  16 : C************************************************************************
  17 : -INC SMELEME
  18 :       POINTEUR MACRO1.MELEME
  19 : 
  20 :       SEGACT MELEME
  21 :       NBSOU1=LISOUS(/1)
  22 :       IF(NBSOU1.EQ.0)NBSOU1=1
  23 : C     write(6,*)' SUB CQF2MC '
  24 : 
  25 : C On vérifie qu'il y a quelque chose à faire
  26 : 
  27 :       DO 12 L=1,NBSOU1
  28 :       IPT1=MELEME
  29 :       IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  30 :       SEGACT IPT1
  31 :       ITYP=IPT1.ITYPEL
  32 : C     write(6,*)' CQF2MC ITYP=',ityp
  33 :       IF(ITYP.EQ.7.OR.ITYP.EQ.34.OR.ITYP.EQ.35)GO TO 212
  34 :       IF(ITYP.EQ.36)THEN
  34 :       CALL ERREUR(29)
  35 :       RETURN
  36 :       ENDIF
  37 :       SEGDES IPT1
  38 :   12  CONTINUE
  39 :       SEGDES MELEME
  40 :       MACRO1=MELEME
  41 : C     write(6,*)'CMACRO il n y a rien a faire '
  42 : 
  43 :       RETURN
  44 : 
  45 :  212  CONTINUE
  46 : C     write(6,*)'CQF2MC il y a a faire '
  47 : 
  48 :       NBSOUS=NBSOU1
  49 :       NBNN=0
  50 :       NBELEM=0
  51 :       NBREF=0
  52 :       SEGINI MACRO1
  53 :       DO 213 L=1,NBSOU1
  54 :       IPT1=MELEME
  55 :       IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  56 :       SEGACT IPT1
  57 :       ITYP=IPT1.ITYPEL
  58 :       NBNN0=IPT1.NUM(/1)
  59 :       NBELEM=IPT1.NUM(/2)
  60 :       MACRO1.LISOUS(L)=IPT1
  61 : 
  62 :       IF(ITYP.EQ.7)THEN
  63 :       NBNN=6
  64 :       NBSOUS=0
  65 :       NBREF=0
  66 :       SEGINI IPT2
  67 :       MACRO1.LISOUS(L)=IPT2
  68 :       IPT2.ITYPEL=6
  69 :       DO 217 K=1,NBELEM
  70 :       DO 217 I=1,NBNN
  71 :       IPT2.NUM(I,K)=IPT1.NUM(I,K)
  72 :  217  CONTINUE
  73 : 
  74 :       ELSEIF(ITYP.EQ.34)THEN
  75 :       NBNN=18
  76 :       NBSOUS=0
  77 :       NBREF=0
  78 :       SEGINI IPT2
  79 :       MACRO1.LISOUS(L)=IPT2
  80 :       IPT2.ITYPEL=40
  81 :       DO 218 K=1,NBELEM
  82 :       DO 218 I=1,NBNN
  83 :       IPT2.NUM(I,K)=IPT1.NUM(I,K)
  84 :  218  CONTINUE
  85 : 
  86 :       ELSEIF(ITYP.EQ.35)THEN
  87 :       NBNN=10
  88 :       NBSOUS=0
  89 :       NBREF=0
  90 :       SEGINI IPT2
  91 :       MACRO1.LISOUS(L)=IPT2
  92 :       IPT2.ITYPEL=24
  93 :       DO 219 K=1,NBELEM
  94 :       DO 219 I=1,NBNN
  95 :       IPT2.NUM(I,K)=IPT1.NUM(I,K)
  96 :  219  CONTINUE
  97 : 
  98 :       ENDIF
  99 : 
 100 :  213  CONTINUE
 101 : 
 102 :       IF(NBSOU1.EQ.1)THEN
 103 :       IPT3=MACRO1
 104 :       MACRO1=MACRO1.LISOUS(1)
 105 :       SEGSUP IPT3
 106 :       ENDIF
 107 : 
 108 :       RETURN
 109 :  1001 FORMAT(20(1X,I5))
 110 :  1002 FORMAT(10(1X,1PE11.4))
 111 :       END
 112 :  
 113 :  
 114 :