1! This is part of the netCDF package. 2! Copyright 2006 University Corporation for Atmospheric Research/Unidata. 3! See COPYRIGHT file for conditions of use. 4 5! This program tests netCDF-4 variable functions from fortran. 6 7! Ed Hartnett 8 9program f90tst_grps 10 use typeSizes 11 use netcdf 12 implicit none 13 14 ! This is the name of the data file we will create. 15 character (len = *), parameter :: FILE_NAME = "f90tst_grps.nc" 16 17 ! We are writing 2D data, a 6 x 12 grid. 18 integer, parameter :: MAX_DIMS = 2 19 integer, parameter :: NX = 6, NY = 12 20 21 ! We need these ids and other gunk for netcdf. 22 integer :: ncid, varid1, varid2, varid3, varid4, dimids(MAX_DIMS) 23 integer :: chunksizes(MAX_DIMS), chunksizes_in(MAX_DIMS) 24 integer :: x_dimid, y_dimid 25 integer :: nvars, ngatts, ndims, unlimdimid, file_format 26 integer, parameter :: CACHE_NELEMS = 10000, CACHE_SIZE = 1000000 27 integer, parameter :: DEFLATE_LEVEL = 4 28 integer (kind = EightByteInt), parameter :: TOE_SAN_VALUE = 2147483648_EightByteInt 29 character (len = *), parameter :: VAR1_NAME = "Payroll" 30 character (len = *), parameter :: VAR2_NAME = "Spies" 31 character (len = *), parameter :: VAR3_NAME = "Propaganda" 32 character (len = *), parameter :: VAR4_NAME = "Arms" 33 character (len = *), parameter :: GRP1_NAME = "Irish_Republican_Brotherhood" 34 character (len = *), parameter :: GRP2_NAME = "Sinn_Fein" 35 character (len = *), parameter :: GRP3_NAME = "Gaelic_Athletic_Association" 36 character (len = *), parameter :: GRP4_NAME = "Provisional_Government" 37 38 character (len = NF90_MAX_NAME) :: grp1_full_name 39 integer :: len 40 41 ! Information read back from the file to check correctness. 42 integer :: varid1_in, varid2_in, varid3_in, varid4_in 43 integer :: grpid1, grpid2, grpid3, grpid4 44 integer :: xtype_in, ndims_in, natts_in, dimids_in(MAX_DIMS) 45 character (len = nf90_max_name) :: name_in 46 integer :: endianness_in, deflate_level_in 47 logical :: shuffle_in, fletcher32_in, contiguous_in 48 49 print *, '' 50 print *,'*** Testing netCDF-4 groups from Fortran 90.' 51 52 ! Create the netCDF file. 53 call check(nf90_create(FILE_NAME, nf90_netcdf4, ncid)) 54 55 ! Define the dimensions. 56 call check(nf90_def_dim(ncid, "x", NX, x_dimid)) 57 call check(nf90_def_dim(ncid, "y", NY, y_dimid)) 58 dimids = (/ y_dimid, x_dimid /) 59 60 ! Define some nested groups. 61 call check(nf90_def_grp(ncid, GRP1_NAME, grpid1)) 62 call check(nf90_def_grp(grpid1, GRP2_NAME, grpid2)) 63 call check(nf90_def_grp(grpid2, GRP3_NAME, grpid3)) 64 call check(nf90_def_grp(grpid3, GRP4_NAME, grpid4)) 65 66 ! Define some variables. 67 chunksizes = (/ NY, NX /) 68 call check(nf90_def_var(ncid, VAR1_NAME, NF90_INT, dimids, varid1, chunksizes = chunksizes, & 69 shuffle = .TRUE., fletcher32 = .TRUE., endianness = nf90_endian_big, deflate_level = DEFLATE_LEVEL)) 70 call check(nf90_def_var(grpid1, VAR2_NAME, NF90_INT, dimids, varid2, contiguous = .TRUE.)) 71 call check(nf90_def_var(grpid2, VAR3_NAME, NF90_INT64, varid3)) 72 call check(nf90_def_var(grpid3, VAR4_NAME, NF90_INT, x_dimid, varid4, contiguous = .TRUE.)) 73 74 ! Close the file. 75 call check(nf90_close(ncid)) 76 77 ! Reopen the file. 78 call check(nf90_open(FILE_NAME, nf90_nowrite, ncid)) 79 80 ! Check some stuff out. 81 call check(nf90_inquire(ncid, ndims, nvars, ngatts, unlimdimid, file_format)) 82 if (ndims /= 2 .or. nvars /= 1 .or. ngatts /= 0 .or. unlimdimid /= -1 .or. & 83 file_format /= nf90_format_netcdf4) stop 21 84 85 ! Get the group ids for the newly reopened file. 86 call check(nf90_inq_grp_ncid(ncid, GRP1_NAME, grpid1)) 87 call check(nf90_inq_grp_ncid(grpid1, GRP2_NAME, grpid2)) 88 call check(nf90_inq_grp_ncid(grpid2, GRP3_NAME, grpid3)) 89 call check(nf90_inq_grp_ncid(grpid3, GRP4_NAME, grpid4)) 90 91 ! Check for the groups with full group names. 92 write(grp1_full_name, '(A,A)') '/', GRP1_NAME 93 call check(nf90_inq_grp_full_ncid(ncid, grp1_full_name, grpid1)) 94 call check(nf90_inq_grpname(grpid1, name_in)) 95 if (name_in .ne. GRP1_NAME) stop 61 96 call check(nf90_inq_grpname_full(grpid1, len, name_in)) 97 if (name_in .ne. grp1_full_name) stop 62 98 99 ! Get varids. 100 call check(nf90_inq_varid(ncid, VAR1_NAME, varid1_in)) 101 call check(nf90_inq_varid(grpid1, VAR2_NAME, varid2_in)) 102 call check(nf90_inq_varid(grpid2, VAR3_NAME, varid3_in)) 103 call check(nf90_inq_varid(grpid3, VAR4_NAME, varid4_in)) 104 105 ! Check variable 1. 106 call check(nf90_inquire_variable(ncid, varid1_in, name_in, xtype_in, ndims_in, dimids_in, & 107 natts_in, chunksizes = chunksizes_in, endianness = endianness_in, fletcher32 = fletcher32_in, & 108 deflate_level = deflate_level_in, shuffle = shuffle_in)) 109 if (name_in .ne. VAR1_NAME .or. xtype_in .ne. NF90_INT .or. ndims_in .ne. MAX_DIMS .or. & 110 natts_in .ne. 0 .or. dimids_in(1) .ne. dimids(1) .or. dimids_in(2) .ne. dimids(2)) stop 3 111 if (chunksizes_in(1) /= chunksizes(1) .or. chunksizes_in(2) /= chunksizes(2)) & 112 stop 4 113 if (endianness_in .ne. nf90_endian_big) stop 5 114 115 ! Check variable 2. 116 call check(nf90_inquire_variable(grpid1, varid2_in, name_in, xtype_in, ndims_in, dimids_in, & 117 natts_in, contiguous = contiguous_in, endianness = endianness_in, fletcher32 = fletcher32_in, & 118 deflate_level = deflate_level_in, shuffle = shuffle_in)) 119 if (name_in .ne. VAR2_NAME .or. xtype_in .ne. NF90_INT .or. ndims_in .ne. MAX_DIMS .or. & 120 natts_in .ne. 0 .or. dimids_in(1) .ne. dimids(1) .or. dimids_in(2) .ne. dimids(2)) stop 6 121 if (deflate_level_in .ne. 0 .or. .not. contiguous_in .or. fletcher32_in .or. shuffle_in) stop 7 122 123 ! Check variable 3. 124 call check(nf90_inquire_variable(grpid2, varid3_in, name_in, xtype_in, ndims_in, dimids_in, & 125 natts_in, contiguous = contiguous_in, endianness = endianness_in, fletcher32 = fletcher32_in, & 126 deflate_level = deflate_level_in, shuffle = shuffle_in)) 127 if (name_in .ne. VAR3_NAME .or. xtype_in .ne. NF90_INT64 .or. ndims_in .ne. 0 .or. & 128 natts_in .ne. 0) stop 8 129 if (deflate_level_in .ne. 0 .or. .not. contiguous_in .or. fletcher32_in .or. shuffle_in) stop 9 130 131 ! Check variable 4. 132 call check(nf90_inquire_variable(grpid3, varid4_in, name_in, xtype_in, ndims_in, dimids_in, & 133 natts_in, contiguous = contiguous_in, endianness = endianness_in, fletcher32 = fletcher32_in, & 134 deflate_level = deflate_level_in, shuffle = shuffle_in)) 135 if (name_in .ne. VAR4_NAME .or. xtype_in .ne. NF90_INT .or. ndims_in .ne. 1 .or. & 136 natts_in .ne. 0 .or. dimids_in(1) .ne. x_dimid) stop 10 137 if (deflate_level_in .ne. 0 .or. .not. contiguous_in .or. fletcher32_in .or. shuffle_in) stop 11 138 139 ! Close the file. 140 call check(nf90_close(ncid)) 141 142 print *,'*** SUCCESS!' 143 144contains 145! This subroutine handles errors by printing an error message and 146! exiting with a non-zero status. 147 subroutine check(errcode) 148 use netcdf 149 implicit none 150 integer, intent(in) :: errcode 151 152 if(errcode /= nf90_noerr) then 153 print *, 'Error: ', trim(nf90_strerror(errcode)) 154 stop 2 155 endif 156 end subroutine check 157end program f90tst_grps 158 159