"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.4.5/examples/F77/sfc_pres_temp_rd.f" (31 Jan 2019, 7343 Bytes) of package /linux/misc/netcdf-fortran-4.4.5.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Fortran 77 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 C     This is part of the netCDF package.
    2 C     Copyright 2006 University Corporation for Atmospheric Research/Unidata.
    3 C     See COPYRIGHT file for conditions of use.
    4 
    5 C     This is an example which reads some surface pressure and
    6 C     temperatures. The data file read by this program is produced
    7 C     comapnion program sfc_pres_temp_wr.f. It is intended to illustrate
    8 C     the use of the netCDF fortran 77 API.
    9 
   10 C     This program is part of the netCDF tutorial:
   11 C     http://www.unidata.ucar.edu/software/netcdf/docs/netcdf-tutorial
   12 
   13 C     Full documentation of the netCDF Fortran 77 API can be found at:
   14 C     http://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f77
   15 
   16 C     $Id: sfc_pres_temp_rd.f,v 1.9 2007/02/14 20:59:20 ed Exp $
   17 
   18       program sfc_pres_temp_rd
   19       implicit none
   20       include 'netcdf.inc'
   21 
   22 C     This is the name of the data file we will read.
   23       character*(*) FILE_NAME
   24       parameter (FILE_NAME='sfc_pres_temp.nc')
   25       integer ncid
   26 
   27 C     We are reading 2D data, a 12 x 6 lon-lat grid.
   28       integer NDIMS
   29       parameter (NDIMS=2)
   30       integer NLATS, NLONS
   31       parameter (NLATS = 6, NLONS = 12)
   32       character*(*) LAT_NAME, LON_NAME
   33       parameter (LAT_NAME='latitude', LON_NAME='longitude')
   34       integer lat_dimid, lon_dimid
   35 
   36 C     For the lat lon coordinate netCDF variables.
   37       real lats(NLATS), lons(NLONS)
   38       integer lat_varid, lon_varid
   39 
   40 C     We will read surface temperature and pressure fields. 
   41       character*(*) PRES_NAME, TEMP_NAME
   42       parameter (PRES_NAME='pressure')
   43       parameter (TEMP_NAME='temperature')
   44       integer pres_varid, temp_varid
   45       integer dimids(NDIMS)
   46 
   47 C     To check the units attributes.
   48       character*(*) UNITS
   49       parameter (UNITS = 'units')
   50       character*(*) PRES_UNITS, TEMP_UNITS, LAT_UNITS, LON_UNITS
   51       parameter (PRES_UNITS = 'hPa', TEMP_UNITS = 'celsius')
   52       parameter (LAT_UNITS = 'degrees_north')
   53       parameter (LON_UNITS = 'degrees_east')
   54       integer MAX_ATT_LEN
   55       parameter (MAX_ATT_LEN = 80)
   56       character*(MAX_ATT_LEN) pres_units_in, temp_units_in
   57       character*(MAX_ATT_LEN) lat_units_in, lon_units_in
   58       integer att_len
   59 
   60 C     Read the data into these arrays.
   61       real pres_in(NLONS, NLATS), temp_in(NLONS, NLATS)
   62 
   63 C     These are used to calculate the values we expect to find.
   64       real START_LAT, START_LON
   65       parameter (START_LAT = 25.0, START_LON = -125.0)
   66       real SAMPLE_PRESSURE
   67       parameter (SAMPLE_PRESSURE = 900.0)
   68       real SAMPLE_TEMP
   69       parameter (SAMPLE_TEMP = 9.0)
   70 
   71 C     We will learn about the data file and store results in these
   72 C     program variables.
   73       integer ndims_in, nvars_in, ngatts_in, unlimdimid_in
   74 
   75 C     Loop indices
   76       integer lat, lon
   77 
   78 C     Error handling
   79       integer retval
   80 
   81 C     Open the file. 
   82       retval = nf_open(FILE_NAME, nf_nowrite, ncid)
   83       if (retval .ne. nf_noerr) call handle_err(retval)
   84 
   85 C     There are a number of inquiry functions in netCDF which can be
   86 C     used to learn about an unknown netCDF file. NF_INQ tells how many
   87 C     netCDF variables, dimensions, and global attributes are in the
   88 C     file; also the dimension id of the unlimited dimension, if there
   89 C     is one.
   90       retval = nf_inq(ncid, ndims_in, nvars_in, ngatts_in, 
   91      +     unlimdimid_in)
   92       if (retval .ne. nf_noerr) call handle_err(retval)
   93 
   94 C     In this case we know that there are 2 netCDF dimensions, 4 netCDF
   95 C     variables, no global attributes, and no unlimited dimension.
   96       if (ndims_in .ne. 2 .or. nvars_in .ne. 4 .or. ngatts_in .ne. 0 
   97      +     .or. unlimdimid_in .ne. -1) stop 2
   98 
   99 C     Get the varids of the latitude and longitude coordinate variables.
  100       retval = nf_inq_varid(ncid, LAT_NAME, lat_varid)
  101       if (retval .ne. nf_noerr) call handle_err(retval)
  102       retval = nf_inq_varid(ncid, LON_NAME, lon_varid)
  103       if (retval .ne. nf_noerr) call handle_err(retval)
  104 
  105 C     Read the latitude and longitude data.
  106       retval = nf_get_var_real(ncid, lat_varid, lats)
  107       if (retval .ne. nf_noerr) call handle_err(retval)
  108       retval = nf_get_var_real(ncid, lon_varid, lons)
  109       if (retval .ne. nf_noerr) call handle_err(retval)
  110 
  111 C     Check to make sure we got what we expected.
  112       do lat = 1, NLATS
  113          if (lats(lat) .ne. START_LAT + (lat - 1) * 5.0) stop 2
  114       end do
  115       do lon = 1, NLONS
  116          if (lons(lon) .ne. START_LON + (lon - 1) * 5.0) stop 2
  117       end do
  118 
  119 C     Get the varids of the pressure and temperature netCDF variables.
  120       retval = nf_inq_varid(ncid, PRES_NAME, pres_varid)
  121       if (retval .ne. nf_noerr) call handle_err(retval)
  122       retval = nf_inq_varid(ncid, TEMP_NAME, temp_varid)
  123       if (retval .ne. nf_noerr) call handle_err(retval)
  124 
  125 C     Read the surface pressure and temperature data from the file.
  126 C     Since we know the contents of the file we know that the data
  127 C     arrays in this program are the correct size to hold all the data.
  128       retval = nf_get_var_real(ncid, pres_varid, pres_in)
  129       if (retval .ne. nf_noerr) call handle_err(retval)
  130       retval = nf_get_var_real(ncid, temp_varid, temp_in)
  131       if (retval .ne. nf_noerr) call handle_err(retval)
  132 
  133 C     Check the data. It should be the same as the data we wrote.
  134       do lon = 1, NLONS
  135          do lat = 1, NLATS
  136              if (pres_in(lon, lat) .ne. SAMPLE_PRESSURE +
  137      +           (lon - 1) * NLATS + (lat - 1)) stop 2
  138              if (temp_in(lon, lat) .ne. SAMPLE_TEMP +
  139      +           .25 * ((lon - 1) * NLATS + (lat - 1))) stop 2
  140          end do
  141       end do
  142 
  143 C     Each of the netCDF variables has a "units" attribute. Let's read
  144 C     them and check them.
  145 
  146       retval = nf_get_att_text(ncid, lat_varid, UNITS, lat_units_in)
  147       if (retval .ne. nf_noerr) call handle_err(retval)
  148       retval = nf_inq_attlen(ncid, lat_varid, UNITS, att_len)
  149       if (retval .ne. nf_noerr) call handle_err(retval)
  150       if (lat_units_in(1:att_len) .ne. LAT_UNITS) stop 2
  151  
  152       retval = nf_get_att_text(ncid, lon_varid, UNITS, lon_units_in)
  153       if (retval .ne. nf_noerr) call handle_err(retval)
  154       retval = nf_inq_attlen(ncid, lon_varid, UNITS, att_len)
  155       if (retval .ne. nf_noerr) call handle_err(retval)
  156       if (lon_units_in(1:att_len) .ne. LON_UNITS) stop 2
  157 
  158       retval = nf_get_att_text(ncid, pres_varid, UNITS, pres_units_in)
  159       if (retval .ne. nf_noerr) call handle_err(retval)
  160       retval = nf_inq_attlen(ncid, pres_varid, UNITS, att_len)
  161       if (retval .ne. nf_noerr) call handle_err(retval)
  162       if (pres_units_in(1:att_len) .ne. PRES_UNITS) stop 2
  163 
  164       retval = nf_get_att_text(ncid, temp_varid, UNITS, temp_units_in)
  165       if (retval .ne. nf_noerr) call handle_err(retval)
  166       retval = nf_inq_attlen(ncid, temp_varid, UNITS, att_len)
  167       if (retval .ne. nf_noerr) call handle_err(retval)
  168       if (temp_units_in(1:att_len) .ne. TEMP_UNITS) stop 2
  169 
  170 C     Close the file. This frees up any internal netCDF resources
  171 C     associated with the file.
  172       retval = nf_close(ncid)
  173       if (retval .ne. nf_noerr) call handle_err(retval)
  174 
  175 C     If we got this far, everything worked as expected. Yipee!
  176       print *,'*** SUCCESS reading example file sfc_pres_temp.nc!'
  177       end
  178 
  179       subroutine handle_err(errcode)
  180       implicit none
  181       include 'netcdf.inc'
  182       integer errcode
  183 
  184       print *, 'Error: ', nf_strerror(errcode)
  185       stop 2
  186       end