scale_file_grads Module Reference

module file_grads More...

Functions/Subroutines
subroutine, public	file_grads_open (file_name, file_id)
	Open. More...
subroutine, public	file_grads_varid (file_id, var_name, var_id)
logical function, public	file_grads_isoned (file_id, var_id)
subroutine	file_grads_get_shape_name (file_id, var_name, shape)
subroutine	file_grads_get_shape_id (file_id, var_id, shape)
subroutine	file_grads_read_1d_id (file_id, var_id, var, step, postfix)
subroutine	file_grads_read_2d_id (file_id, var_id, var, step, postfix)
subroutine	file_grads_read_3d_id (file_id, var_id, var, step, postfix)
subroutine, public	file_grads_close (file_id)
subroutine	read_data_int1 (fid, irecl, nx, ny, nz, k, yrev, var, ierr)
character(len=len(str)) function	upcase (str)

Detailed Description

module file_grads

Description

read data from GrADS file

Author

Team SCALE

NAMELIST

• GrADS_DIMS

  name	type	default value	comment
  NX	integer
  NY	integer
  NZ	integer

  
  
• GrADS_ITEM

  name	type	default value	comment
  NAME	character(len=H_SHORT)		up to 16 characters
  DTYPE	character(len=H_SHORT)		'linear','levels','map'
  FNAME	character(len=H_LONG)		head of file name
  SWPOINT	real(RP)		start point (south-west point) for "linear"
  DD	real(RP)		dlon,dlat for "linear"
  LNUM	integer		number of data
  LVARS	real(RP), dimension(LVARS_MAX)		values for "levels"
  STARTREC	integer		record position
  TOTALREC	integer		total record number per one time
  MISSVAL	real(SP)		missing value
  NX	integer
  NY	integer
  NZ	integer
  YREV	logical
  BINTYPE	character(len=H_SHORT)		binary type: 'int?' or 'real?' ?=2,4, or 8

  
  
• nml_grads_grid

  name	type	default value	comment
  DUMMY	logical

  
  
• grdvar

  name	type	default value	comment
  DUMMY	logical

  
  

History Output

No history output

Function/Subroutine Documentation

file_grads_open()

subroutine, public scale_file_grads::file_grads_open	(	character(len=*), intent(in)	file_name,
		integer, intent(out)	file_id
	)

Open.

Definition at line 102 of file scale_file_grads.F90.

    use scale_prc, only: &
       prc_abort
    use scale_const, only: &
       undef => const_undef
    implicit none
    character(len=*), intent(in)  :: file_name
    integer,          intent(out) :: file_id
 
    character(len=H_SHORT) :: name             ! up to 16 characters
    character(len=H_SHORT) :: dtype            ! 'linear','levels','map'
    character(len=H_LONG)  :: fname            ! head of file name
    real(RP)               :: swpoint          ! start point (south-west point) for "linear"
    real(RP)               :: dd               ! dlon,dlat for "linear"
    integer                :: lnum             ! number of data
    real(RP)               :: lvars(lvars_max) ! values for "levels"
    integer                :: startrec         ! record position
    integer                :: totalrec         ! total record number per one time
    real(SP)               :: missval          ! missing value
    integer                :: nx               ! optional
    integer                :: ny               ! optional
    integer                :: nz               ! optional
    character(len=H_SHORT) :: fendian          ! option for "map"
    logical                :: yrev             ! option for "map", if yrev=.true., order of data is NW to SE.
    character(len=H_SHORT) :: bintype          ! binary type: 'int?' or 'real?' ?=2,4, or 8
 
    namelist /grads_dims/ &
       nx, &
       ny, &
       nz
 
    namelist /grads_item/ &
       name,     & ! necessary
       dtype,    & ! necessary
       fname,    & ! necessary except for linear data
       swpoint,  & ! for linear data
       dd,       & ! for linear data
       lnum,     & ! for levels data
       lvars,    & ! for levels data
       startrec, & ! for map data
       totalrec, & ! for map data
       missval,  & ! option
       nx,       & ! option
       ny,       & ! option
       nz,       & ! option
       yrev,     & ! option
       bintype     ! option
