chahut
C CHAHUT SOURCE PV 20/03/30 21:15:50 10567 SUBROUTINE CHAHUT(MELEME,ALFA) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMELEME -INC SMLENTI COEF=ALFA*0.05D0 IF(IDIM.EQ.3)THEN WRITE(6,*)' DOMA : CHAHUT non prevu en 3D' RETURN ENDIF JG=nbpts SEGINI MLENTI SEGACT MELEME NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 DO 1 L=1,NBSOUS IPT1=MELEME IF(NBSOUS.NE.1)IPT1=LISOUS(L) SEGACT IPT1 NP =IPT1.NUM(/1) DO 102 I=2,NP,2 N2=IPT1.NUM(I,K) LECT(N2)=LECT(N2)+1 102 CONTINUE 101 CONTINUE 1 CONTINUE DO 2 L=1,NBSOUS IPT1=MELEME IF(NBSOUS.NE.1)IPT1=LISOUS(L) NP =NUM(/1) IF(NP.EQ.6)THEN N1=IPT1.NUM(1,K) N2=IPT1.NUM(2,K) N3=IPT1.NUM(3,K) N4=IPT1.NUM(3,K) N5=IPT1.NUM(3,K) N6=IPT1.NUM(3,K) XN1=XCOOR((N1-1)*(IDIM+1) +1) YN1=XCOOR((N1-1)*(IDIM+1) +2) XN2=XCOOR((N2-1)*(IDIM+1) +1) YN2=XCOOR((N2-1)*(IDIM+1) +2) XN3=XCOOR((N3-1)*(IDIM+1) +1) YN3=XCOOR((N3-1)*(IDIM+1) +2) XN4=XCOOR((N4-1)*(IDIM+1) +1) YN4=XCOOR((N4-1)*(IDIM+1) +2) XN5=XCOOR((N5-1)*(IDIM+1) +1) YN5=XCOOR((N5-1)*(IDIM+1) +2) XN6=XCOOR((N6-1)*(IDIM+1) +1) YN6=XCOOR((N6-1)*(IDIM+1) +2) D1=(XN2-XN6)*(XN2-XN6)+(YN2-YN6)*(YN2-YN6) D1=SQRT(D1) D2=(XN2-XN4)*(XN2-XN4)+(YN2-YN4)*(YN2-YN4) D2=SQRT(D2) D3=(XN6-XN4)*(XN6-XN4)+(YN6-YN4)*(YN6-YN4) D3=SQRT(D2) IF(LECT(N2).EQ.2)THEN D=MIN(D1,D2)*COEF UU=(XN2-XN5)*(XN2-XN5)+(YN2-YN5)*(YN2-YN5) UU=SQRT(UU) UX=(XN2-XN5)/UU UY=(YN2-YN5)/UU XCOOR((N2-1)*(IDIM+1) +1)= XCOOR((N2-1)*(IDIM+1) +1)+D*UX XCOOR((N2-1)*(IDIM+1) +2)= XCOOR((N2-1)*(IDIM+1) +2)+D*UY ENDIF IF(LECT(N4).EQ.2)THEN D=MIN(D3,D2)*COEF UU=(XN1-XN4)*(XN1-XN4)+(YN1-YN4)*(YN1-YN4) UU=SQRT(UU) UX=(XN1-XN4)/UU UY=(YN1-YN4)/UU XCOOR((N4-1)*(IDIM+1) +1)= XCOOR((N4-1)*(IDIM+1) +1)+D*UX XCOOR((N4-1)*(IDIM+1) +2)= XCOOR((N4-1)*(IDIM+1) +2)+D*UY ENDIF IF(LECT(N6).EQ.2)THEN D=MIN(D3,D1)*COEF UU=(XN6-XN3)*(XN6-XN3)+(YN6-YN3)*(YN6-YN3) UU=SQRT(UU) UX=(XN6-XN3)/UU UY=(YN6-YN3)/UU XCOOR((N6-1)*(IDIM+1) +1)= XCOOR((N6-1)*(IDIM+1) +1)+D*UX XCOOR((N6-1)*(IDIM+1) +2)= XCOOR((N6-1)*(IDIM+1) +2)+D*UY ENDIF 206 CONTINUE ELSEIF(NP.EQ.8)THEN GO TO 2 ELSE WRITE(6,*)' DOMA : CHAHUT non prevu pour NP=',NP GO TO 2 ENDIF SEGDES IPT1 2 CONTINUE SEGDES MELEME SEGSUP MLENTI RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales