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

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