Télécharger la plaquette Cast3M


fr en

Télécharger changs.eso

Retour à la liste

Numérotation des lignes : 

changs

  1. C CHANGS    SOURCE    CHAT      05/01/12    21:55:38     5004
  2. C   TRANSFORME LES T3 ENGENDRES PAR SURF EN T6 SUR LE PLAN LOCAL
  3. C  TRANSFORME AUSSI LES Q4 EN Q8 ET LES T3 EN Q4 ET LES T3 EN Q8
  4. C
  5.       SUBROUTINE CHANGS(NUMNP,NUMELG,ITY,IPT1,XPROJ,IPT5)
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8. -INC SMELEME
  9.       SEGMENT XPROJ(N,1)
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13.       SEGMENT NKON(IKOUR)
  14.       SEGMENT KON(IKOUR,NKMAX,2)
  15.       IF (IPT1.ITYPEL.EQ.ITY) RETURN
  16.       IF (ITY.EQ.8) RETURN
  17.       IF ((ITY.EQ.6.AND.IPT1.ITYPEL.EQ.4).OR.
  18.      #    (ITY.EQ.10.AND.IPT1.ITYPEL.EQ.4).OR.
  19.      #   (ITY.EQ.10.AND.IPT1.ITYPEL.EQ.8)) GOTO 10
  20. C  ON CHANGE DES Q4 EN COUPLES DE T3
  21.       NBELEM=2*NUMELG
  22.       NUMELG=NBELEM
  23.       NBNN=3
  24.       NBSOUS=0
  25.       NBREF=0
  26.       SEGINI IPT2
  27.       IPT2.ITYPEL=4
  28.       DO 3 I=1,IPT1.NUM(/2),2
  29.       J=2*I-1
  30.       IPT2.NUM(1,J)=IPT1.NUM(1,I)
  31.       IPT2.NUM(2,J)=IPT1.NUM(2,I)
  32.       IPT2.NUM(3,J)=IPT1.NUM(3,I)
  33.       J=J+1
  34.       IPT2.NUM(1,J)=IPT1.NUM(1,I)
  35.       IPT2.NUM(2,J)=IPT1.NUM(3,I)
  36.       IPT2.NUM(3,J)=IPT1.NUM(4,I)
  37.       J=J+1
  38.       IF (J.GT.IPT2.NUM(/2)) GOTO 3
  39.       IPT2.NUM(1,J)=IPT1.NUM(1,I+1)
  40.       IPT2.NUM(2,J)=IPT1.NUM(2,I+1)
  41.       IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
  42.       J=J+1
  43.       IPT2.NUM(1,J)=IPT1.NUM(2,I+1)
  44.       IPT2.NUM(2,J)=IPT1.NUM(3,I+1)
  45.       IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
  46.    3  CONTINUE
  47.       SEGSUP IPT1
  48.       IPT1=IPT2
  49.       IF (IPT1.ITYPEL.EQ.ITY) RETURN
  50.   10  CONTINUE
  51. C  ON CHANGE LES T3 EN T6 OU LES Q4 EN Q8
  52.       IKOUR=NUMNP
  53.       SEGINI NKON
  54.       DO 23 I=1,IKOUR
  55.   23  NKON(I)=0
  56.       DO 24 I=1,IPT1.NUM(/1)
  57.       DO 24 J=1,NUMELG
  58.       IKL=IPT1.NUM(I,J)
  59.       IF (IKL.EQ.0) GOTO 24
  60.       NKON(IKL)=NKON(IKL)+1
  61.   24  CONTINUE
  62.       NKMAX=0
  63.       DO 25 I=1,IKOUR
  64.   25  NKMAX=MAX(NKMAX,NKON(I))
  65.   62  CONTINUE
  66.       SEGINI KON
  67.       DO 26 I=1,IKOUR
  68.       DO 27 J=1,NKMAX
  69.       KON(I,J,1)=0
  70.       KON(I,J,2)=0
  71.   27  CONTINUE
  72.   26  CONTINUE
  73.       IF (IPT5.EQ.0) GOTO 40
  74.       SEGACT IPT5
  75.       DO 31 J=1,IPT5.NUM(/2)
  76.       I1=IPT5.NUM(1,J)
  77.       I3=IPT5.NUM(3,J)
  78.       J1=MIN(I1,I3)
  79.       J3=MAX(I1,I3)
  80.       ITF=0
  81.   32  ITF=ITF+1
  82.       IF (ITF.GT.NKMAX) GOTO 61
  83.       IF (KON(J1,ITF,1).EQ.0) GOTO 33
  84.       IF (KON(J1,ITF,1).EQ.J3) GOTO 33
  85.       GOTO 32
  86.   33  KON(J1,ITF,1)=J3
  87.       KON(J1,ITF,2)=IPT5.NUM(2,J)
  88.   31  CONTINUE
  89.   40  CONTINUE
  90.       NBELEM=NUMELG
  91.       NBNN=IPT1.NUM(/1)*2
  92.       NBSOUS=0
  93.       NBREF=0
  94.       SEGINI IPT2
  95.       IPT2.ITYPEL=IPT1.ITYPEL+2
  96.       NBNN1=NBNN/2
  97.       DO 34 J=1,NBELEM
  98.       DO 35 I=1,NBNN1
  99.       IF (IPT1.NUM(I,J).EQ.0) GOTO 38
  100.       IFI=I+1
  101.       IF (IFI.EQ.NBNN1+1) IFI=1
  102.       IF (IPT1.NUM(IFI,J).EQ.0) IFI=1
  103.       IPT2.NUM(2*I-1,J)=IPT1.NUM(I,J)
  104.       I1=IPT1.NUM(I,J)
  105.       I2=IPT1.NUM(IFI,J)
  106.       J1=MIN(I1,I2)
  107.       J2=MAX(I1,I2)
  108.       ITF=0
  109.   36  ITF=ITF+1
  110.       IF (ITF.GT.NKMAX) GOTO 61
  111.       IF (KON(J1,ITF,1).EQ.J2) GOTO 37
  112.       IF (KON(J1,ITF,1).NE.0) GOTO 36
  113.       KON(J1,ITF,1)=J2
  114.       NUMNP=NUMNP+1
  115.       IF (NUMNP.GT.XPROJ(/2)) CALL ERREUR(31)
  116.       IF (IERR.NE.0) GOTO 1000
  117.       XPROJ(1,NUMNP)=0.5*(XPROJ(1,I1)+XPROJ(1,I2))
  118.       XPROJ(2,NUMNP)=0.5*(XPROJ(2,I1)+XPROJ(2,I2))
  119.       XPROJ(3,NUMNP)=0.5*(XPROJ(3,I1)+XPROJ(3,I2))
  120.       IF (XPROJ(/1).EQ.4)
  121.      #      XPROJ(4,NUMNP)=0.5*(XPROJ(4,I1)+XPROJ(4,I2))
  122.       KON(J1,ITF,2)=NUMNP
  123.   37  IPT2.NUM(2*I,J)=KON(J1,ITF,2)
  124.       GOTO 35
  125.   38  IPT2.NUM(2*I-1,J)=0
  126.       IPT2.NUM(2*I,J)=0
  127.   35  CONTINUE
  128.   34  CONTINUE
  129.       SEGSUP IPT1
  130.       IPT1=IPT2
  131.  1000 SEGSUP KON,NKON,IPT5
  132.       RETURN
  133.   61  SEGSUP KON
  134.       NKMAX=NKMAX+1
  135.       IF (IIMPI.NE.0) WRITE (IOIMP,2000) NKMAX
  136.  2000 FORMAT(/,' NOUVELLE VALEUR DE NKMAX TENTEE DANS CHANGS',I4)
  137.       GOTO 62
  138.       END
  139.  
  140.  
  141.  

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