
! =======================================                               
! FILNAM                                                                
!                                                                       
! computes  file name in assigned directory                             
! ========================================                              
SUBROUTINE filnam(eledir,astnam,suffix,file,le) 
  IMPLICIT NONE 
  CHARACTER*(*) eledir 
  CHARACTER*(*) astnam 
  CHARACTER*(*) suffix 
  CHARACTER*(*) file 
  INTEGER le 
!==== end interface                                                     
  INTEGER ldir,l1,l2,l3 
  PARAMETER (ldir=60) 
  CHARACTER*200 tmpstr 
  INTEGER lench 
  INCLUDE 'sysdep.h90' 
  l1=lench(eledir) 
  l2=lench(astnam) 
  l3=lench(suffix) 
  IF(l1+l2+l3+2.gt.200)THEN 
     WRITE(*,*) 'filnam: Filename too long:',                       &
          &        eledir(1:l1),dircha,astnam(1:l2),'.',suffix(1:l3)         
     STOP 
  ENDIF
  tmpstr=eledir(1:l1)//dircha//astnam(1:l2)//'.'//suffix(1:l3) 
  CALL rmsp(tmpstr,le) 
  file=tmpstr(1:le) 
  IF(le.gt.ldir-4)THEN 
     WRITE(*,*)'filnam: possible file name truncation',astnam,file 
  ENDIF
END SUBROUTINE filnam
                                                                        
! ==============================================                        
! handling of name with multiple solutions                              
SUBROUTINE splinam(name0,name1,m) 
  IMPLICIT NONE 
  CHARACTER*(*) name0 
  CHARACTER*9 name1 
  INTEGER m 
  INTEGER i 
! find separator                                                        
  i=index(name0,'_') 
  IF(i.le.0)THEN 
!        WRITE(*,*)' name splitting problem for ', name0                
     name1=name0(1:9) 
     m=1 
     RETURN 
  ENDIF
  name1=' ' 
  name1=name0(1:i-1) 
  READ(name0(i+1:i+4),101)m 
  !     WRITE(*,*)name1,m                                                 
101 FORMAT(i4) 
END SUBROUTINE splinam
! =======================================                               
! FIDINAM vers. 4
!                                                                       
! computes  file name in assigned directory, including ONS  
! ========================================                              
SUBROUTINE fidinam(eledir,astnam,suffix,file,le) 
  IMPLICIT NONE 
  INTEGER, PARAMETER :: ldir=100 
  CHARACTER*(60), INTENT(IN) :: eledir 
  CHARACTER*(*), INTENT(IN) :: astnam 
  CHARACTER*3, INTENT(IN) ::  suffix 
  CHARACTER*(*), INTENT(OUT) ::  file
  INTEGER, INTENT(OUT) :: le 
! END INTERFACE
  CHARACTER*9 nam0
  CHARACTER*60 fulldir
  INTEGER ld,ll,ld1 
  INCLUDE 'sysdep.h90' 
  INTEGER j 
  CHARACTER*10 dircom4,direct 
  CALL rmsp(eledir,le) 
! convert name in case it is of the form nam0=namp                      
  call rmsp(astnam,ld1) 
  ll=index(astnam,'=') 
  IF(ll.eq.0)THEN 
     nam0=astnam(1:9) 
  ELSE 
     nam0=astnam(1:ll-1) 
  ENDIF
  CALL rmsp(nam0,ld1) 
  direct=dircom4(nam0,ld)
  IF(eledir(le:le).eq.dircha)THEN 
     fulldir=eledir(1:le)//direct(1:ld) 
  ELSE 
     fulldir=eledir(1:le)//dircha//direct(1:ld) 
  ENDIF
  CALL rmsp(fulldir,le)
  IF(le.gt.ldir)THEN 
     WRITE(*,*)'fidinam: possible directory name truncation for ',astnam
     WRITE(*,*) fulldir 
  ENDIF
  file=fulldir(1:le)//dircha//astnam 
  CALL rmsp(file,le) 
  file=file(1:le)//'.'//suffix 
  CALL rmsp(file,le)
  IF(le.eq.60)THEN
    WRITE(*,*)'fidinam: possible file name truncation for ',astnam
     WRITE(*,*) file
  ENDIF
  DO j=le+1,60 
     file(j:j)=' ' 
  ENDDO
  RETURN 
END SUBROUTINE fidinam
! =============================                                         
! DIRCOM4                                                                
!                                                                       
! computes subdirectory name                                            
CHARACTER*10 FUNCTION dircom4(name0,le) 
  USE output_control 
  IMPLICIT NONE 
  CHARACTER*9 name0 
  INTEGER le 
  CHARACTER*9 name 
  CHARACTER*1 nm 
  INTEGER number,ll,ld,nyea,nodir
! new ONS part
  CHARACTER*3 dat
  DOUBLE PRECISION mjd
  INTEGER lun,lunation
! make sure it is left aligned                                          
  name=name0 
  CALL rmsp(name,ll) 
! find if numbered                                                      
  READ(name,FMT='(I9)',ERR=10)number 
! numbered: directories of 1000 each                                    
  nodir=number/1000 
  dircom4=' ' 
  IF(nodir.gt.99)THEN
     WRITE(dircom4,'(I3)')nodir 
     le=3
  ELSEIF(nodir.gt.9)THEN 
     WRITE(dircom4,'(I2)')nodir 
     le=2 
  ELSE 
     WRITE(dircom4,'(I1)')nodir 
     le=1 
  ENDIF
  RETURN 
! unnumbered                                                            
10 CONTINUE 
! select surveys                                                        
  ld=index(name,'-') 
  IF(ld.gt.0)THEN 
! surveys                                                               
     IF(index(name,'P-L').ne.0)THEN 
! Palomar-Leiden                                                        
        dircom4='P-L' 
        le=3 
     ELSEIF(index(name,'T-').ne.0)THEN 
! trojan surveys                                                        
        le=3 
        IF(index(name,'T-1').ne.0)THEN 
           dircom4='T-1' 
        ELSEIF(index(name,'T-2').ne.0)THEN 
           dircom4='T-2' 
        ELSEIF(index(name,'T-3').ne.0)THEN 
           dircom4='T-3' 
        ELSE 
           WRITE(*,*)'dircom4: name parsing error',name0 
           WRITE(ierrou,*)'dircom4: name parsing error',name0 
           numerr=numerr+1 
           dircom4='unknown' 
           le=7 
        ENDIF
     ELSE 
        WRITE(*,*)'dircom4: name parsing error',name0 
        WRITE(ierrou,*)'dircom4: name parsing error',name0 
        numerr=numerr+1 
        dircom4='unknown' 
        le=7 
     ENDIF
  ELSE 
! by year                                                               
     READ(name(1:4),FMT='(I4)',ERR=20) nyea 
     IF(nyea.lt.1920)THEN 
        dircom4='old' 
        le=3 
     ELSEIF(nyea.lt.1930)THEN 
        dircom4='1920' 
        le=4 
     ELSEIF(nyea.lt.1940)THEN 
        dircom4='1930' 
        le=4 
     ELSEIF(nyea.lt.1950)THEN 
        dircom4='1940' 
        le=4 
     ELSEIF(nyea.lt.1960)THEN 
        dircom4='1950' 
        le=4 
     ELSEIF(nyea.lt.1970)THEN 
        dircom4='1960' 
        le=4 
     ELSEIF(nyea.lt.1980)THEN 
        dircom4='1970' 
        le=4 
     ELSEIF(nyea.ge.1998)THEN 
        nm=name(5:5) 
        WRITE(dircom4,199)nyea,nm 
199     FORMAT(I4,A1) 
        le=5 
     ELSEIF(nyea.lt.0.or.nyea.gt.2100)THEN 
        WRITE(*,*)'dircom4: name parsing error',name0 
        WRITE(ierrou,*)'dircom4: name parsing error',name0 
        numerr=numerr+1 
        dircom4='unknown' 
        le=7 
     ELSE 
        WRITE(dircom4,FMT='(I4)') nyea 
        le=4 
     ENDIF
  ENDIF
  RETURN 
20 CONTINUE
! ONS?
  READ(name(5:7),'(A3)')dat
  CALL decode_mjd(dat,mjd)
  lun=lunation(mjd)
  IF(lun.lt.0.or.lun.gt.999)GOTO 40
  WRITE(dircom4,299)lun
299 FORMAT('ons_',I3)
  CALL rmsp(dircom4,le)
  RETURN
! error parsing year                                                    
40 CONTINUE 
  WRITE(*,*)'dircom4: name parsing error',name0 
  WRITE(ierrou,*)'dircom4: name parsing error',name0 
  numerr=numerr+1 
  dircom4='unknown' 
  le=7 
  RETURN 
END FUNCTION dircom4

INTEGER FUNCTION lunation(mjd) ! number of lunations, from some origin
DOUBLE PRECISION, INTENT(IN) :: mjd ! MJD date
DOUBLE PRECISION, PARAMETER :: per_syn=29.53059d0
DOUBLE PRECISION, PARAMETER :: new_moon0=5.2717d4 ! 19 march 2003
!
DOUBLE PRECISION cycles

cycles=(mjd-new_moon0)/per_syn
lunation=floor(cycles)+200
END FUNCTION lunation

SUBROUTINE lun_limits(lun,t1,t2)
IMPLICIT NONE
INTEGER, INTENT(IN) :: lun
DOUBLE PRECISION, INTENT(OUT) :: t1,t2
DOUBLE PRECISION, PARAMETER :: per_syn=29.53059d0
DOUBLE PRECISION, PARAMETER :: new_moon0=5.2717d4 ! 19 march 2003
t1=new_moon0+(lun-200)*per_syn
t2=t1+per_syn
END SUBROUTINE lun_limits

!!!!!!!!!!!!!!!!!!!!!
! Encoding routines !
!!!!!!!!!!!!!!!!!!!!!
!
! ons_code2 encodes designation
SUBROUTINE ons_code2(n, y, m , d, station, our_ons_code)
IMPLICIT NONE

INTEGER, INTENT(IN) :: n, y, m, d
CHARACTER (LEN=3), INTENT(IN)  :: station
CHARACTER (LEN=9), INTENT(OUT) :: our_ons_code

CHARACTER (LEN=4) :: string_number
CHARACTER (LEN=3) :: string_date
CHARACTER (LEN=2) :: string_station

CALL encode_number(n, string_number)
CALL encode_date(y,m,d, string_date)
CALL encode_station(station, string_station)

our_ons_code =  string_number// string_date // string_station

END SUBROUTINE ons_code2


!=========================================================
!              encode_number
!=========================================================
! INPUT  INTEGER :: 0< n < 54*64**3  
! OUTPUT CHARACTER (LEN=4) :: n_enc 
!
!=========================================================


SUBROUTINE encode_number(n, n_enc)
IMPLICIT NONE 

INTEGER, INTENT(IN) :: n
CHARACTER (LEN=4), INTENT(OUT) :: n_enc

CALL base_10_to_64(n+10*64**3,n_enc)

END SUBROUTINE encode_number

!=========================================================
!              encode_date
!=========================================================
! INPUT   INTEGER :: y, m, d
! OUTPUT  CHARACTER (LEN=3) :: date_code 
! 
!=========================================================

SUBROUTINE encode_date(y, m, d, date_code)
IMPLICIT NONE 

INTEGER, INTENT(IN) :: y, m, d
CHARACTER (LEN=3) :: date_code

DOUBLE PRECISION :: jd
CHARACTER (LEN=4) :: temp_date_code

