Download decoup.eso

Back to the list

   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