hdf_tools_exists.F90 5.56 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
      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 
Daniel Wortmann's avatar
Daniel Wortmann committed
35 36 37
      !>
      testid = 0
      hdferr = 0
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
      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 
Daniel Wortmann's avatar
Daniel Wortmann committed
67 68 69
      !>
      testid = 0
      hdferr = 0
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
      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 
Daniel Wortmann's avatar
Daniel Wortmann committed
98 99 100
      !>
      testid = 0
      hdferr = 0
101 102 103 104 105 106 107 108 109 110 111 112 113
      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