CALL julian(y,m,d,0,0,0.d0, jd)
!WRITE(*,*) "julian day: ", jd-2400000.5   
CALL base_10_to_64(INT(jd-2400000.5), temp_date_code)

IF(LEN(TRIM(temp_date_code))==1) THEN
date_code = "00"//temp_date_code(1:1)
ELSEIF(LEN(TRIM(temp_date_code))==2) THEN
date_code = "0"//temp_date_code(1:2)
ELSEIF(LEN(TRIM(temp_date_code))==3) THEN
date_code = temp_date_code(1:3)
END IF

END SUBROUTINE encode_date


!=========================================================
!              encode_station
!=========================================================
! INPUT  CHARACTER (LEN=3) :: mpc_code 
! OUTPUT CHARACTER (LEN=2) :: our_code
!
!=========================================================

SUBROUTINE encode_station(mpc_code, our_code)
IMPLICIT NONE 
!INTERFACE
CHARACTER (LEN=3), INTENT(IN)  :: mpc_code 
CHARACTER (LEN=2), INTENT(OUT) :: our_code 
!END INTERFACE
INTEGER :: number, fb64_char_value
CHARACTER (LEN=4):: temp_code



  IF ( INDEX("0123456789", mpc_code(2:2))== 0 .OR. &
       INDEX("0123456789", mpc_code(3:3))== 0 ) THEN ! ERROR
     WRITE (*,*) "WARNING in encode_station: ", mpc_code , &
                   " can't be encoded  (last two characters are not digits!) "
     our_code = "**"
 ELSEIF ( INDEX("0123456789"// &
            "ABCDEFGHIJKLMNOPQRSTUV" // &
            "abcde" , mpc_code(1:1))== 0 ) THEN ! ERROR
    WRITE (*,*) "WARNING in encode_station: ", mpc_code , &
             " can't be encoded  (first digit not handled!) "
    our_code = "**"
 ELSE ! ALMOST RIGHT

    number = fb64_char_value(mpc_code(1:1)) * 100 + &
          fb64_char_value(mpc_code(2:2)) * 10  + &
          fb64_char_value(mpc_code(3:3))  

!WRITE (*,*) "DB:", number
   IF (number >= 4096) THEN ! ERROR
      WRITE (*,*) "WARNING in encode_station: ", mpc_code , " can't be encoded"
      our_code = "**"
   ELSE
      CALL base_10_to_64(number, temp_code)
      IF (LEN(TRIM(temp_code)) == 1) THEN
         our_code = "0"//temp_code(1:1)
      ELSEIF  (LEN(TRIM(temp_code)) == 2) THEN
         our_code = temp_code(1:2)
      END IF
   END IF
END IF

END SUBROUTINE encode_station



!=========================================================
!              decode_number
!=========================================================
! INPUT  CHARACTER (LEN=4) :: number_code 
! OUTPUT INTEGER :: number
!
!=========================================================

SUBROUTINE decode_number (number_code, number)
IMPLICIT NONE
!INTERFACE
CHARACTER (LEN=4), INTENT(IN) :: number_code
INTEGER, INTENT(OUT) :: number
!END INTERFACE

INTEGER :: fb64_char_value
CHARACTER (LEN=64):: basis_64="0123456789"// &
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// &
            "abcdefghijklmnopqrstuvwxyz"// &
            "%&"

IF ((INDEX(basis_64, number_code(1:1)) == 0).OR. &
    (INDEX(basis_64, number_code(2:2)) == 0).OR. &
    (INDEX(basis_64, number_code(3:3)) == 0).OR. &
    (INDEX(basis_64, number_code(4:4)) == 0) ) THEN ! ERROR
   WRITE (*,*) "WARNING in decode_number: ->", number_code, "<- isn't a valid number code." 
   number= -1
ELSE ! RIGHT
   number = (fb64_char_value(number_code(1:1)) * 64**3 + &
             fb64_char_value(number_code(2:2)) * 64**2 + &
             fb64_char_value(number_code(3:3)) * 64    + &
             fb64_char_value(number_code(4:4)))        - &
             10*64**3  
