Télécharger decoup.eso

Retour à la liste

Numérotation des lignes :

  1. C DECOUP SOURCE GOUNAND 19/07/12 21:15:08 10254
  2. C CALCUL AUTOMATIQUE DES DECOUPAGES
  3. C
  4. SUBROUTINE DECOUP(INBR,DEN1,DEN2,APROG,NBELEM,DENI,DECA,DLONG)
  5.  
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8.  
  9. IF (INBR.GT.0) GOTO 100
  10. IF (SIGN(1.D0,DEN1)*SIGN(1.D0,DEN2).LE.0.D0) THEN
  11. CALL ERREUR(809)
  12. RETURN
  13. ENDIF
  14. *
  15. XAUX=abs(((DEN1-DEN2)**2)/2)
  16. IF (DEN2.LT.DEN1) APROG=1.D0+XAUX-SQRT(XAUX*(2+XAUX))
  17. IF (DEN2.GE.DEN1) APROG=1.D0+XAUX+SQRT(XAUX*(2+XAUX))
  18. IF (ABS(APROG-1) .GT. 1.D-5) GOTO 20
  19. XNBELE=1.D0/DEN1
  20. NBELEM=INT(XNBELE)
  21. NBELEM=MAX(1,NBELEM)
  22. IF (XNBELE/NBELEM.GT.(NBELEM+1)/XNBELE) NBELEM=NBELEM+1
  23. IF (INBR.LT.0) NBELEM=-INBR
  24. DEN1=1.D0/REAL(NBELEM)
  25. GOTO 21
  26. 20 CONTINUE
  27. *sg 2019/07 eviter les pbs si DEN2/DEN1 est trop grand
  28. *sg XNBELE=(LOG(DEN2/DEN1)/LOG(APROG))
  29. XNBELE=(LOG(ABS(DEN2))-LOG(ABS(DEN1)))/(LOG(APROG))
  30. NBELEM=INT(XNBELE)
  31. NBELEM=MAX(1,NBELEM)
  32. IF (XNBELE/NBELEM.GT.(NBELEM+1)/XNBELE) NBELEM=NBELEM+1
  33. IF (INBR.LT.0) NBELEM=-INBR
  34. 21 CONTINUE
  35. IF (ABS(APROG-1.D0) .GT. 1.D-5)
  36. $ DEN1=(1.D0-APROG)/((1.D0-APROG**NBELEM)*APROG)
  37. DENI=DEN1*DLONG
  38. DECA=(DEN2-DEN1)*DLONG
  39. RETURN
  40.  
  41. 100 CONTINUE
  42. APROG =1.D0
  43. NBELEM=INBR
  44. DEN1 =1.D0/INBR
  45. DENI =DLONG/INBR
  46. DECA =0.D0
  47. END
  48.  
  49.  
  50.  

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