!       fendian     ! option
 
    character(len=H_LONG) :: dirname
 
    integer :: fid
    integer :: nvars
    integer :: ierr
    integer :: n
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("FILE_GrADS_open",*) 'open namelist file :', trim(file_name)
 
    ! check exist
    do n = 1, nnmls
       if ( nmls(n)%fname == file_name ) then
          ! alread read
          file_id = n
          return
       end if
    end do
 
 
    fid = io_get_available_fid()
    !--- open namelist
    open( fid, &
          file   = trim(file_name), &
          form   = 'formatted',    &
          status = 'old',          &
          action = 'read',         &
          iostat = ierr            )
    if ( ierr /= 0 ) then
       log_error("FILE_GrADS_open",*) 'Input file is not found! ', trim(file_name)
       call prc_abort
    endif
 
    call check_oldnamelist( fid )
 
    !--- read namelist dims
    read(fid,nml=grads_dims,iostat=ierr)
    if( ierr /= 0 ) then !--- missing or fatal error
       log_error("FILE_GrADS_open",*) 'Not appropriate names in GrADS_DIMS in ', trim(file_name),'. Check!'
       call prc_abort
    endif
    log_nml(grads_dims)
 
 
    nnmls = nnmls + 1
    file_id = nnmls
 
    nmls(file_id)%fname = file_name
    nmls(file_id)%nx    = nx
    nmls(file_id)%ny    = ny
    nmls(file_id)%nz    = nz
 
 
 
    !--- count the number of variables
    rewind(fid)
    nvars = 0
    do n = 1, vars_max
       read(fid, nml=grads_item, iostat=ierr)
       if( ierr > 0 )then
          log_error("FILE_GrADS_open",*) 'Not appropriate names in GrADS_ITEM in ', trim(file_name),'. Check!'
          call prc_abort
       else if( ierr < 0 )then
          exit
       endif
       nvars = nvars + 1
    enddo
 
    if ( nvars > vars_max ) then
       log_error("FILE_GRADS_open",*) 'The number of grads vars exceeds the limit! ', &
            nvars, ' > ', vars_max
       call prc_abort
    endif
 
    nmls(file_id)%nvars = nvars
    allocate( nmls(file_id)%vars(nvars) )
 
    n = index( file_name, '/', back=.true. )
    if ( n > 0 ) then
       dirname = file_name(1:n)
    else
       dirname = ""
    end if
 
    !--- read information of the variables
    rewind(fid)
    do n = 1, nvars
 
       ! set default
       name     = ''
       dtype    = ''
       fname    = ''
       swpoint  = undef
       dd       = undef
       lnum     = -1
       lvars(:) = undef
       startrec = -1
       totalrec = -1
       nx       = nmls(file_id)%nx
       ny       = nmls(file_id)%ny
       nz       = nmls(file_id)%nz
       yrev     = .false.
       fendian  = 'big'
       missval  = undef
       bintype  = 'real4'
 
       ! read namelist
       read(fid, nml=grads_item, iostat=ierr)
       if( ierr /= 0 ) exit
 
       nmls(file_id)%vars(n)%name    = upcase(name)
       if ( fname(1:1) == "/" ) then
          nmls(file_id)%vars(n)%fname = fname
       else
          nmls(file_id)%vars(n)%fname = trim(dirname) // fname
       end if
       nmls(file_id)%vars(n)%dtype   = dtype
       nmls(file_id)%vars(n)%swpoint = swpoint
       nmls(file_id)%vars(n)%dd      = dd
       nmls(file_id)%vars(n)%lnum    = lnum
       if ( lnum > 0 ) then
          allocate( nmls(file_id)%vars(n)%lvars(lnum) )
          nmls(file_id)%vars(n)%lvars(:) = lvars(1:lnum)
       end if
       nmls(file_id)%vars(n)%startrec = startrec
       nmls(file_id)%vars(n)%totalrec = totalrec
       nmls(file_id)%vars(n)%missval  = missval
       nmls(file_id)%vars(n)%nx       = nx
       nmls(file_id)%vars(n)%ny       = ny
       nmls(file_id)%vars(n)%nz       = nz
       nmls(file_id)%vars(n)%yrev     = yrev
       if ( fendian == "big" ) then
          nmls(file_id)%vars(n)%endian = 1
       else
          nmls(file_id)%vars(n)%endian = 0
       end if
       nmls(file_id)%vars(n)%bintype  = bintype
 
    end do
 
    close( fid )
 

References scale_const::const_undef, scale_io::io_get_available_fid(), scale_prc::prc_abort(), and upcase().

Referenced by mod_cnv2d::cnv2d_grads_init(), mod_cnvuser::cnvuser(), mod_cnvuser::cnvuser_setup(), mod_copytopo::copytopo_get_data_grads(), mod_copytopo::copytopo_get_size_grads(), mod_copytopo::copytopo_get_size_wrfarw(), mod_realinput_grads::parentatmossetupgrads(), mod_realinput_grads::parentlandsetupgrads(), and mod_realinput_grads::parentoceansetupgrads().

