dataRetrieval.f

      ********************************************************************************
      * This file collects routines for dataRetrival from ASCII files or directly
      * from NetCDF files
      * TODO: to be extended    
   5: ********************************************************************************
      
      
            SUBROUTINE retrieveCoordinateData(p_file, p_x, p_y, p_var
           c  , o_retVal)
  10: ************************************************************************
      * NOTE: this method is currently not used in the program
      * Retrieves coordinates data from ASCII file (such as e.g. ncdumped NetCDF
      * files). If possible it is recommended to read directly from NetCDF with
      * the functions provided below since it is a lot faster.
  15: *
      * Input:
      *  - p_file (String): name of the file
      *  - p_x (Integer): grid size
      *  - p_y (Integer): grid size
  20: *  - p_var (String): name of the variable to be red (usally lon or lat)
      * Output:
      *  - o_retVal (Real[p_x, p_y]): the read coordinates array (lon or lat depending on input file
      *
      ************************************************************************
  25:       IMPLICIT none
            
      *     Functions from the function library
            INTEGER strlen
            
  30: *     Parameters
            CHARACTER p_file*(*), sFile*255, output*255
            CHARACTER p_var*(*), var*50, line*50
            INTEGER p_x, p_y
            REAL o_retVal(p_x, p_y)
  35:       
            INTEGER i, x,y !vars
            sFile = p_file
            var=p_var
            
  40:       print *,  "Reading coordinate data file '", 
           c sFile(1:strlen(sFile)), "' for grid x=",p_x,", y=",p_y,"..."
            
            OPEN (11,file=sFile(1:strlen(sFile)))
        1   read(11,*) line
  45:       if ( var .ne. line ) goto 1
            
            do y=1,p_y
              do x=1,p_x
                READ(11,*) o_retVal(x,y)
  50:         enddo
            enddo
            CLOSE(11)
            
            END
  55: 
      
            SUBROUTINE retrieveMonthlyData(p_file, p_x, p_y,
           c  p_a, p_var, o_retVal)
      ************************************************************************
  60: * NOTE: this method is currently not used in the program
      * Retrieves monthly data from ASCII file (such as e.g. ncdumped NetCDF files). 
      * If possible it is recommended to read directly from NetCDF with
      * the functions provided below since it is a lot faster.
      *
  65: * Input:
      *  - p_file (String): name of the file
      *  - p_x (Integer): grid size of data array
      *  - p_y (Integer): grid size of data array
      *  - p_a (Integer): number of years of data
  70: *  - p_var (String): name of the variable to be red (e.g. 't2m' or 'precip')
      * Output:
      *  - o_retVal (Real[p_x, p_y, p_a, 12]): the read data array
      *
      ************************************************************************
  75:       IMPLICIT none
      
      *     Functions from the function library
            INTEGER strlen
            
  80: *     Parameters
            CHARACTER p_file*(*), sFile*255
            CHARACTER p_var*(*), var*50, line*50
            INTEGER p_x, p_y, p_a
            REAL o_retVal(p_x, p_y, p_a, 12)
  85: 
            INTEGER i,x,y,m,t !vars
            REAL val !vals
      
            sFile = p_file
  90:       var=p_var
      
            print *,  "Reading time span data file '", 
           c sFile(1:strlen(sFile)), "' for grid x=",p_x,", y=",p_y,
           c " entirely for ", p_a," years..."
  95: 
            OPEN (11,file=sFile(1:strlen(sFile)))
        1   read(11,*) line
            if ( var .ne. line ) goto 1
            
 100:       do t=1,p_a
              do m=1,12
                do y=1,p_y
                  do x=1,p_x
                     READ(11,*) val
 105:                o_retVal(x,y,t,m) = val
                  enddo
                enddo
              enddo
            enddo
 110:       
            CLOSE (11)
            
            END
      
 115: 
      
            SUBROUTINE getNetCdfCoordinates (
           c   p_fileName, p_fileType,
           c   p_x, p_y, 
 120:      c   p_lonDim, p_latDim, p_lonVar, p_latVar,
           c   o_lons, o_lats ) 
      ************************************************************************
      * Retrieve coordinate arrays from a NetCDF file.
      *
 125: * NetCDF INFO: http://www.unidata.ucar.edu/software/netcdf/guidef/ 
      *
      * Input:
      *  - p_fileName (String): the path to the netCDF file
      *  - p_fileType (String): specifies the kind of netCDF file, currently supported:
 130: *         SDF: self-defining/standard NetCDF file (i.e. 1D coordinate arrays), defined by COARDS conventions: http://ferret.wrc.noaa.gov/noaa_coop/coop_cdf_profile.html
      *	  Normal: everything else (assumed to have 2D coordinate arrays)
      *  - p_x (Integer): grid size (in sdf case, longitude size) 
      *  - p_y (Integer): grid size (in sdf case, latitue size) 
      *  - p_lonDim (String): name of the longitudinal dimension
 135: *  - p_latDim (String): name of the latitudinal dimension
      *  - p_lonVar (String): name of the longitude variable
      *  - p_latVar (String): name of the latitude variable
      * Output:
      *  - o_lons (Real[p_x, p_y]): read longitudes
 140: *  - o_lats (Real[p_x, p_y]): read latitudes
      ************************************************************************
            IMPLICIT none
            INCLUDE 'netcdf.inc'
         
 145:       CHARACTER p_fileType*(*), fileType*10
            CHARACTER*(*) p_fileName, p_lonDim, p_latDim, p_lonVar, p_latVar !input, variable name
            CHARACTER*20 fileN*100, lonDimN, latDimN, lonVarN, latVarN 
            INTEGER p_x, p_y ! desired grid size: lon, lat
             
 150:       REAL o_lons(p_x, p_y), o_lats(p_x, p_y) ! output longitudes and lattitudes
             
            INTEGER ncId ! net cdf fileid
            INTEGER lonId, latId ! net cdf variable ids
            INTEGER lonDim, latDim, timeDim
 155:       
            INTEGER strlen ! function
            INTEGER dimId, errId ! process variable
            
            fileType = p_fileType
 160:       fileN = p_fileName
            lonDimN = p_lonDim
            latDimN = p_latDim
            lonVarN = p_lonVar
            latVarN = p_latVar
 165:        
            print *,"Reading coordinates from ",fileType(1:strlen(fileType)),
           c " netCDF data file '", fileN(1:strlen(fileN)), 
           c "' into grid x=",p_x,", y=",p_y," ..."
             
 170:        CALL handleErr(
           c  nf_open(fileN(1:strlen(fileN)), 
           c  NF_CLOBBER,ncId))
      
            ! dimension sizes (lon, lat)
 175:       CALL handleErr(NF_INQ_DIMID(ncId,
           c      lonDimN(1:strlen(lonDimN)),dimId))
            CALL handleErr (NF_INQ_DIMLEN(ncId, dimId, lonDim))
            CALL handleErr(NF_INQ_DIMID(ncId,
           c      latDimN(1:strlen(latDimN)),dimId))
 180:       CALL handleErr (NF_INQ_DIMLEN(ncId, dimId, latDim))
      
            ! variable ids
            CALL handleErr(NF_INQ_VARID(ncId,
           c      lonVarN(1:strlen(lonVarN)),lonId))
 185:       CALL handleErr(NF_INQ_VARID(ncId,
           c      latVarN(1:strlen(latVarN)),latId))
            
      
            if (fileType .eq. "SDF") then
 190:         CALL readSdfNetCdfCoordinates (p_x, p_y, 
           c      lonDim, latDim, 
           c      ncId, lonId, latId, 
           c      o_lons, o_lats)
            else
 195:         CALL readNormalNetCdfCoordinates (p_x, p_y, 
           c      lonDim, latDim, 
           c      ncId, lonId, latId, 
           c      o_lons, o_lats)
            endif      
 200:       END
      
      
            SUBROUTINE getNetCdfVarVals (
           c   p_fileName, p_fileType,
 205:      c   p_x, p_y, p_a,
           c   p_lonDim, p_latDim, p_timeDim, p_varName,
           c   o_vals )
      ************************************************************************
      * Retrieve data values of a time-dependent variable from a NetCDF file.
 210: *
      * NetCDF INFO: http://www.unidata.ucar.edu/software/netcdf/guidef/ 
      *
      * Input:
      *  - p_fileName (String): the path to the netCDF file
 215: *  - p_fileType (String): specifies the kind of netCDF file, currently supported:
      *         SDF: self-defining/standards NetCDF file (i.e. 1D coordinate arrays), defined by COARDS conventions: http://ferret.wrc.noaa.gov/noaa_coop/coop_cdf_profile.html
      *	  Normal: everything else (assumed to be a simple 3D data array)
      *  - p_x (Integer): grid size (in sdf case, longitude size) 
      *  - p_y (Integer): grid size (in sdf case, latitude size) 
 220: *  - p_a (Integer): number of years of data
      *  - p_lonDim (String): name of the longitudinal dimension
      *  - p_latDim (String): name of the latitudinal dimension
      *  - p_timeDim (String): name of the temporal dimension
      *  - p_varName (String): name of the variable to retrieve
 225: * Output:
      *  - o_vals (Real[p_x, p_y, p_a]): read data
      ************************************************************************
            IMPLICIT none
            INCLUDE 'netcdf.inc'
 230:    
            CHARACTER p_fileType*(*), fileType*10
            CHARACTER*(*) p_fileName, p_lonDim, p_latDim, p_timeDim, p_varName !input, variable name
            CHARACTER*20 fileN*100, lonDimN, latDimN, timeDimN, varName
            INTEGER p_x, p_y, p_a ! desired grid size: lon, lat, time
 235:        
            REAL o_vals(p_x,p_y,p_a,12) ! output vals
             
            INTEGER ncId ! net cdf fileid
            INTEGER varId ! net cdf variable ids
 240:       INTEGER lonDim, latDim, timeDim
            REAL fillVal ! fill value to find if the netcdf file is cut too large
            
            INTEGER strlen ! function
            INTEGER dimId, errId ! process variable
 245: 
             fileType = p_fileType
             fileN = p_fileName
             lonDimN = p_lonDim
             latDimN = p_latDim
 250:        timeDimN = p_timeDim
             varName = p_varName
             
             print *,  "Reading variable ",
           c  varName(1:strlen(varName)),
 255:      c " from ", fileType(1:strlen(fileType)) ," netCDF data file '", 
           c fileN(1:strlen(fileN)), "' into grid x=",p_x,", y=",p_y,
           c " for ", p_a, " years..."
             
             CALL handleErr(
 260:      c  nf_open(fileN(1:strlen(fileN)), 
           c  NF_CLOBBER,ncId))
      
             ! dimension sizes (only lon, lat, time...level assumed to be 1) //FIXME
             CALL handleErr(NF_INQ_DIMID(ncId,
 265:      c      lonDimN(1:strlen(lonDimN)),dimId))
            CALL handleErr (NF_INQ_DIMLEN(ncId, dimId, lonDim))
            CALL handleErr(NF_INQ_DIMID(ncId,
           c      latDimN(1:strlen(latDimN)),dimId))
            CALL handleErr (NF_INQ_DIMLEN(ncId, dimId, latDim))
 270:       CALL handleErr (NF_INQ_DIMID(ncId, 
           c      timeDimN(1:strlen(timeDimN)), dimId))
            CALL handleErr (NF_INQ_DIMLEN(ncId, dimId, timeDim))
              
             ! variable ids
 275:        CALL handleErr (NF_INQ_VARID (ncId, 
           c  varName(1:strlen(varName)), varId))
              
             ! attributes (here only fillvalue)
             errId = NF_GET_ATT_REAL (ncId, varId, "_FillValue", fillVal)
 280:        if ( errId == NF_NOERR ) then
                  ! fill value could be read which means there ARE missing values -> error
                  print *, "ERROR: file ", fileN(1:strlen(fileN)),
           c            " has missing values, please crop the dataset further"
                  STOP
 285:        endif
             
            if (fileType .eq. "SDF") then
              CALL readSdfNetCdfVals (p_x, p_y, p_a,
           c      lonDim, latDim, timeDim, 
 290:      c      ncId, varId, o_vals)
            else 
              CALL readNormalNetCdfVals (p_x, p_y, p_a,
           c      lonDim, latDim, timeDim, 
           c      ncId, varId, o_vals)
 295:       endif      
      
            END
      
      
 300:       SUBROUTINE readSdfNetCdfCoordinates (p_x, p_y, 
           c      p_lonDim, p_latDim, 
           c      p_ncId, p_lonId, p_latId, 
           c      o_lons, o_lats)
      ************************************************************************
 305: * Read coordinates from a self-describing netCdf file (1D coordinate arrays)
      * NetCDF INFO: http://www.unidata.ucar.edu/software/netcdf/guidef/ 
      * PRIVATE subroutine
      ************************************************************************     
            IMPLICIT none
 310:       INCLUDE 'netcdf.inc'
            
            INTEGER p_x,p_y,p_a ! output dimensions
            INTEGER p_lonDim, p_latDim ! netscd dimensions
            INTEGER p_ncId, p_lonId, p_latId ! netcdf ids
 315:       REAL o_lons(p_x, p_y), o_lats(p_x, p_y) !output vars
            
            REAL lons(p_lonDim), lats(p_latDim) !netcdf coordinate data
            
            INTEGER x,y !looping vars
 320:       
            ! get data
            CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_lonId, lons))
            CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_latId, lats))
            
 325:       do y=1,p_y
              do x=1,p_x
                o_lats(x,y) = lats(y)
                o_lons(x,y) = lons(x) 
              enddo
 330:       enddo
            
            END
      
      
 335:       SUBROUTINE readNormalNetCdfCoordinates (p_x, p_y, 
           c      p_lonDim, p_latDim, 
           c      p_ncId, p_lonId, p_latId, 
           c      o_lons, o_lats)
      ************************************************************************
 340: * Read coordinates from a normal netCdf file
      * NetCDF INFO: http://www.unidata.ucar.edu/software/netcdf/guidef/ 
      * PRIVATE subroutine
      ************************************************************************     
            IMPLICIT none
 345:       INCLUDE 'netcdf.inc'
            
            INTEGER p_x,p_y,p_a ! output dimensions
            INTEGER p_lonDim, p_latDim ! netscd dimensions
            INTEGER p_ncId, p_lonId, p_latId ! netcdf ids
 350:       REAL o_lons(p_x, p_y), o_lats(p_x, p_y) !output vars
            
            REAL lons(p_lonDim, p_latDim), lats(p_lonDim, p_latDim) !netcdf coordinate data
            
            INTEGER x,y !looping vars
 355:       
            if (p_x==p_lonDim .and. p_y==p_latDim ) then ! identical size, read directly
               CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_lonId, o_lons))
               CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_latId, o_lats))
            else ! read first into temp arrays, then move over, assumes p_x<lonDim, p_y<latDim
 360:          CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_lonId, lons))
               CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_latId, lats))
            
              do y=1,p_y
                do x=1,p_x
 365:             o_lats(x,y) = lats(x,y)
                  o_lons(x,y) = lons(x,y) 
                enddo
              enddo
            endif
 370:       
            END
      
      
            SUBROUTINE readSdfNetCdfVals (p_x, p_y, p_a,
 375:      c      p_lonDim, p_latDim, p_timeDim, 
           c      p_ncId, p_varId, 
           c      o_vals)
      ************************************************************************
      * Read time dependent variable from a self-describing netCdf file
 380: * NetCDF INFO: http://www.unidata.ucar.edu/software/netcdf/guidef/ 
      * PRIVATE subroutine
      ************************************************************************     
            IMPLICIT none
            INCLUDE 'netcdf.inc'
 385:       
            INTEGER p_x,p_y,p_a ! output dimensions
            INTEGER p_lonDim, p_latDim, p_timeDim ! netscd dimensions
            INTEGER p_ncId, p_varId ! netcdf ids
            REAL o_lons(p_x, p_y), o_lats(p_x, p_y)
 390:       REAL o_vals(p_x, p_y, p_a, 12) !output vars
            REAL vals(p_lonDim, p_latDim, 1, p_timeDim) !netcdf variable data
            
            INTEGER x,y,a,m !looping vars
            
 395:       ! get data
            CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_varId, vals))
            
            do m=1,12
              do a=1,p_a
 400:           do y=1,p_y
                  do x=1,p_x
                    o_vals(x,y,a,m) = vals(x,y,1,(a-1)*12+m)
                  enddo
                enddo
 405:         enddo
            enddo
            
            END 
      
 410: 
            SUBROUTINE readNormalNetCdfVals (p_x, p_y, p_a,
           c      p_lonDim, p_latDim, p_timeDim, 
           c      p_ncId, p_varId, o_vals)
      ************************************************************************
 415: * Read time dependent variable from a normal netCdf file
      * NetCDF INFO: http://www.unidata.ucar.edu/software/netcdf/guidef/ 
      * PRIVATE subroutine
      ************************************************************************     
            IMPLICIT none
 420:       INCLUDE 'netcdf.inc'
            
            INTEGER p_x,p_y,p_a ! output dimensions
            INTEGER p_lonDim, p_latDim, p_timeDim ! netscd dimensions
            INTEGER p_ncId, p_varId ! netcdf ids
 425:       REAL o_vals(p_x, p_y, p_a, 12) !output vars
            REAL vals(p_lonDim, p_latDim, p_timeDim) !netcdf variable data
            
            INTEGER x,y,a,m !looping vars
            INTEGER yearShift
 430:       
            ! get data
            CALL handleErr (NF_GET_VAR_REAL (p_ncId, p_varId, vals))
            
            yearShift = p_timeDim/12-p_a ! FIXME, this is not the best way to make the shift by one year for the HC files
 435:       if (yearShift > 1) yearShift = 1
            print *, "shift: ", yearShift ! FIXME
            do m=1,12
              do a=1,p_a
                do y=1,p_y
 440:             do x=1,p_x
                    o_vals(x,y,a,m) = vals(x,y,(yearShift+a-1)*12+m)
                  enddo
                enddo
              enddo
 445:       enddo
            
            END
            
      
 450:       SUBROUTINE netCdfInfo (p_fileName)
      ************************************************************************
      * NOTE: this function is not used anywhere in the final version of the program.
      * Helper function to display info about a netcdf file at once on standard output. 
      * Finishes with a program stop (!)
 455: * NetCDF INFO: http://www.unidata.ucar.edu/software/netcdf/guidef/ 
      *
      * Input:
      *  - p_fileName(String): name of the NetCDF file to be analysed  
      ************************************************************************
 460:       IMPLICIT none
            INCLUDE 'netcdf.inc'
            CHARACTER p_fileName*(*), fileN*100 ! input, variable name
            INTEGER NCID
            INTEGER NDIMS, NVARS, NGATTS, UNLIMDIMID, DIML
 465:       CHARACTER*(NF_MAX_NAME) DIMNAME
            INTEGER  RHID               ! variable ID
            CHARACTER*31 RHNAME, ANAME, ATVAL        ! variable name
            INTEGER  RHTYPE  , ATYPE           ! variable type
            INTEGER  RHN , ALENGTH    ! number of dimensions
 470:       INTEGER  RHDIMS(NF_MAX_VAR_DIMS)   ! variable shape
            INTEGER  RHNATT                  ! number of attributes
            INTEGER i,j, strlen
                  
             fileN = p_fileName      
 475:       
             CALL handleErr(
           c  nf_open(fileN(1:strlen(fileN)), 
           c  NF_CLOBBER,NCID))
               
 480:          CALL handleErr (
           c  NF_INQ(NCID, NDIMS, NVARS, NGATTS, UNLIMDIMID) )
               
               print *, NDIMS, NVARS, NGATTS, UNLIMDIMID
               
 485:          do i=1, NDIMS
                     CALL handleErr (
           c       NF_INQ_DIM     (NCID, i, DIMNAME, DIML))
                     print *, "dim ", i, ": ", DIMNAME(1:strlen(DIMNAME)),
           c        "(",DIML,")"
 490:          enddo
               
               do i=1, NVARS
                  CALL handleErr (
           c    NF_INQ_VAR (NCID, i, RHNAME, RHTYPE, RHN, RHDIMS, RHNATT) )
 495:             print *, "var ", i, ": ", RHNAME(1:strlen(RHNAME)),
           c    ", type: ", RHTYPE, " dims: ", RHN, 
           c    " shape: ", RHDIMS(1), RHDIMS(2), RHDIMS(3),
           c    ", attribs: ", RHNATT
                     do j=1, RHNATT
 500:                   CALL handleErr (
           c          NF_INQ_ATTNAME(NCID, i, j, ANAME))
                        CALL handleErr (
           c         NF_INQ_ATT (NCID, i, ANAME, ATYPE, ALENGTH) )
                        print *, "   attrib ", j, ": ", ANAME, 
 505:      c           " type: ", ATYPE, " length: ", ALENGTH
                       if (ATYPE == NF_CHAR) then
                    CALL handleErr(NF_GET_ATT_TEXT (NCID, i, ANAME, ATVAL))
                           print *, "       value: ", ATVAL(1:ALENGTH)
                       endif
 510:                enddo
               enddo
            
              print *, "global attributes:"
                  
 515:              j=0
         5         j=j+1
                        CALL handleErr (
           c          NF_INQ_ATTNAME(NCID, NF_GLOBAL, j, ANAME))
                        CALL handleErr (
 520:      c         NF_INQ_ATT (NCID, NF_GLOBAL, ANAME, ATYPE, ALENGTH) )
                        print *, "   attrib ", j, ": ", ANAME, 
           c           " type: ", ATYPE, " length: ", ALENGTH
                       if (ATYPE == NF_CHAR) then
                    CALL handleErr(NF_GET_ATT_TEXT (NCID, 
 525:      c                  NF_GLOBAL, ANAME, ATVAL))
                           print *, "       value: ", ATVAL(1:ALENGTH)
                       endif
                   goto 5
            
 530:       
            END


Info Section
Warning: externals (function calls) may not be acurate includes: netcdf.inc calls: handleerr, readnormalnetcdfcoordinates, readnormalnetcdfvals, readsdfnetcdfcoordinates, readsdfnetcdfvals
back to top
f2html v0.3 (C) 1997,98 Beroud Jean-Marc. Fri Aug 11 17:54:58 CEST 2006