program read_srb_rel3_shortwave_3hrlymonthly_nc use netcdf implicit none character (200) :: path_in, file_in, file_out integer :: rec, index integer :: month, year character(4) :: cyear character(2) :: cmon ! netCDF id integer :: ncid ! dimension ids integer :: lat_dim, lon_dim, time_dim integer, parameter :: NDIMS = 3, NRECS = 8 integer, parameter :: NLVLS = 1, NLATS = 180, NLONS = 360 character (len = *), parameter :: LAT_NAME = "lat" character (len = *), parameter :: LON_NAME = "lon" character (len = *), parameter :: time_name = "time" ! The start and count arrays will tell the netCDF library where to ! read our data. integer :: start(NDIMS), count(NDIMS) ! In addition to the latitude and longitude dimensions, we will also ! create latitude and longitude variables which will hold the actual ! latitudes and longitudes. Since they hold data about the ! coordinate system, the netCDF term for these is: "coordinate ! variables." real :: lats(NLATS), lons(NLONS) character (len = *), parameter :: toadn_name="sw_toa_dn" character (len = *), parameter :: toaup_name="sw_toa_up" character (len = *), parameter :: sfcdn_name="sw_sfc_dn" character (len = *), parameter :: sfcup_name="sw_sfc_up" character (len = *), parameter :: ctoaup_name="clr_sw_toa_up" character (len = *), parameter :: csfcdn_name="clr_sw_sfc_dn" character (len = *), parameter :: csfcup_name="clr_sw_sfc_up" character (len = *), parameter :: par_name="par" character (len = *), parameter :: cldfra_name="cld_frac" character (len = *), parameter :: sza_name="sza" character (len = *), parameter :: avesza_name="ave_sza" ! variable ids integer :: lat_id, lon_id, time_id, clr_sw_toa_up_id, clr_sw_sfc_up_id, & clr_sw_sfc_dn_id, sw_toa_up_id, sw_sfc_up_id, sw_sfc_dn_id, & sw_toa_dn_id, par_id, sza_id, ave_sza_id, cld_frac_id double precision :: time real, dimension(nlons,nlats) :: clr_sw_toa_up, clr_sw_sfc_up, & clr_sw_sfc_dn, sw_toa_up, sw_sfc_up, sw_sfc_dn, sw_toa_dn, & par, sza, ave_sza, cld_frac integer :: dimids(NDIMS) ! To check the units attributes. character (80) :: clr_sw_toa_up_units_in, clr_sw_sfc_up_units_in, & clr_sw_sfc_dn_units_in, sw_toa_up_units_in, sw_sfc_up_units_in, & sw_sfc_dn_units_in, sw_toa_dn_units_in, & par_units_in, sza_units_in, ave_sza_units_in, cld_frac_units_in character (80) :: lat_units_in, lon_units_in month=2 year=1984 write (cyear,"(i4)") year write (cmon,"(i2.2)") month path_in='' path_in='/SCF2/RADAPP/srb/NetCDF/GSW/1984/' file_in=trim(path_in)//'srb_rel3.0_shortwave_3hrlymonthly_utc_'//cyear//cmon//'.nc' print*,trim(file_in) ! Open the file. call check( nf90_open(file_in, nf90_nowrite, ncid)) ! Get the varids of the latitude and longitude coordinate variables. call check( nf90_inq_varid(ncid, LAT_NAME, lat_id) ) call check( nf90_inq_varid(ncid, LON_NAME, lon_id) ) ! Read the latitude and longitude data. call check( nf90_get_var(ncid, lat_id, lats) ) call check( nf90_get_var(ncid, lon_id, lons) ) call check( nf90_inq_varid(ncid, time_name, time_id) ) call check( nf90_get_var(ncid, time_id, time) ) ! Get the varids of the variables call check( nf90_inq_varid(ncid, toadn_name, sw_toa_dn_id) ) call check( nf90_inq_varid(ncid, toaup_name, sw_toa_up_id) ) call check( nf90_inq_varid(ncid, sfcdn_name, sw_sfc_dn_id) ) call check( nf90_inq_varid(ncid, sfcup_name, sw_sfc_up_id) ) call check( nf90_inq_varid(ncid, ctoaup_name, clr_sw_toa_up_id) ) call check( nf90_inq_varid(ncid, csfcdn_name, clr_sw_sfc_dn_id) ) call check( nf90_inq_varid(ncid, csfcup_name, clr_sw_sfc_up_id) ) call check( nf90_inq_varid(ncid, par_name, par_id) ) call check( nf90_inq_varid(ncid, sza_name, sza_id) ) call check( nf90_inq_varid(ncid, avesza_name, ave_sza_id) ) call check( nf90_inq_varid(ncid, cldfra_name, cld_frac_id) ) ! Read the units call check( nf90_get_att(ncid, sw_toa_dn_id, 'units', sw_toa_dn_units_in) ) call check( nf90_get_att(ncid, sw_toa_up_id, 'units', sw_toa_up_units_in) ) call check( nf90_get_att(ncid, sw_sfc_dn_id, 'units', sw_sfc_dn_units_in) ) call check( nf90_get_att(ncid, sw_sfc_up_id, 'units', sw_sfc_up_units_in) ) call check( nf90_get_att(ncid, clr_sw_toa_up_id, 'units', clr_sw_toa_up_units_in) ) call check( nf90_get_att(ncid, clr_sw_sfc_dn_id, 'units', clr_sw_sfc_dn_units_in) ) call check( nf90_get_att(ncid, clr_sw_sfc_up_id, 'units', clr_sw_sfc_up_units_in) ) call check( nf90_get_att(ncid, par_id, 'units', par_units_in) ) call check( nf90_get_att(ncid, sza_id, 'units', sza_units_in) ) call check( nf90_get_att(ncid, ave_sza_id, 'units', ave_sza_units_in) ) call check( nf90_get_att(ncid, cld_frac_id, 'units', cld_frac_units_in) ) count = (/ NLONS, NLATS, 1 /) start = (/ 1, 1, 1 /) file_out='sw_check.binary' ! Read the variables do rec = 1, NRECS start(3)=rec call check( nf90_get_var(ncid, sw_toa_dn_id, sw_toa_dn,start=start,& count=count) ) call check( nf90_get_var(ncid, sw_toa_up_id, sw_toa_up,start=start,& count=count) ) call check( nf90_get_var(ncid, sw_sfc_dn_id, sw_sfc_dn,start=start,& count=count) ) call check( nf90_get_var(ncid, sw_sfc_up_id, sw_sfc_up,start=start,& count=count) ) call check( nf90_get_var(ncid, clr_sw_toa_up_id, clr_sw_toa_up,start=start,& count=count) ) call check( nf90_get_var(ncid, clr_sw_sfc_dn_id, clr_sw_sfc_dn,start=start,& count=count) ) call check( nf90_get_var(ncid, clr_sw_sfc_up_id, clr_sw_sfc_up,start=start,& count=count) ) call check( nf90_get_var(ncid, par_id, par,start=start,& count=count) ) call check( nf90_get_var(ncid, sza_id, sza,start=start,& count=count) ) call check( nf90_get_var(ncid, ave_sza_id, ave_sza,start=start,& count=count) ) call check( nf90_get_var(ncid, cld_frac_id, cld_frac,start=start,& count=count) ) end do call check( nf90_close(ncid) ) contains !***************************************** subroutine check(status) integer, intent ( in) :: status if(status /= nf90_noerr) then print *, trim(nf90_strerror(status)) stop "Stopped" end if end subroutine check !***************************************** end program read_srb_rel3_shortwave_3hrlymonthly_nc