!======================================================================
! Description: Table handling subroutines. Separate each columns in a
!              row, and convert them to integer or float.
!                                             Sep. 2002  Zhichang Guo
! $Log: drv_table_mod.f90,v $
! Revision 1.1  2002/09/17  17:15:17  guo
! Initial revision
!
!======================================================================
MODULE drv_table_mod

CONTAINS
!           
!---------------------------------------------------------------------
SUBROUTINE tbl_get_columns(row, rowleng, colleng, sep, cols, cols_num)
!           
! Purpose: Separate each columns in a row of a table
!                      Zhichang Guo 08/2002
  IMPLICIT NONE
  INTEGER, PARAMETER                  :: cols_max = 15
  INTEGER, INTENT(IN)                 :: rowleng, colleng, cols_num
  CHARACTER(LEN=1), INTENT(IN)        :: sep  
  CHARACTER(LEN=rowleng), INTENT(IN)  :: row
  CHARACTER(LEN=colleng), INTENT(OUT) :: cols(cols_max)
! local arguments
  INTEGER                             :: i, istart, iend 
  iend = 1
  istart = 0
  DO i = 1,cols_num
    CALL tbl_get_column(row, rowleng, colleng, sep, istart, iend, cols(i))
    istart = iend
  ENDDO
END SUBROUTINE tbl_get_columns
!           
!---------------------------------------------------------------------
SUBROUTINE tbl_get_column(row, rowleng, colleng, sep, istart, iend, col)
!           
!     purpose: returns the ending location and section of a
!              string starting at a cetain location and ending
!              with the declared separator 
!                                        Zhichang Guo 08/2002
      IMPLICIT NONE
      INTEGER                :: rowleng, colleng
      INTEGER                :: istart
      INTEGER                :: iend
      CHARACTER(LEN=rowleng) :: row
      CHARACTER(LEN=1)       :: sep  
      CHARACTER(LEN=colleng) :: col
! local arguments
      INTEGER                :: i, l
      DO l = 1,colleng
        col(l:l) = ' '
      ENDDO
      i = 0
      DO l = istart+1,rowleng
         i = i +1 
         IF(i <= colleng) THEN
           col(i:i) = row(l:l)
           IF(row(l:l) == sep(1:1)) THEN
              iend = l
              col(i:i) = ' '
              RETURN 
           END IF
         END IF
      ENDDO
      iend = rowleng
END SUBROUTINE tbl_get_column
!           
!---------------------------------------------------------------------
SUBROUTINE tbl_get_colnum(row, rowleng, sep, cols_num)
!           
! Purpose: find the total number of columns in a row
!                      Zhichang Guo 08/2002
  IMPLICIT NONE
  INTEGER, INTENT(IN)                 :: rowleng
  INTEGER, INTENT(OUT)                :: cols_num
  CHARACTER(LEN=1), INTENT(IN)        :: sep  
  CHARACTER(LEN=rowleng), INTENT(IN)  :: row
! local arguments
  CHARACTER(LEN=1)                    :: first_char, last_char  
  LOGICAL                             :: first_notfound
  INTEGER                             :: l 
  cols_num = 0
  first_notfound = .TRUE.
  DO l = 1,rowleng
     IF(row(l:l) /= ' ' .AND. first_notfound) THEN
       first_notfound = .FALSE.
       first_char = row(l:l)
     ENDIF
     IF(row(l:l) /= ' ') last_char = row(l:l)
     IF(row(l:l) == sep(1:1)) cols_num = cols_num + 1
  ENDDO
  cols_num = cols_num + 1
  IF(first_char == sep(1:1)) cols_num = cols_num - 1
  IF(last_char == sep(1:1)) cols_num = cols_num - 1
END SUBROUTINE tbl_get_colnum
!           
!---------------------------------------------------------------------
 FUNCTION tbl_c2i(string, totleng, strlen)
!           
! Purpose: convert a string into an INTEGER
!                      Zhichang Guo 08/2002
      IMPLICIT NONE
      INTEGER                :: strlen, totleng
      INTEGER                :: tbl_c2i
      CHARACTER(LEN=totleng) :: string
