hash_table.f

Go to the documentation of this file.

      MODULE hash_table
!
      USE declarations_special
      IMPLICIT NONE
!
      INTEGER, PARAMETER :: max_file = 3000
!
      CONTAINS
!
      SUBROUTINE get_obj
!***********************************************************************
!
     &(hash,file_id,hashed_id,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the index in the obj_tab for a give file id
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HASH           |<->| HASH TABLE
!| FILE_ID        |-->| ID OF THE FILE
!| HASHED_ID      |<->| ID IN THE SRF_OBJ_TAB
!| IERR           |-->| 0 IF EVERYTHING WENT FINE, ERROR INDEX OTHERWISE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(INOUT) :: HASHED_ID
        INTEGER, INTENT(INOUT) :: HASH(max_file)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: I
        !
        hashed_id = 0
        ! LOOK FOR THE ID LINKED TO THAT FILE_ID
        DO i=1,max_file
          IF (hash(i).EQ.file_id) THEN
            hashed_id = i
            EXIT
          ENDIF
        ENDDO
        ! IF HASHED_ID == 0 THEN NO ID WAS FOUND RETURN ERROR
        IF(hashed_id.EQ.0) THEN
          ierr = hermes_file_not_opened_err
        ELSE
          ierr = 0
        ENDIF
        hashed_id = hashed_id
        !
        RETURN
      END SUBROUTINE

!***********************************************************************
      SUBROUTINE add_obj
!***********************************************************************
!
     &(hash,file_id,hashed_id,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Add a new file to the obj_tab and returns its new id
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HASH           |<->| HASH TABLE
!| FILE_ID        |-->| ID OF THE FILE
!| HASHED_ID      |<->| ID IN THE SRF_OBJ_TAB
!| IERR           |-->| 0 IF EVERYTHING WENT FINE, ERROR INDEX OTHERWISE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(INOUT) :: HASH(max_file)
        INTEGER, INTENT(IN)  :: FILE_ID
        INTEGER, INTENT(INOUT) :: HASHED_ID
        INTEGER, INTENT(OUT) :: IERR
        !
        hashed_id = 0
        ! CHECK IF THE FILE IS ALREADY OPEN
        CALL get_obj(hash,file_id,hashed_id,ierr)
        IF(hashed_id.NE.0) THEN
          ierr = hermes_file_id_already_in_use_err
          RETURN
        ENDIF
        ! WE RESET THE IERR TO ZERO AS THE PREVIOUS CALL SHOULD
        ! HAVE CRASHED AS THE FILES IS NOT OPENED YET
        ierr = 0
        !
        ! Look far a place in the hash table
        hashed_id = 1
        DO
          IF(hashed_id.GT.max_file) EXIT
          IF(hash(hashed_id).EQ.0) EXIT
          hashed_id = hashed_id + 1
        ENDDO
        ! CHECK IF WE'VE REACH THE MAXIMUM NUMBER OF FILES
        IF(hashed_id.GT.max_file) THEN
          ierr = hermes_max_file_err
          RETURN
        ELSE
          hash(hashed_id) = file_id
        ENDIF
        !
        RETURN
      END SUBROUTINE

      END MODULE hash_table