Télécharger decoup.eso

Retour à la liste

Numérotation des lignes :

  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.  
  46.  

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