Télécharger la plaquette Cast3M


fr en

Télécharger decoup.eso

Retour à la liste

Numérotation des lignes : 

decoup

  1. C DECOUP    SOURCE    PASCAL    22/11/09    21:15:01     11496          
  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.       LOGICAL LPROG
  9. -INC CCREEL
  10. **    DEN1=SIGN(MAX(XPETIT,ABS(DEN1)),DEN1)
  11. **    DEN2=SIGN(MAX(XPETIT,ABS(DEN2)),DEN2)
  12.       DEN1=MAX(XPETIT,ABS(DEN1))
  13.       DEN2=MAX(XPETIT,ABS(DEN2))
  14. C     write(6,*) 'INBR,DEN1,DEN2=',INBR,DEN1,DEN2
  15.       IF ((INBR.EQ.0).AND.(ABS(DEN1*DEN2).LT.XPETIT)) THEN
  16.          CALL ERREUR(809)
  17.          RETURN
  18.       ENDIF
  19.       IF (INBR.GT.0) THEN
  20.          APROG =1.D0
  21.          NBELEM=INBR
  22.          DEN1  =1.D0/INBR
  23.          DENI  =DLONG/INBR
  24.          DECA  =0.D0
  25.       ELSE
  26.          IF (SIGN(1.D0,DEN1)*SIGN(1.D0,DEN2).LE.0.D0) THEN
  27.             CALL ERREUR(809)
  28.             RETURN
  29.          ENDIF
  30. *
  31.          XAUX=abs(((DEN1-DEN2)**2)/2)
  32.          IF (DEN2.LT.DEN1) THEN
  33.             APROG=1.D0+XAUX-SQRT(XAUX*(2+XAUX))
  34.          ELSE
  35.             APROG=1.D0+XAUX+SQRT(XAUX*(2+XAUX))
  36.          ENDIF
  37.          IF (ABS(APROG).LT.XPETIT) THEN
  38.            CALL ERREUR(809)
  39.            RETURN
  40.          ENDIF
  41.          LPROG=((ABS(APROG-1))   .GT.  1.D-5)
  42. C     write(6,*) 'XAUX,APROG =',XAUX,APROG
  43.          IF (INBR.LT.0) THEN
  44.             NBELEM=-INBR
  45.          ELSE
  46.             IF (LPROG) THEN
  47. *sg 2019/07 eviter les pbs si DEN2/DEN1 est trop grand
  48. *sg      XNBELE=(LOG(DEN2/DEN1)/LOG(APROG))
  49.                XNBELE=(LOG(ABS(DEN2))-LOG(ABS(DEN1)))/(LOG(APROG))
  50.             ELSE
  51.                XNBELE=min(1.D0/DEN1,dble(igrand))
  52.                XNBELE=max(xnbele,-2.d0**31)
  53.             ENDIF
  54.             if(.not.(xnbele.ge.xpetit)) xnbele=xpetit
  55.             NBELEM=INT(XNBELE)
  56.             NBELEM=MAX(1,NBELEM)
  57.             IF (XNBELE/NBELEM.GT.(NBELEM+1)/XNBELE) NBELEM=NBELEM+1
  58.          ENDIF
  59.          IF (LPROG) THEN
  60.             DEN1=(1.D0-APROG)/((1.D0-APROG**NBELEM)*APROG)
  61.          ELSE
  62.             DEN1=1.D0/REAL(NBELEM)
  63.          ENDIF
  64.          DENI=DEN1*DLONG
  65.          DECA=(DEN2-DEN1)*DLONG
  66.       ENDIF
  67. *      write(6,*) ' decoup nbelem deni deca',nbelem,deni,deca
  68. *      if (deni.LE.xzprec) write(6,*) ' deni < xzprec' 
  69.       if (nbelem.GT.igranD) nbelem=1
  70.       RETURN
  71.       END
  72.  
  73.  
  74.  
  75.  
  76.  

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