*=*=*=*= to36.html =*=*=*=*
SUBROUTINE to36

SUBROUTINE to36


      SUBROUTINE to36(x,nbre,xmin,xmax,iunit,icase)
Ccray IMPLICIT NONE
      IMPLICIT NONE
c=======================================================================
c-- x    : le champ a compacter
c-- nbre : la taille du champ x
c-- iunit: numero logique du fichier sortie
c-- icase: nombre de cases a utiliser (qui determine la precision)
      INTEGER iunit, nbre, icase
      REAL x(nbre)
c=======================================================================
      INTEGER ibase, maxnbr, ifact1, ifact2, ifact3
      PARAMETER (ibase=36, maxnbr=100000)
      PARAMETER (ifact1 = ibase**1-1)
      PARAMETER (ifact2 = ibase**2-1)
      PARAMETER (ifact3 = ibase**3-1)
c=======================================================================
      CHARACTER*1 word1(0:ifact1)
      COMMON /elbat1/ word1
      CHARACTER*1 chax1(maxnbr)
c======================================================================
      CHARACTER*2 word2(0:ifact2)
      COMMON /elbat2/ word2
      CHARACTER*2 chax2(maxnbr)
c======================================================================
      CHARACTER*3 word3(0:ifact3)
      COMMON /elbat3/ word3
      CHARACTER*3 chax3(maxnbr)
c=====================================================================
      INTEGER i, inte
      REAL xmin, xmax
      EXTERNAL ini36
c=====================================================================
c
c--- initialisation pour le codage
c la routine ini36 est appelee une seule fois
c     IF (word1(36) .NE. 'Z' ) THEN
        CALL ini36
c     ENDIF

      IF (nbre .GT. maxnbr) THEN
        PRINT*, 'Nombre elements trop grand', nbre, maxnbr
        STOP
      ENDIF
c
      WRITE(iunit,*) nbre, ibase, icase, '  (nbre,ibase,icase)'
      WRITE(iunit,*) xmin
      WRITE(iunit,*) xmax
c
      IF(xmin .EQ. xmax)THEN
      WRITE(iunit,'(a)')'Ce champ est constant'
      GO TO 999
      ENDIF
c
      IF (icase .EQ. 1) THEN
        DO 10 i = 1, nbre
          inte = NINT( FLOAT(ifact1)/(xmax-xmin) * (x(i)-xmin) )
          chax1(i) = word1(inte)
   10   CONTINUE
        WRITE(iunit,91) (chax1(i),i=1,nbre)
      ELSE IF (icase .EQ. 2) THEN
        DO 20 i = 1, nbre
          inte = NINT( FLOAT(ifact2)/(xmax-xmin) * (x(i)-xmin) )
          chax2(i) = word2(inte)
   20   CONTINUE
        WRITE(iunit,92) (chax2(i),i=1,nbre)
      ELSE IF (icase.eq.3) THEN
        DO 30 i = 1, nbre
          inte = NINT( FLOAT(ifact3)/(xmax-xmin) * (x(i)-xmin) )
          chax3(i) = word3(inte)
   30   CONTINUE
        WRITE(iunit,93) (chax3(i),i=1,nbre)
      ELSE
        PRINT*, 'Verfier icase (1,2,3) dans les arguments de to36'
        STOP
      ENDIF
c
   91 FORMAT(120a1)
   92 FORMAT(64a2)
   93 FORMAT(40a3)
c
  999 RETURN
      END