1 : C DECOUP SOURCE CHAT 05/01/12 22:39:27 5004 2 : C CALCUL AUTOMATIQUE DES DECOUPAGES 3 : C 4 : SUBROUTINE DECOUP(INBR,DEN1,DEN2,APROG,NBELEM,DENI,DECA,DLONG) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IF (INBR.GT.0) GOTO 100 8 : XAUX=abs(((DEN1-DEN2)**2)/2) 9 : IF (DEN2.LT.DEN1) APROG=1+XAUX-SQRT(XAUX*(2+XAUX)) 10 : IF (DEN2.GE.DEN1) APROG=1+XAUX+SQRT(XAUX*(2+XAUX)) 11 : IF (ABS(APROG-1).GT.1.D-5) GOTO 20 12 : XNBELE=1.D0/DEN1 13 : NBELEM=INT(XNBELE) 14 : NBELEM=MAX(1,NBELEM) 15 : IF (XNBELE/NBELEM.GT.(NBELEM+1)/XNBELE) NBELEM=NBELEM+1 16 : IF (INBR.LT.0) NBELEM=-INBR 17 : DEN1=1.D0/DBLE(NBELEM) 18 : GOTO 21 19 : 20 CONTINUE 20 : XNBELE=(LOG(DEN2/DEN1)/LOG(APROG)) 21 : NBELEM=INT(XNBELE) 22 : NBELEM=MAX(1,NBELEM) 23 : IF (XNBELE/NBELEM.GT.(NBELEM+1)/XNBELE) NBELEM=NBELEM+1 24 : IF (INBR.LT.0) NBELEM=-INBR 25 : 21 CONTINUE 26 : IF (ABS(APROG-1).GT.1.D-5) 27 : $ DEN1=(1-APROG)/((1-APROG**NBELEM)*APROG) 28 : DENI=DEN1*DLONG 29 : DECA=(DEN2-DEN1)*DLONG 30 : GOTO 101 31 : 100 APROG=1.D0 32 : NBELEM=INBR 33 : DEN1=1.D0/INBR 34 : DENI=DLONG/INBR 35 : DECA=0 36 : 101 CONTINUE 37 : RETURN 38 : END 39 : 40 : 41 : 42 : 43 : 44 : 45 :
© Cast3M 2003 - All rights reserved.
Disclaimer