Commit 34c6e4da authored by kb's avatar kb
Browse files

added source-files for reading 2D-fields from external files

parent 6c3e4078
#$Id: Makefile,v 1.4 2006-02-07 07:16:22 kbk Exp $
#$Id: Makefile,v 1.5 2009-05-07 16:02:00 kb Exp $
#
# Makefile to build the ncdf module - ncdfio.o
#
......@@ -32,6 +32,7 @@ endif
OBJ += \
${LIB}(init_meteo_input.o) \
${LIB}(get_meteo_data.o) \
${LIB}(get_2d_field.o) \
${LIB}(get_field.o) \
${LIB}(read_profile.o) \
${LIB}(check_grid.o) \
......
!$Id: get_2d_field.F90,v 1.1 2009-05-07 16:02:01 kb Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_2d_field - read a 2D field from a file.
!
! !INTERFACE:
subroutine get_2d_field(fn,varname,il,ih,jl,jh,field)
!
! !DESCRIPTION:
! Reads varname from a named file - fn - into to field.
!
! !USES:
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn,varname
integer, intent(in) :: il,ih,jl,jh
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
REALTYPE, intent(out) :: field(:,:)
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding
!
! !LOCAL VARIABLES:
integer, parameter :: fmt=NETCDF
!EOP
!-------------------------------------------------------------------------
!BOC
#ifdef DEBUG
integer, save :: Ncall = 0
ncall = ncall+1
write(debug,*) 'get_field() # ',ncall
#endif
select case (fmt)
case (ANALYTICAL)
case (ASCII)
STDERR 'Should get an ASCII field'
stop 'get_2d_field()'
case (NETCDF)
call get_2d_field_ncdf(fn,varname,il,ih,jl,jh,field)
case DEFAULT
FATAL 'A non valid input format has been chosen'
stop 'get_2d_field'
end select
#ifdef DEBUG
write(debug,*) 'Leaving get_2d_field()'
write(debug,*)
#endif
return
end subroutine get_2d_field
!EOC
!-----------------------------------------------------------------------
! Copyright (C) 2009 - Hans Burchard and Karsten Bolding !
!-----------------------------------------------------------------------
#$Id: Makefile,v 1.8 2009-04-27 09:22:55 kb Exp $
#$Id: Makefile,v 1.9 2009-05-07 16:02:01 kb Exp $
#
# Makefile to build the ncdf module - ncdfio.o and the libncdfio.a library
#
......@@ -15,6 +15,7 @@ LIBSRC = set_attributes.F90 init_grid_ncdf.F90 save_grid_ncdf.F90 \
init_2d_ncdf.F90 save_2d_ncdf.F90 \
init_3d_ncdf.F90 save_3d_ncdf.F90 \
get_field_ncdf.F90 read_field_ncdf.F90 ncdf_close.F90 \
get_2d_field_ncdf.F90 \
create_restart_ncdf.F90 write_restart_ncdf.F90 \
open_restart_ncdf.F90 read_restart_ncdf.F90 \
init_mean_ncdf.F90 save_mean_ncdf.F90
......@@ -54,6 +55,7 @@ ${LIB}(get_field_ncdf.o) \
${LIB}(read_field_ncdf.o)
endif
OBJ += \
${LIB}(get_2d_field_ncdf.o) \
${LIB}(create_restart_ncdf.o) \
${LIB}(write_restart_ncdf.o) \
${LIB}(open_restart_ncdf.o) \
......
!$Id: get_2d_field_ncdf.F90,v 1.1 2009-05-07 16:02:01 kb Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_2d_field_ncdf()
!
! !INTERFACE:
subroutine get_2d_field_ncdf(fn,varname,il,ih,jl,jh,field)
!
! !USES:
use netcdf
use exceptions
IMPLICIT NONE
!
! !DESCRIPTION:
! A two-dimensional netCDF variable with specified global range
! {\tt il < i < ih} and {\tt jl < j < jh} is read into {\tt field}.
! It is checked if the sizes of the fields correspond exactly.
! When calling this funtions, remember that FORTRAN netCDF variables
! start with index 1.
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn,varname
integer, intent(in) :: il,ih,jl,jh
!
! !OUTPUT PARAMETERS:
REALTYPE, intent(out) :: field(:,:)
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding, Lars Umlauf
!
! !LOCAL VARIABLES:
integer, dimension(2) :: start
integer, dimension(2) :: edges
integer, dimension(2) :: ubounds
integer :: status,ncid,varid
!EOP
!-------------------------------------------------------------------------
!#include"netcdf.inc"
LEVEL3 'get_2d_field_ncdf()'
start(1) = il
start(2) = jl
edges(1) = ih-il+1
edges(2) = jh-jl+1
ubounds = ubound(field)
if ((ubounds(1) .ne. edges(1)) .or. ubounds(2) .ne. edges(2) ) then
call getm_error("get_2d_field_ncdf()", &
"Array bounds inconsistent.")
endif
status = nf90_open(trim(fn),NF90_NOWRITE,ncid)
if (status .NE. NF90_NOERR) then
call netcdf_error(status,"get_2d_field_ncdf()", &
"Error opening file "//trim(fn))
end if
status = nf90_inq_varid(ncid,trim(varname),varid)
if (status .ne. NF90_NOERR) then
call netcdf_error(status,"get_2d_field_ncdf()", &
"Error inquiring "//trim(varname))
endif
status = nf90_get_var(ncid,varid,field,start,edges)
if (status .ne. NF90_NOERR) then
call netcdf_error(status,"get_2d_field_ncdf()", &
"Error reading "//trim(varname))
endif
status = nf90_close(ncid)
if (status .ne. NF90_NOERR) then
call netcdf_error(status,"get_2d_field_ncdf()", &
"Error closing file")
endif
return
end subroutine get_2d_field_ncdf
!EOC
!-----------------------------------------------------------------------
! Copyright (C) 2009 - Hans Burchard and Karsten Bolding (BB) !
!-----------------------------------------------------------------------
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment