Sources Esope | Cast3M

changs
C CHANGS    SOURCE    CB215821  26/08/24    21:15:29     12622          
C   TRANSFORME LES T3 ENGENDRES PAR SURF EN T6 SUR LE PLAN LOCAL
C  TRANSFORME AUSSI LES Q4 EN Q8 ET LES T3 EN Q4 ET LES T3 EN Q8
C
      SUBROUTINE CHANGS(NUMNP,NUMELG,ITY,IPT1,XPROJ,IPT5)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMELEME
      SEGMENT XPROJ(N,1)
 
-INC PPARAM
-INC CCOPTIO
      SEGMENT NKON(IKOUR)
      SEGMENT KON(IKOUR,NKMAX,2)
      IF (IPT1.ITYPEL.EQ.ITY) RETURN
      IF (ITY.EQ.8) RETURN
      IF ((ITY.EQ.6.AND.IPT1.ITYPEL.EQ.4).OR.
     #    (ITY.EQ.10.AND.IPT1.ITYPEL.EQ.4).OR.
     #   (ITY.EQ.10.AND.IPT1.ITYPEL.EQ.8)) GOTO 10
C  ON CHANGE DES Q4 EN COUPLES DE T3
      NBELEM=2*NUMELG
      NUMELG=NBELEM
      NBNN=3
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=4
      DO 3 I=1,IPT1.NUM(/2),2
      J=2*I-1
      IPT2.NUM(1,J)=IPT1.NUM(1,I)
      IPT2.NUM(2,J)=IPT1.NUM(2,I)
      IPT2.NUM(3,J)=IPT1.NUM(3,I)
      J=J+1
      IPT2.NUM(1,J)=IPT1.NUM(1,I)
      IPT2.NUM(2,J)=IPT1.NUM(3,I)
      IPT2.NUM(3,J)=IPT1.NUM(4,I)
      J=J+1
      IF (J.GT.IPT2.NUM(/2)) GOTO 3
      IPT2.NUM(1,J)=IPT1.NUM(1,I+1)
      IPT2.NUM(2,J)=IPT1.NUM(2,I+1)
      IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
      J=J+1
      IPT2.NUM(1,J)=IPT1.NUM(2,I+1)
      IPT2.NUM(2,J)=IPT1.NUM(3,I+1)
      IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
   3  CONTINUE
      SEGSUP IPT1
      IPT1=IPT2
      IF (IPT1.ITYPEL.EQ.ITY) RETURN
  10  CONTINUE
C  ON CHANGE LES T3 EN T6 OU LES Q4 EN Q8
      IKOUR=NUMNP
      SEGINI NKON
      DO 23 I=1,IKOUR
      NKON(I)=0
   23 CONTINUE
      DO 2001 I=1,IPT1.NUM(/1)
      DO 24 J=1,NUMELG
      IKL=IPT1.NUM(I,J)
      IF (IKL.EQ.0) GOTO 24
      NKON(IKL)=NKON(IKL)+1
  24  CONTINUE
 2001 CONTINUE
      NKMAX=0
      DO 25 I=1,IKOUR
      NKMAX=MAX(NKMAX,NKON(I))
   25 CONTINUE
  62  CONTINUE
      SEGINI KON
      DO 26 I=1,IKOUR
      DO 27 J=1,NKMAX
      KON(I,J,1)=0
      KON(I,J,2)=0
  27  CONTINUE
  26  CONTINUE
      IF (IPT5.EQ.0) GOTO 40
      SEGACT IPT5
      DO 31 J=1,IPT5.NUM(/2)
      I1=IPT5.NUM(1,J)
      I3=IPT5.NUM(3,J)
      J1=MIN(I1,I3)
      J3=MAX(I1,I3)
      ITF=0
  32  ITF=ITF+1
      IF (ITF.GT.NKMAX) GOTO 61
      IF (KON(J1,ITF,1).EQ.0) GOTO 33
      IF (KON(J1,ITF,1).EQ.J3) GOTO 33
      GOTO 32
  33  KON(J1,ITF,1)=J3
      KON(J1,ITF,2)=IPT5.NUM(2,J)
  31  CONTINUE
  40  CONTINUE
      NBELEM=NUMELG
      NBNN=IPT1.NUM(/1)*2
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=IPT1.ITYPEL+2
      NBNN1=NBNN/2
      DO 34 J=1,NBELEM
      DO 35 I=1,NBNN1
      IF (IPT1.NUM(I,J).EQ.0) GOTO 38
      IFI=I+1
      IF (IFI.EQ.NBNN1+1) IFI=1
      IF (IPT1.NUM(IFI,J).EQ.0) IFI=1
      IPT2.NUM(2*I-1,J)=IPT1.NUM(I,J)
      I1=IPT1.NUM(I,J)
      I2=IPT1.NUM(IFI,J)
      J1=MIN(I1,I2)
      J2=MAX(I1,I2)
      ITF=0
  36  ITF=ITF+1
      IF (ITF.GT.NKMAX) GOTO 61
      IF (KON(J1,ITF,1).EQ.J2) GOTO 37
      IF (KON(J1,ITF,1).NE.0) GOTO 36
      KON(J1,ITF,1)=J2
      NUMNP=NUMNP+1
      IF (NUMNP.GT.XPROJ(/2)) CALL ERREUR(31)
      IF (IERR.NE.0) GOTO 1000
      XPROJ(1,NUMNP)=0.5*(XPROJ(1,I1)+XPROJ(1,I2))
      XPROJ(2,NUMNP)=0.5*(XPROJ(2,I1)+XPROJ(2,I2))
      XPROJ(3,NUMNP)=0.5*(XPROJ(3,I1)+XPROJ(3,I2))
      IF (XPROJ(/1).EQ.4)
     #      XPROJ(4,NUMNP)=0.5*(XPROJ(4,I1)+XPROJ(4,I2))
      KON(J1,ITF,2)=NUMNP
  37  IPT2.NUM(2*I,J)=KON(J1,ITF,2)
      GOTO 35
  38  IPT2.NUM(2*I-1,J)=0
      IPT2.NUM(2*I,J)=0
  35  CONTINUE
  34  CONTINUE
      SEGSUP IPT1
      IPT1=IPT2
 1000 SEGSUP KON,NKON,IPT5
      RETURN
  61  SEGSUP KON
      NKMAX=NKMAX+1
      IF (IIMPI.NE.0) WRITE (IOIMP,2000) NKMAX
 2000 FORMAT(/,' NOUVELLE VALEUR DE NKMAX TENTEE DANS CHANGS',I4)
      GOTO 62
      END