END IF
END SUBROUTINE decode_number


!=========================================================
!              decode_date
!=========================================================
! INPUT  CHARACTER (LEN=3) :: date_code 
! OUTPUT INTEGER :: y, m, d
!
!=========================================================

SUBROUTINE decode_date(date_code, y, m, d)
IMPLICIT NONE
!INTERFACE
CHARACTER (LEN=3), INTENT(IN) :: date_code
INTEGER, INTENT(OUT) :: y, m, d
!END INTERFACE

DOUBLE PRECISION :: tjm, hour
!REAL (KIND=8) ::  tjm, hour
INTEGER :: fb64_char_value
CHARACTER (LEN=64):: basis_64="0123456789"// &
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// &
            "abcdefghijklmnopqrstuvwxyz"// &
            "%&"

IF ((INDEX(basis_64, date_code(1:1)) == 0).OR. &
    (INDEX(basis_64, date_code(2:2)) == 0).OR. &
    (INDEX(basis_64, date_code(3:3)) == 0) ) THEN ! ERROR
   WRITE (*,*) "WARNING in decode_date: ->", date_code, "<- isn't a valid date code." 
   d= -1
   m= -1
   y= -1
   hour= -1
ELSE ! RIGHT
   tjm = (fb64_char_value(date_code(1:1)) * 64**2 + &
          fb64_char_value(date_code(2:2)) * 64    + &
          fb64_char_value(date_code(3:3))) *1.0 

   CALL mjddat(tjm, d, m, y, hour)
END IF

END SUBROUTINE decode_date

SUBROUTINE decode_date_mjd(date_code, tjm)
IMPLICIT NONE
!INTERFACE
CHARACTER (LEN=3), INTENT(IN) :: date_code
DOUBLE PRECISION, INTENT(OUT) :: tjm
!END INTERFACE

INTEGER :: fb64_char_value
CHARACTER (LEN=64):: basis_64="0123456789"// &
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// &
            "abcdefghijklmnopqrstuvwxyz"// &
            "%&"

IF ((INDEX(basis_64, date_code(1:1)) == 0).OR. &
    (INDEX(basis_64, date_code(2:2)) == 0).OR. &
    (INDEX(basis_64, date_code(3:3)) == 0) ) THEN ! ERROR
   WRITE (*,*) "WARNING in decode_date_mjd: ->", date_code,    &
 &           "<- isn't a valid date code." 

ELSE ! RIGHT
   tjm = (fb64_char_value(date_code(1:1)) * 64**2 + &
          fb64_char_value(date_code(2:2)) * 64    + &
          fb64_char_value(date_code(3:3))) *1.0 
END IF

END SUBROUTINE decode_date_mjd

!=========================================================
!              decode_mjd
!=========================================================
! INPUT  CHARACTER (LEN=3) :: date_code 
! OUTPUT INTEGER :: mjd
!
!=========================================================

SUBROUTINE decode_mjd(date_code, tjm)
IMPLICIT NONE
!INTERFACE
CHARACTER (LEN=3), INTENT(IN) :: date_code
DOUBLE PRECISION, INTENT(OUT) :: tjm
!END INTERFACE

INTEGER :: fb64_char_value
CHARACTER (LEN=64):: basis_64="0123456789"// &
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// &
            "abcdefghijklmnopqrstuvwxyz"// &
            "%&"

IF ((INDEX(basis_64, date_code(1:1)) == 0).OR. &
    (INDEX(basis_64, date_code(2:2)) == 0).OR. &
    (INDEX(basis_64, date_code(3:3)) == 0) ) THEN ! ERROR
   WRITE (*,*) "WARNING in decode_date: ->", date_code, "<- isn't a valid date code." 
