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