! local arguments
      INTEGER                :: i, j, ndec
      REAL                   :: value
      CHARACTER(LEN=20)      :: formt
      IF(strlen > 0) THEN
        j = strlen + 1
        DO i = 1,strlen
          IF(string(i:i) == '.') THEN
            j = i
          END IF
        ENDDO
        ndec = strlen - j
        IF(ndec >= 0) THEN
          WRITE(formt,'(2h(f,i1,1h.,i1,1h))') strlen,ndec
          READ(string(1:strlen), FMT=formt) value
          tbl_c2i = INT(value)  
        ELSE
          WRITE(formt,'(2h(i,i1,1h))') strlen
          READ(string(1:strlen), FMT=formt) tbl_c2i
        END IF    
      ELSE
        tbl_c2i = 0
      END IF    
END FUNCTION tbl_c2i
!           
!---------------------------------------------------------------------
FUNCTION tbl_c2f(string, totleng, strlen)
!           
! Purpose: convert a string into a float
!                      Zhichang Guo 08/2002
      IMPLICIT NONE
      INTEGER                :: strlen, totleng
      CHARACTER(LEN=totleng) :: string
      REAL                   :: tbl_c2f
! local arguments
      INTEGER                :: i, j, l, ndec
      INTEGER                :: value
      CHARACTER(LEN=20)      :: formt
      LOGICAL                :: efound
      efound =.FALSE.
      IF(strlen > 0) THEN
        j = strlen + 1
        DO i = 1,strlen
          IF(string(i:i) == '.' ) THEN
            j = i
          ELSE IF(string(i:i) == 'E' .or. string(i:i) == 'e') THEN
            efound = .true.
            l = i
          END IF
        ENDDO
        ndec = strlen - j
        IF(ndec >= 0 .OR. efound) THEN
          IF(efound) THEN
            ndec = l - 1 - j
            IF(ndec < 0) ndec = 0
            WRITE(formt,'(2h(e,i1,1h.,i1,1h))') strlen,ndec
            READ (string(1:strlen), FMT=formt) tbl_c2f
          ELSE
            WRITE(formt,'(2h(f,i1,1h.,i1,1h))') strlen,ndec
            READ (string(1:strlen), FMT=formt) tbl_c2f
          ENDIF
        ELSE
          WRITE(formt,'(2h(i,i1,1h))') strlen
          READ (string(1:strlen), FMT=formt) value  
          tbl_c2f = FLOAT(value)  
        END IF
      ELSE
        tbl_c2f = 0.    
      END IF    
END FUNCTION tbl_c2f
!---------------------------------------------------------------------
      SUBROUTINE tbl_nblank(choice, string, totleng, strlen)
! 
!     purpose:  remove blanks from a string
!         choice = 1 : remove all blanks before the first letter and
!                      after the last letter
!         choice = 2 : remove all blanks
!                                        Zhichang Guo 08/2002
!
      IMPLICIT NONE
      INTEGER                :: strlen, choice, totleng
      CHARACTER(LEN=totleng) :: string
! local arguments
      INTEGER                :: i, j, k, l
      CHARACTER(LEN=totleng) :: dummy
!
      DO i = 1,totleng
         dummy(i:i) = string(i:i)
      ENDDO
!                           
!     ... remove all blanks before the first letter and after the last letter
!                           
        i = 1     
        DO WHILE(dummy(i:i) == ' ')
           i = i + 1
        ENDDO 
        j = totleng     
        DO WHILE(dummy(j:j) == ' ')
           j = j - 1
        ENDDO 
      IF(choice == 1) THEN
        l = 0
        DO k = i,j
          l = l + 1
          string(l:l) = dummy(k:k)
        ENDDO
        strlen = j - i + 1
        DO k = l+1,totleng 
           string(k:k)=' '
        ENDDO 
!                           
!     ... remove all blanks 
!
      ELSE IF(choice == 2) THEN
        l = 0
        DO k = i,j
          IF(dummy(k:k) /= ' ') THEN 
            l = l + 1
            string(l:l) = dummy(k:k)
          ENDIF
        ENDDO
        strlen = l
        DO k = l+1,totleng 
          string(k:k)=' '
        ENDDO 
      ELSE
        PRINT*, 'invalid choice for nblank'
        CALL ABORT
      ENDIF
      IF(string(1:strlen) == 'n/a' .OR. string(1:strlen) == 'N/A') THEN
        strlen = 0
        string(1:totleng) = ' '
      ENDIF
END SUBROUTINE tbl_nblank
END MODULE drv_table_mod