ELSE ! RIGHT
   tjm = (fb64_char_value(date_code(1:1)) * 64.d0**2 + &
          fb64_char_value(date_code(2:2)) * 64.d0    + &
          fb64_char_value(date_code(3:3)))* 1.d0 
END IF

END SUBROUTINE decode_mjd

!=========================================================
!              decode_station
!=========================================================
! INPUT   CHARACTER (LEN=2) :: station_code
! OUTPUT  CHARACTER (LEN=3) :: station_mpc 
!
!=========================================================

SUBROUTINE decode_station(station_code, station_mpc)
IMPLICIT NONE
!INTERFACE
CHARACTER (LEN=2), INTENT(IN) :: station_code
CHARACTER (LEN=3), INTENT(OUT) :: station_mpc
!END INTERFACE 

INTEGER :: n
INTEGER :: fb64_char_value

INTEGER :: a, aa, aaa
CHARACTER (LEN=64):: basis_64="0123456789"// &
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// &
            "abcdefghijklmnopqrstuvwxyz"// &
            "%&"

IF ((INDEX(basis_64, station_code(1:1)) == 0).OR. &
    (INDEX(basis_64, station_code(2:2)) == 0) ) THEN ! ERROR
   WRITE (*,*) "WARNING in decode_station: ->", station_code, "<- isn't a valid code"
   station_mpc = "***"
ELSE ! RIGHT
   n = fb64_char_value(station_code(1:1)) * 64 + &
        fb64_char_value(station_code(2:2))
!   WRITE(*,*) "number=", n   

   IF (n<10) THEN
      a = n
      station_mpc = "00"//basis_64(a+1:a+1)
   ELSEIF (n<100) THEN
      aa = INT((n*1.)/10.)
      a  = n - aa*10
      station_mpc = "0"//basis_64(aa+1:aa+1)//basis_64(a+1:a+1)
   ELSE
      aaa= INT((n*1.)/100.)
      aa = INT(((n - aaa *100)*1.)/10.)
      a  = n - aaa*100 - aa*10
      !WRITE(*,*) aaa, aa, a
      station_mpc=basis_64(aaa+1:aaa+1)//basis_64(aa+1:aa+1)//basis_64(a+1:a+1)
   END IF
END IF


END SUBROUTINE decode_station




!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Auxiliar subroutines & functions !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!=========================================================
!              base_10_to_64    
!=========================================================
! INPUT            INTEGER :: b_10 < 64**4
! OUTPUT CHARACTER (LEN=4) :: b_64 
!
!=========================================================
SUBROUTINE base_10_to_64(b_10, b_64)
IMPLICIT NONE 
!INTERFACE
INTEGER, INTENT(IN):: b_10
CHARACTER (LEN=4), INTENT(OUT):: b_64
!END INTERFACE

INTEGER :: quotient, rest, temp
CHARACTER (LEN=64):: basis_64="0123456789"// &
     "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// &
     "abcdefghijklmnopqrstuvwxyz"// &
     "%&"
IF ((b_10 >= 64**4).OR.(b_10 < 0)) THEN ! ERROR
   WRITE (*,*) "WARNING base_10_to_64: number ->", b_10, &
               "<- negative or too large!"
   b_64 = "****"
ELSE ! RIGHT
   b_64=""
   quotient = b_10
   DO
      IF (quotient < 64) EXIT 
      temp = INT((quotient*1.)/(64*1.))
      rest = quotient-temp *64
      quotient = temp
      
      b_64 = basis_64(rest+1:rest+1)//TRIM(b_64)
   END DO
   b_64 = basis_64(quotient+1:quotient+1)//TRIM(b_64)
END IF

END SUBROUTINE base_10_to_64

!=========================================================
!              base_64_to_10    
!=========================================================
! INPUT   CHARACTER (LEN=4) :: b_64 (char in 0..9A..Za..z%&)
! OUTPUT  INTEGER :: b_10 
!
!=========================================================

