Numérotation des lignes :

C CHANGS    SOURCE    CHAT      05/01/12    21:55:38     5004C   TRANSFORME LES T3 ENGENDRES PAR SURF EN T6 SUR LE PLAN LOCALC  TRANSFORME AUSSI LES Q4 EN Q8 ET LES T3 EN Q4 ET LES T3 EN Q8C      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 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 10C  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  CONTINUEC  ON CHANGE LES T3 EN T6 OU LES Q4 EN Q8      IKOUR=NUMNP      SEGINI NKON      DO 23 I=1,IKOUR  23  NKON(I)=0      DO 24 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      NKMAX=0      DO 25 I=1,IKOUR  25  NKMAX=MAX(NKMAX,NKON(I))  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

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