Here is the call graph for this function:

Here is the caller graph for this function:

file_grads_varid()

subroutine, public scale_file_grads::file_grads_varid	(	integer, intent(in)	file_id,
		character(len=*), intent(in)	var_name,
		integer, intent(out)	var_id
	)

Definition at line 300 of file scale_file_grads.F90.

    use scale_prc, only: &
       prc_abort
    implicit none
    integer,          intent(in)  :: file_id
    character(len=*), intent(in)  :: var_name
    integer,          intent(out) :: var_id
 
    character(len=len(var_name)) :: vname
    integer :: n
 
    if ( file_id < 0 ) then
       log_error("FILE_GrADS_varid",*) 'file_id is invalid: ', file_id
       call prc_abort
    end if
 
    vname = upcase(var_name)
 
    var_id = -1
    do n = 1, nmls(file_id)%nvars
       if ( nmls(file_id)%vars(n)%name == vname ) then
          var_id = n
          return
       end if
    end do
 
    return

References scale_prc::prc_abort(), and upcase().

Referenced by mod_cnv2d::cnv2d_grads_init(), mod_cnvuser::cnvuser(), mod_cnvuser::cnvuser_setup(), mod_copytopo::copytopo_get_data_grads(), file_grads_get_shape_id(), file_grads_get_shape_name(), file_grads_read_1d_id(), file_grads_read_2d_id(), mod_realinput_grads::parentatmossetupgrads(), mod_realinput_grads::parentlandsetupgrads(), and mod_realinput_grads::parentoceansetupgrads().

Here is the call graph for this function:

Here is the caller graph for this function:

file_grads_isoned()

logical function, public scale_file_grads::file_grads_isoned	(	integer, intent(in)	file_id,
		integer, intent(in)	var_id
	)

Definition at line 332 of file scale_file_grads.F90.

    use scale_prc, only: &
       prc_abort
    implicit none
    integer, intent(in)  :: file_id
    integer, intent(in)  :: var_id
    logical :: ret
 
    if ( file_id < 0 ) then
       log_error("FILE_GrADS_isOneD",*) 'file_id is invalid: ', file_id
       call prc_abort
    end if
    if ( var_id < 0 ) then
       log_error("FILE_GrADS_isOneD",*) 'var_id is invalid: ', var_id
       call prc_abort
    end if
 
    select case( nmls(file_id)%vars(var_id)%dtype )
    case ('linear', 'levels')
       ret = .true.
    case default
       ret = .false.
    end select
 
    return

References scale_prc::prc_abort().

Referenced by mod_cnv2d::cnv2d_grads_init(), mod_cnvuser::cnvuser_setup(), mod_copytopo::copytopo_get_data_grads(), file_grads_get_shape_id(), mod_realinput_grads::parentatmosinputgrads(), mod_realinput_grads::parentatmosopengrads(), mod_realinput_grads::parentlandinputgrads(), and mod_realinput_grads::parentoceaninputgrads().

Here is the call graph for this function:

Here is the caller graph for this function:

file_grads_get_shape_name()

subroutine scale_file_grads::file_grads_get_shape_name	(	integer, intent(in)	file_id,
		character(len=*), intent(in)	var_name,
		integer, dimension(:), intent(out)	shape
	)

Definition at line 363 of file scale_file_grads.F90.

    use scale_prc, only: &
       prc_abort
    implicit none
    integer,          intent(in)  :: file_id
    character(len=*), intent(in)  :: var_name
    integer,          intent(out) :: shape(:)
    
    integer :: var_id
 
    call file_grads_varid( file_id, var_name, & ! (in)
                           var_id             ) ! (out)
    
    if ( var_id < 0 ) then
       log_error("FILE_GrADS_get_shape",*) 'variable "', trim(var_name), ' is not founed in file "', trim(nmls(file_id)%fname), '"'
       call prc_abort
    end if
 
    call file_grads_get_shape_id( file_id, var_id, & ! (in)
                                  shape(:)         ) ! (out)
 
    return

References file_grads_get_shape_id(), file_grads_varid(), and scale_prc::prc_abort().

Here is the call graph for this function:

file_grads_get_shape_id()

subroutine scale_file_grads::file_grads_get_shape_id	(	integer, intent(in)	file_id,
		integer, intent(in)	var_id,
		integer, dimension(:), intent(out)	shape
	)