SUBROUTINE base_64_to_10(b_64, b_10)
IMPLICIT NONE 
!INTERFACE
CHARACTER (LEN=4), INTENT(IN):: b_64
INTEGER, INTENT(OUT):: b_10
!END INTERFACE

INTEGER :: n
INTEGER :: fb64_char_value
CHARACTER (LEN=64) :: char_set = "0123456789"// &
     "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// &
     "abcdefghijklmnopqrstuvwxyz"// &
     "%&"

IF ( (LEN(b_64) /= 4) .OR. &
    (INDEX(char_set, b_64(1:1))==0) .OR. &
    (INDEX(char_set, b_64(2:2))==0) .OR. & 
    (INDEX(char_set, b_64(3:3))==0) .OR. &
    (INDEX(char_set, b_64(4:4))==0) ) THEN ! ERROR
!IF ( LEN(b_64) /= 4 ) THEN
WRITE (*,*) "base_64_to_10: Invalid string ->", b_64, "<-"
b_10 = -1
ELSE ! RIGHT 
b_10 = (fb64_char_value(b_64(1:1)) * 64**3 + &
         fb64_char_value(b_64(2:2)) * 64**2 + &
         fb64_char_value(b_64(3:3)) * 64    + &
         fb64_char_value(b_64(4:4)))       


!b_10 = 0
!DO n=0, LEN(TRIM(b_64))-1
!b_10 =  fb64_char_value(b_64(LEN(TRIM(b_64))-n:LEN(TRIM(b_64))-n)) * 64**n + b_10
!WRITE(*,*) b_64(LEN(TRIM(b_64))-n:LEN(TRIM(b_64))-n)
!END DO
END IF

END SUBROUTINE base_64_to_10




SUBROUTINE b64_char_value(char, value)
IMPLICIT NONE 

CHARACTER (LEN=1), INTENT(IN) :: char
INTEGER, INTENT(OUT) :: value

INTEGER :: temp_val

temp_val = IACHAR(char)


IF     ( (48<= temp_val).AND.( temp_val <=57) ) THEN ! 0-9 
value = temp_val - 48
ELSEIF ( (65<= temp_val).AND.( temp_val <=90 ) ) THEN ! A-Z
value = temp_val - 65 + 10
ELSEIF ( (97<= temp_val).AND.( temp_val <=122) ) THEN ! a-z
value = temp_val - 97 + 36
ELSEIF ( (37<= temp_val).AND.( temp_val <=38 ) ) THEN ! %-&
value = temp_val - 37 + 62
ELSE
value = -1
WRITE(*,*) "WARNING in b64_char_value: character ->", char, "<- not allowed"
END IF

END SUBROUTINE b64_char_value



!=========================================================
!                 fb64_char_value 
!=========================================================
! INPUT  CHARAACTER (LEN=1) :: char (in 0..9A..Za..z%&)
! OUTPUT CHARACTER (LEN=4) :: b_64 
!
!=========================================================

FUNCTION fb64_char_value(char)
IMPLICIT NONE 
!INTERFACE
CHARACTER (LEN=1), INTENT(IN) :: char
INTEGER :: fb64_char_value
!END INTERFACE

INTEGER :: temp_val



temp_val = IACHAR(char)

IF     ( (48<= temp_val).AND.( temp_val <=57) ) THEN ! 0-9 
fb64_char_value = temp_val - 48
ELSEIF ( (65<= temp_val).AND.( temp_val <=90 ) ) THEN ! A-Z
fb64_char_value = temp_val - 65 + 10
ELSEIF ( (97<= temp_val).AND.( temp_val <=122) ) THEN ! a-z
fb64_char_value = temp_val - 97 + 36
ELSEIF ( (37<= temp_val).AND.( temp_val <=38 ) ) THEN ! %-&
fb64_char_value = temp_val - 37 + 62
ELSE ! ERROR
fb64_char_value = -1
!WRITE(*,*) "WARNING in b64_char_value: character ->", char, "<- not allowed"
END IF

END FUNCTION fb64_char_value

