Sources Esope | Cast3M

intaxe
C INTAXE    SOURCE    CB215821  25/04/08    21:15:23     12227          
 
      SUBROUTINE INTAXE(BMIN,BMAX,BINT,IN,ZLOG,ZARR)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Y)
 
      IMPLICIT LOGICAL (Z)
*
* BMIN (E)    BORNE MINI
* BMAX (E)    BORNE MAXI
* BINT (S)    PAS DE GRADUATION
* IN   (S)    NOMBRE DE SEGMENTS
* ZLOG (E)    INDIQUATION SI AXE EN LOGARITHMIQUE
* ZARR (E)    VRAI => AXE NON NORMALISE
*
*     PAS DE GRADUATION POSSIBLE
      DIMENSION PAS(11)
      DATA      PAS/0.01D0,0.02d0,0.05D0,0.1D0,0.2D0,0.5D0,1.D0,
     $             2.D0,5.D0,10.D0,20.D0/
*
      DIST  =ABS(BMAX-BMIN)
      binima=bmax
      binimi=bmin
 
* ------
*  LOG : LES BORNES SONT DES ENTIERS
* ------
      IF (ZLOG) THEN
C       Taille des intervalles
        IDIST=CEILING(DIST)
        IN   =MIN(IDIST,12)
        BINT =REAL(MAX(NINT(DIST / REAL(IN)),1))
 
C       Recallage pour tomber sur des entiers en puissance de 10
        IN  =NINT(DIST/BINT)
        BMAX=BMIN + REAL(IN*BINT)
      ELSE
 
* ----------
*  DECIMAL :
* ----------
*  INITIALISATION IP
*
         IP = ICALP(BMIN,BMAX)
         P10IP = 10.D0**REAL(IP)
 
*   DETERMINATION DU COEFF. CORRECTEUR POUR LES BORNES
 
         IF (BMIN .LT. 0.D0) THEN
           CORR1=-1.D0
         ELSE
            CORR1=0.D0
         ENDIF
         IF (BMAX .LT. 0.D0) THEN
            CORR2=0.D0
         ELSE
            CORR2=1.D0
         ENDIF
*
*        bminin = bmin
*        bmaxin = bmax
*
*  Pour affichage et deverminage :
*         binima=bmax
*         binimi=bmin
*
*        AXE NON NORMALISE
*
         IF (ZARR) THEN
*     RAMENE LES BORNES A UNE FORME XX.XX  EXX
*     ARRONDI EN 10-2 PUISQUE LES ECHELLES SONT GRADUEES EN 10-2
            BMIN=BMIN/P10IP
            BMAX=BMAX/P10IP
           IF(ABS(AINT(BMIN*100.D0)-(BMIN*100.d0)).GT.ABS(BMIN*0.001D0))
     *          BMIN=AINT(BMIN*100.D0+CORR1)/100.D0
           IF(ABS(AINT(BMAX*100.D0)-(BMAX*100.D0)).GT.ABS(BMAX*0.001D0))
     *          BMAX=AINT(BMAX*100.D0+CORR2)/100.D0
            DIST=ABS(BMAX-BMIN)
*      RECHERCHE UN PAS EN 10-2 PERMETTANT D'AVOIR DE 5 A 10 DIVISIONS
            I=11
1           I=I-1
            DIST2=DIST/I
            ZNE=ABS((DIST2*100.D0)-(AINT(DIST2*100.D0))).GT.
     $      (ABS(DIST2*0.001D0))
cbp             IF ((I.NE.4).AND.ZNE)  GOTO 1
cbp : incoherence avec la notice --> si NARR ou YBOR on impose YSUP et YINF
cbp : on cherche de 10 a 1 divisions
            IF ((I.NE.1).AND.ZNE)  GOTO 1
*      SORTIE QUAND LE PAS EST EN 10-2
            IF (.NOT.ZNE) THEN
               IN=I
               BINT=DIST2* P10IP
               BMIN=BMIN * P10IP
               BMAX=BMAX * P10IP
            ELSE
c *      RECALCUL DES BORNES DE FACON A AVOIR UN PAS EN 10-2
c                IN=10
c                DIST2=ABS(BMAX-BMIN)/10.D0
c                DIST2=AINT(DIST2*100.D0+1.D0)/100.D0
c                BINT=DIST2* P10IP
c                BMIN=BMIN * P10IP
c                BMAX=BMIN+10.D0*BINT
cbp : incoherence avec la notice --> si NARR ou YBOR on impose YSUP et YINF
               IN=I
               BINT=DIST2* P10IP
               BMIN=BMIN * P10IP
               BMAX=BMAX * P10IP
            ENDIF
 
 
         ELSE
*
*      AXE NORMALISE
*
            D=DIST/P10IP
*
*      SELECTION DU PREMIER PAS
            DO 2 I=1,11
                 IF (((PAS(I)*10.D0)-D).GT.1.D-2) GOTO 3
2           CONTINUE
 
*    RAMENE LES BORNES A UNE EXPRESSION EN XX.XX E XX
3           CONTINUE
            BI=BMIN/P10IP
            BS=BMAX/P10IP
         IF(AINT(BI*100.D0).NE.BI*100.D0)BI=AINT(BI*100.D0+CORR1)/100.D0
         IF(AINT(BS*100.D0).NE.BS*100.D0)BS=AINT(BS*100.D0+CORR2)/100.D0
 
*    DEMANDE A AVOIR DES BORNES MULTIPLES DU PAS
            IM=mod(i-1,3)+1
            PASM=PAS(IM) * (10.D0**((i-im)/3.D0))
            BI=ARROND(BI,PASM,0)
            BS=ARROND(BS,PASM,1)
            D1=BS-BI
            R=D1/PASM
 
*    COMPTE TENU DES CORRECTIONS DE ARROND , LE PAS PEUT NE PLUS ETRE
*    VALIDE => ON ESSAIE LE PAS SUIVANT
            IF (R.GT.10.D0) THEN
               I=I+1
               GOTO 3
            ENDIF
*    ON REDRESSE TOUT ET ON SORT
*
* TC je ne comprends pas comment ne pas faire d'erreur donc je m'assure
* que le resultat a un sens
*
            BMIN=BI * P10IP
            BMAX=BS * P10IP
            pasm10=pasm * P10IP
100         continue
            imodi=0
*            write(6,*) ' avant correction '
*            write(6,*) ' bmin binimi bmax binima'
*            write(6,*)  bmin ,binimi ,bmax, binima
            if( bmin+pasm10.lt.binimi ) then
              bmin=bmin+pasm10
              imodi=imodi+8
            endif
            if( binimi.lt.bmin) then
              bmin=bmin-pasm10
              imodi = imodi+1
            endif
 
            if( bmax.lt. binima) then
               bmax=bmax + pasm10
               imodi=imodi+2
            endif
            if( bmax - pasm10.gt.binima ) then
                 bmax=bmax- pasm10
                 imodi=imodi +4
            endif
            if( imodi.ne.0) then
*           write(6,*) ' imodi ' , imodi
             go to 100
            endif
 
*            write(6,*) ' apres correction '
*            write(6,*) ' bmin binimi bmax binima'
*            write(6,*)  bmin ,binimi ,bmax, binima
            in= int( (Bmax-bmin)/pasm10 + 0.5)
            BINT=PASM * P10IP
         ENDIF
 
      ENDIF
 
      END