Definition at line 390 of file scale_file_grads.F90.

    implicit none
    integer, intent(in)  :: file_id
    integer, intent(in)  :: var_id
    integer, intent(out) :: shape(:)
    
    intrinsic :: size
 
    if ( file_grads_isoned( file_id, var_id ) ) then
       if ( nmls(file_id)%vars(var_id)%dtype == "levels" ) then
          shape(1) = nmls(file_id)%vars(var_id)%lnum
       else
          shape(1) = -1
       end if
    else if ( size(shape) == 2 ) then
       shape(1) = nmls(file_id)%vars(var_id)%nx
       shape(2) = nmls(file_id)%vars(var_id)%ny
    else
       shape(1) = nmls(file_id)%vars(var_id)%nz
       shape(2) = nmls(file_id)%vars(var_id)%nx
       shape(3) = nmls(file_id)%vars(var_id)%ny
    end if
 
    return

References file_grads_isoned(), file_grads_read_1d_id(), file_grads_varid(), and scale_prc::prc_abort().

Referenced by file_grads_get_shape_name().

Here is the call graph for this function:

Here is the caller graph for this function:

file_grads_read_1d_id()

subroutine scale_file_grads::file_grads_read_1d_id	(	integer, intent(in)	file_id,
		integer, intent(in)	var_id,
		real(rp), dimension(:), intent(out)	var,
		integer, intent(in), optional	step,
		character(len=*), intent(in), optional	postfix
	)

Definition at line 457 of file scale_file_grads.F90.

    implicit none
    integer,          intent(in)  :: file_id
    integer,          intent(in)  :: var_id
    real(RP),         intent(out) :: var(:)
    integer,          intent(in), optional :: step
    character(len=*), intent(in), optional :: postfix
 
    logical :: exist
    integer :: vid
 
    intrinsic :: size
    !---------------------------------------------------------------------------
 
    if ( file_id < 0 ) then
       log_error("FILE_GrADS_read_1D_vid",*) 'file_id is invalid: ', file_id
    end if
    if ( var_id < 0 ) then
       log_error("FILE_GrADS_read_1D_vid",*) 'var_id is invalid: ', var_id
    end if
 
    call file_grads_read_data( nmls(file_id)%vars(var_id), & ! (in)
                               1, size(var),               & ! (in)
                               var(:),                     & ! (out)
                               step = step,                & ! (int)
                               postfix = postfix           ) ! (in)
 
    return

References file_grads_read_2d_id(), file_grads_varid(), and scale_prc::prc_abort().

Referenced by file_grads_get_shape_id().

Here is the call graph for this function:

Here is the caller graph for this function:

file_grads_read_2d_id()

subroutine scale_file_grads::file_grads_read_2d_id	(	integer, intent(in)	file_id,
		integer, intent(in)	var_id,
		real(rp), dimension(:,:), intent(out)	var,
		integer, intent(in), optional	step,
		character(len=*), intent(in), optional	postfix
	)

Definition at line 527 of file scale_file_grads.F90.

    implicit none
    integer,          intent(in)  :: file_id
    integer,          intent(in)  :: var_id
    real(RP),         intent(out) :: var(:,:)
    integer,          intent(in), optional :: step
    character(len=*), intent(in), optional :: postfix
 
    integer :: vid
    intrinsic :: size
    !---------------------------------------------------------------------------
 
    if ( file_id < 0 ) then
       log_error("FILE_GrADS_read_2D_vid",*) 'file_id is invalid: ', file_id
    end if
    if ( var_id < 0 ) then
       log_error("FILE_GrADS_read_2D_vid",*) 'var_id is invalid: ', var_id
    end if
 
    call file_grads_read_data( nmls(file_id)%vars(var_id), & ! (in)
                               2, size(var),               & ! (in)
                               var(:,:),                   & ! (out)
                               step = step,                & ! (in)
                               postfix = postfix           ) ! (in)
 
    return

References file_grads_read_3d_id(), file_grads_varid(), and scale_prc::prc_abort().

Referenced by file_grads_read_1d_id().

Here is the call graph for this function:

Here is the caller graph for this function:

file_grads_read_3d_id()

subroutine scale_file_grads::file_grads_read_3d_id	(	integer, intent(in)	file_id,
		integer, intent(in)	var_id,
		real(rp), dimension(:,:,:), intent(out)	var,
		integer, intent(in), optional	step,
		character(len=*), intent(in), optional	postfix
	)

