! $Id$ module nf95_gw_var_m implicit none interface nf95_gw_var ! "nf95_gw_var" stands for "NetCDF 1995 get whole variable". ! These procedures read a whole NetCDF variable (coordinate or ! primary) into an array. ! The difference between the procedures is the rank of the array ! and the type of Fortran values. ! The procedures do not check the type of the NetCDF variable. !!$ module procedure nf95_gw_var_real_1d, nf95_gw_var_real_2d, & !!$ nf95_gw_var_real_3d, nf95_gw_var_real_4d, nf95_gw_var_dble_1d, & !!$ nf95_gw_var_dble_3d, nf95_gw_var_int_1d, nf95_gw_var_int_3d module procedure nf95_gw_var_real_1d, nf95_gw_var_real_2d, & nf95_gw_var_real_3d, nf95_gw_var_real_4d, nf95_gw_var_int_1d, & nf95_gw_var_int_3d end interface private public nf95_gw_var contains subroutine nf95_gw_var_real_1d(ncid, varid, values) ! Real type, the array has rank 1. use netcdf, only: NF90_GET_VAR use simple, only: nf95_inquire_variable, nf95_inquire_dimension use handle_err_m, only: handle_err integer, intent(in):: ncid integer, intent(in):: varid real, pointer:: values(:) ! Variables local to the procedure: integer ierr, len integer, pointer :: dimids(:) !--------------------- call nf95_inquire_variable(ncid, varid, dimids=dimids) if (size(dimids) /= 1) then print *, "nf95_gw_var_real_1d: NetCDF variable is not of rank 1" stop 1 end if call nf95_inquire_dimension(ncid, dimids(1), len=len) deallocate(dimids) ! pointer allocate(values(len)) if (len /= 0) then ierr = NF90_GET_VAR(ncid, varid, values) call handle_err("NF90_GET_VAR", ierr, ncid, varid) end if end subroutine nf95_gw_var_real_1d !************************************ subroutine nf95_gw_var_real_2d(ncid, varid, values) ! Real type, the array has rank 2. use netcdf, only: NF90_GET_VAR use simple, only: nf95_inquire_variable, nf95_inquire_dimension use handle_err_m, only: handle_err integer, intent(in):: ncid integer, intent(in):: varid real, pointer:: values(:, :) ! Variables local to the procedure: integer ierr, len1, len2 integer, pointer :: dimids(:) !--------------------- call nf95_inquire_variable(ncid, varid, dimids=dimids) if (size(dimids) /= 2) then print *, "nf95_gw_var_real_2d: NetCDF variable is not of rank 2" stop 1 end if call nf95_inquire_dimension(ncid, dimids(1), len=len1) call nf95_inquire_dimension(ncid, dimids(2), len=len2) deallocate(dimids) ! pointer allocate(values(len1, len2)) if (len1 /= 0 .and. len2 /= 0) then ierr = NF90_GET_VAR(ncid, varid, values) call handle_err("NF90_GET_VAR", ierr, ncid, varid) end if end subroutine nf95_gw_var_real_2d !************************************ subroutine nf95_gw_var_real_3d(ncid, varid, values) ! Real type, the array has rank 3. use netcdf, only: NF90_GET_VAR use simple, only: nf95_inquire_variable, nf95_inquire_dimension use handle_err_m, only: handle_err integer, intent(in):: ncid integer, intent(in):: varid real, pointer:: values(:, :, :) ! Variables local to the procedure: integer ierr, len1, len2, len3 integer, pointer :: dimids(:) !--------------------- call nf95_inquire_variable(ncid, varid, dimids=dimids) if (size(dimids) /= 3) then print *, "nf95_gw_var_real_3d: NetCDF variable is not of rank 3" stop 1 end if call nf95_inquire_dimension(ncid, dimids(1), len=len1) call nf95_inquire_dimension(ncid, dimids(2), len=len2) call nf95_inquire_dimension(ncid, dimids(3), len=len3) deallocate(dimids) ! pointer allocate(values(len1, len2, len3)) if (len1 * len2 * len3 /= 0) then ierr = NF90_GET_VAR(ncid, varid, values) call handle_err("NF90_GET_VAR", ierr, ncid, varid) end if end subroutine nf95_gw_var_real_3d !************************************ subroutine nf95_gw_var_real_4d(ncid, varid, values) ! Real type, the array has rank 4. use netcdf, only: NF90_GET_VAR use simple, only: nf95_inquire_variable, nf95_inquire_dimension use handle_err_m, only: handle_err integer, intent(in):: ncid integer, intent(in):: varid real, pointer:: values(:, :, :, :) ! Variables local to the procedure: integer ierr, len_dim(4), i integer, pointer :: dimids(:) !--------------------- call nf95_inquire_variable(ncid, varid, dimids=dimids) if (size(dimids) /= 4) then print *, "nf95_gw_var_real_4d: NetCDF variable is not of rank 4" stop 1 end if do i = 1, 4 call nf95_inquire_dimension(ncid, dimids(i), len=len_dim(i)) end do deallocate(dimids) ! pointer allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4))) if (all(len_dim /= 0)) then ierr = NF90_GET_VAR(ncid, varid, values) call handle_err("NF90_GET_VAR", ierr, ncid, varid) end if end subroutine nf95_gw_var_real_4d !************************************ !!$ subroutine nf95_gw_var_dble_1d(ncid, varid, values) !!$ !!$ ! Double precision, the array has rank 1. !!$ !!$ use netcdf, only: NF90_GET_VAR !!$ use simple, only: nf95_inquire_variable, nf95_inquire_dimension !!$ use handle_err_m, only: handle_err !!$ !!$ integer, intent(in):: ncid !!$ integer, intent(in):: varid !!$ double precision, pointer:: values(:) !!$ !!$ ! Variables local to the procedure: !!$ integer ierr, len !!$ integer, pointer :: dimids(:) !!$ !!$ !--------------------- !!$ !!$ call nf95_inquire_variable(ncid, varid, dimids=dimids) !!$ !!$ if (size(dimids) /= 1) then !!$ print *, "nf95_gw_var_dble_1d: NetCDF variable is not of rank 1" !!$ stop 1 !!$ end if !!$ !!$ call nf95_inquire_dimension(ncid, dimids(1), len=len) !!$ deallocate(dimids) ! pointer !!$ !!$ allocate(values(len)) !!$ if (len /= 0) then !!$ ierr = NF90_GET_VAR(ncid, varid, values) !!$ call handle_err("NF90_GET_VAR", ierr, ncid, varid) !!$ end if !!$ !!$ end subroutine nf95_gw_var_dble_1d !!$ !!$ !************************************ !!$ !!$ subroutine nf95_gw_var_dble_3d(ncid, varid, values) !!$ !!$ ! Double precision, the array has rank 3. !!$ !!$ use netcdf, only: NF90_GET_VAR !!$ use simple, only: nf95_inquire_variable, nf95_inquire_dimension !!$ use handle_err_m, only: handle_err !!$ !!$ integer, intent(in):: ncid !!$ integer, intent(in):: varid !!$ double precision, pointer:: values(:, :, :) !!$ !!$ ! Variables local to the procedure: !!$ integer ierr, len1, len2, len3 !!$ integer, pointer :: dimids(:) !!$ !!$ !--------------------- !!$ !!$ call nf95_inquire_variable(ncid, varid, dimids=dimids) !!$ !!$ if (size(dimids) /= 3) then !!$ print *, "nf95_gw_var_dble_3d: NetCDF variable is not of rank 3" !!$ stop 1 !!$ end if !!$ !!$ call nf95_inquire_dimension(ncid, dimids(1), len=len1) !!$ call nf95_inquire_dimension(ncid, dimids(2), len=len2) !!$ call nf95_inquire_dimension(ncid, dimids(3), len=len3) !!$ deallocate(dimids) ! pointer !!$ !!$ allocate(values(len1, len2, len3)) !!$ if (len1 * len2 * len3 /= 0) then !!$ ierr = NF90_GET_VAR(ncid, varid, values) !!$ call handle_err("NF90_GET_VAR", ierr, ncid, varid) !!$ end if !!$ !!$ end subroutine nf95_gw_var_dble_3d !************************************ subroutine nf95_gw_var_int_1d(ncid, varid, values) ! Integer type, the array has rank 1. use netcdf, only: NF90_GET_VAR use simple, only: nf95_inquire_variable, nf95_inquire_dimension use handle_err_m, only: handle_err integer, intent(in):: ncid integer, intent(in):: varid integer, pointer:: values(:) ! Variables local to the procedure: integer ierr, len integer, pointer :: dimids(:) !--------------------- call nf95_inquire_variable(ncid, varid, dimids=dimids) if (size(dimids) /= 1) then print *, "nf95_gw_var_int_1d: NetCDF variable is not of rank 1" stop 1 end if call nf95_inquire_dimension(ncid, dimids(1), len=len) deallocate(dimids) ! pointer allocate(values(len)) if (len /= 0) then ierr = NF90_GET_VAR(ncid, varid, values) call handle_err("NF90_GET_VAR", ierr, ncid, varid) end if end subroutine nf95_gw_var_int_1d !************************************ subroutine nf95_gw_var_int_3d(ncid, varid, values) ! Integer type, the array has rank 3. use netcdf, only: NF90_GET_VAR use simple, only: nf95_inquire_variable, nf95_inquire_dimension use handle_err_m, only: handle_err integer, intent(in):: ncid integer, intent(in):: varid integer, pointer:: values(:, :, :) ! Variables local to the procedure: integer ierr, len1, len2, len3 integer, pointer :: dimids(:) !--------------------- call nf95_inquire_variable(ncid, varid, dimids=dimids) if (size(dimids) /= 3) then print *, "nf95_gw_var_int_3d: NetCDF variable is not of rank 3" stop 1 end if call nf95_inquire_dimension(ncid, dimids(1), len=len1) call nf95_inquire_dimension(ncid, dimids(2), len=len2) call nf95_inquire_dimension(ncid, dimids(3), len=len3) deallocate(dimids) ! pointer allocate(values(len1, len2, len3)) if (len1 * len2 * len3 /= 0) then ierr = NF90_GET_VAR(ncid, varid, values) call handle_err("NF90_GET_VAR", ierr, ncid, varid) end if end subroutine nf95_gw_var_int_3d end module nf95_gw_var_m