Sources Esope | Cast3M

cqf2mc
C CQF2MC    SOURCE    MAGN      18/05/16    21:15:04     9823           
      SUBROUTINE CQF2MC(MELEME,MACRO1)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C Ce sp transforme des éléments QUAF pris
C dans la liste ci-dessous
C SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19
C  3    7    11   33   34   35   36
C
C en les éléments correspondant MACRO (iso p2 ou q2) de la liste
C ci-dessous
C
C SEG3 TRI6 QUA9 CU27 PR18 TE10 PY14
C  3    6    11   33   40   24   ??
C************************************************************************
-INC SMELEME
      POINTEUR MACRO1.MELEME
 
      SEGACT MELEME
      NBSOU1=LISOUS(/1)
      IF(NBSOU1.EQ.0)NBSOU1=1
C     write(6,*)' SUB CQF2MC '
 
C On vérifie qu'il y a quelque chose à faire
 
      DO 12 L=1,NBSOU1
      IPT1=MELEME
      IF(NBSOU1.NE.1)IPT1=LISOUS(L)
      SEGACT IPT1
      ITYP=IPT1.ITYPEL
C     write(6,*)' CQF2MC ITYP=',ityp
      IF(ITYP.EQ.7.OR.ITYP.EQ.34.OR.ITYP.EQ.35.OR.ITYP.EQ.36)GO TO 212
      IF(ITYP.EQ.36)THEN
      CALL ERREUR(29)
      RETURN
      ENDIF
      SEGDES IPT1
  12  CONTINUE
      SEGDES MELEME
      MACRO1=MELEME
C     write(6,*)'CMACRO il n y a rien a faire '
 
      RETURN
 
 212  CONTINUE
C     write(6,*)'CQF2MC il y a a faire '
 
      NBSOUS=NBSOU1
      NBNN=0
      NBELEM=0
      NBREF=0
      SEGINI MACRO1
      DO 213 L=1,NBSOU1
      IPT1=MELEME
      IF(NBSOU1.NE.1)IPT1=LISOUS(L)
      SEGACT IPT1
      ITYP=IPT1.ITYPEL
      NBNN0=IPT1.NUM(/1)
      NBELEM=IPT1.NUM(/2)
      MACRO1.LISOUS(L)=IPT1
 
      IF(ITYP.EQ.7)THEN
      NBNN=6
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MACRO1.LISOUS(L)=IPT2
      IPT2.ITYPEL=6
      DO 217 K=1,NBELEM
      DO 217 I=1,NBNN
      IPT2.NUM(I,K)=IPT1.NUM(I,K)
 217  CONTINUE
 
      ELSEIF(ITYP.EQ.34)THEN
      NBNN=18
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MACRO1.LISOUS(L)=IPT2
      IPT2.ITYPEL=40
      DO 218 K=1,NBELEM
      DO 218 I=1,NBNN
      IPT2.NUM(I,K)=IPT1.NUM(I,K)
 218  CONTINUE
 
      ELSEIF(ITYP.EQ.35)THEN
      NBNN=10
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MACRO1.LISOUS(L)=IPT2
      IPT2.ITYPEL=24
      DO 219 K=1,NBELEM
      DO 219 I=1,NBNN
      IPT2.NUM(I,K)=IPT1.NUM(I,K)
 219  CONTINUE
 
      ELSEIF(ITYP.EQ.36)THEN
C     write(6,*)' CQF2MC 36 '
      MACRO1.LISOUS(L)=IPT1
 
      ENDIF
 
 213  CONTINUE
 
      IF(NBSOU1.EQ.1)THEN
      IPT3=MACRO1
      MACRO1=MACRO1.LISOUS(1)
      SEGSUP IPT3
      ENDIF
C     write(6,*)' FIN cqf2mc'
 
      RETURN
 1001 FORMAT(20(1X,I5))
 1002 FORMAT(10(1X,1PE11.4))
      END