hdf_tools_exists.F90 5.65 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
      MODULE m_hdf_tools3 
!-----------------------------------------------                        
!     major rewrite of hdf_tools                                        
!     this module contains only the                                     
!     subroutines                                                       
!                                                                       
!     io_[data/att/group]exists(id,name) to check for objects           
!                                                                       
!-----------------------------------------------                        
      CONTAINS 
      !<-- functions to test for objects                                
      !<-- F: io_dataexists(gid,name)RESULT(exists)                     
                                                                        
      FUNCTION io_dataexists(gid,name)RESULT(exist) 
!******************************************                             
!     checks if dataset called 'name' exists at position gid            
!                          D. Wortmann                                  
!******************************************                             
      USE hdf5 
      IMPLICIT NONE 
      !<--Arguments                                                     
      INTEGER(HID_T),INTENT(IN)  ::gid 
      CHARACTER,INTENT(IN)       ::name*(*) 
      LOGICAL                    ::exist 
      !>                                                                
      !<--Locals                                                        
      INTEGER(HID_t)::testid 
      INTEGER       ::hdferr 
      !>                                                                
      CALL h5eclear_f(hdferr) 
                                    !No automatic error checking!       
      CALL h5eset_auto_f(0, hdferr) 
      CALL h5dopen_f(gid,name,testid,hdferr) 
      exist=(hdferr.EQ.0) 
      CALL h5dclose_f(testid,hdferr) 
      CALL h5eclear_f(hdferr) 
                                    !Resume automatic error checking!   
      CALL h5eset_auto_f(1, hdferr) 
      END FUNCTION 
                                                                        
      !>                                                                
                                                                        
      !<-- F: io_attexists(gid,name)RESULT(exists)                      
      FUNCTION io_attexists(gid,name)RESULT(exist) 
!******************************************                             
!     checks if attribute called 'name' exists at position gid          
!                          D. Wortmann                                  
!******************************************                             
      USE hdf5 
      IMPLICIT NONE 
      !<--Arguments                                                     
      INTEGER(HID_T),INTENT(IN)  ::gid 
      CHARACTER,INTENT(IN)       ::name*(*) 
      LOGICAL                    ::exist 
      !>                                                                
      !<--Locals                                                        
      INTEGER(HID_t)::testid 
      INTEGER       ::hdferr 
      !>                                                                
      CALL h5eclear_f(hdferr) 
                                    !No automatic error checking!       
      CALL h5eset_auto_f(0, hdferr) 
      CALL h5aopen_name_f(gid,name,testid,hdferr) 
      exist=(hdferr.EQ.0) 
      CALL h5aclose_f(testid,hdferr) 
      CALL h5eclear_f(hdferr) 
                                    !Resume automatic error checking!   
      CALL h5eset_auto_f(1, hdferr) 
      END FUNCTION 
      !>                                                                
                                                                        
      !<-- F: io_groupexists(gid,name)RESULT(exists)                    
      FUNCTION io_groupexists(gid,name)RESULT(exist) 
!******************************************                             
!     checks if group called 'name' exists at position gid              
!                          D. Wortmann                                  
!******************************************                             
      USE hdf5 
      IMPLICIT NONE 
      !<--Arguments                                                     
      INTEGER(HID_T),INTENT(IN)  ::gid 
      CHARACTER,INTENT(IN)       ::name*(*) 
      LOGICAL                    ::exist 
      !>                                                                
      !<--Locals                                                        
      INTEGER(HID_t)::testid 
      INTEGER       ::hdferr 
      !>                                                                
      CALL h5eclear_f(hdferr) 
                                    !No automatic error checking!       
      CALL h5eset_auto_f(0, hdferr) 
      CALL h5gopen_f(gid,name,testid,hdferr) 
      exist=(hdferr.EQ.0) 
      CALL h5gclose_f(testid,hdferr) 
      CALL h5eclear_f(hdferr) 
                                    !Resume automatic error checking!   
      CALL h5eset_auto_f(1, hdferr) 
      END FUNCTION 
      !>                                                                
      !>                                                                
      END