Definition at line 595 of file scale_file_grads.F90.

    implicit none
    integer,          intent(in)  :: file_id
    integer,          intent(in)  :: var_id
    real(RP),         intent(out) :: var(:,:,:)
    integer,          intent(in), optional :: step
    character(len=*), intent(in), optional :: postfix
 
    integer :: vid
    intrinsic :: size
    !---------------------------------------------------------------------------
 
    if ( file_id < 0 ) then
       log_error("FILE_GrADS_read_3D_vid",*) 'file_id is invalid: ', file_id
    end if
    if ( var_id < 0 ) then
       log_error("FILE_GrADS_read_3D_vid",*) 'var_id is invalid: ', var_id
    end if
 
    call file_grads_read_data( nmls(file_id)%vars(var_id),     & ! (in)
                               3, size(var),                   & ! (in)
                               var(:,:,:),                     & ! (out)
                               step = step, postfix = postfix  ) ! (in)
 
    return

Referenced by file_grads_read_2d_id().

Here is the caller graph for this function:

file_grads_close()

subroutine, public scale_file_grads::file_grads_close

(

integer, intent(in)

file_id

)

Definition at line 624 of file scale_file_grads.F90.

    implicit none
    integer, intent(in) :: file_id
 
    integer :: n, m
 
    if ( file_id < 0 ) return
 
    do n = 1, nmls(file_id)%nvars
       do m = 1, nfiles
          if ( files(m)%fname == nmls(file_id)%vars(n)%fname ) then
             if ( files(m)%fid > 0 ) then
                close( files(m)%fid )
                files(m)%fid = -1
                files(m)%postfix = ""
             end if
             exit
          end if
       end do
       if ( nmls(file_id)%vars(n)%lnum > 0 ) deallocate( nmls(file_id)%vars(n)%lvars )
       nmls(file_id)%vars(n)%lnum = -1
    end do
    deallocate( nmls(file_id)%vars )
    nmls(file_id)%fname = ""
    nmls(file_id)%nvars = 0
 
    return

References scale_const::const_eps, scale_const::const_undef, scale_io::io_get_available_fid(), scale_prc::prc_abort(), and read_data_int1().

Referenced by mod_copytopo::copytopo_get_data_grads().

Here is the call graph for this function:

Here is the caller graph for this function:

read_data_int1()

subroutine scale_file_grads::read_data_int1	(	integer, intent(in)	fid,
		integer, intent(in)	irecl,
		integer, intent(in)	nx,
		integer, intent(in)	ny,
		integer, intent(in)	nz,
		integer, intent(in)	k,
		logical, intent(in)	yrev,
		real(rp), dimension(:), intent(out)	var,
		integer, intent(out)	ierr
	)

Definition at line 863 of file scale_file_grads.F90.

    integer, intent(in) :: fid, irecl
    integer, intent(in) :: nx, ny, nz, k
    logical, intent(in) :: yrev
 
    real(RP), intent(out) :: var(:)
    integer,  intent(out) :: ierr
 
    integer(1) :: buf(nx,ny)
    integer :: i, j
 
    read(fid, rec=irecl, iostat=ierr) buf(:,:)
    if ( ierr /= 0 ) return
 
    if ( yrev ) then
       !$omp parallel do collapse(2)
       do j = 1, ny
          do i = 1, nx
             var(k+(i-1)*nz+(j-1)*nx*nz) = buf(i,ny-j+1)
          end do
       end do
    else
       !$omp parallel do collapse(2)
       do j = 1, ny
          do i = 1, nx
             var(k+(i-1)*nz+(j-1)*nx*nz) = buf(i,j)
          end do
       end do
    end if
 
    return

References scale_prc::prc_abort().

Referenced by file_grads_close().

Here is the call graph for this function:

Here is the caller graph for this function:

upcase()

character(len=len(str)) function scale_file_grads::upcase

(

character(len=*), intent(in)

str

)

Definition at line 1093 of file scale_file_grads.F90.

    character(len=*), intent(in) :: str
    character(len=len(str)) :: upcase
    integer :: i
    do i = 1, len_trim(str)
       if ( str(i:i) >= 'a' .and. str(i:i) <= 'z' ) then
          upcase(i:i) = char( ichar(str(i:i)) - 32 )
       else
          upcase(i:i) = str(i:i)
       end if
    end do
    do i = len_trim(str)+1, len(str)
       upcase(i:i) = ' '
    end do

Referenced by file_grads_open(), and file_grads_varid().

Here is the caller graph for this function: