tools_atlas.F90

Go to the documentation of this file.

# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../generics.fypp" 1
!----------------------------------------------------------------------
! Header: generics
!> Generic ranks, dimensions and types
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
 
# 57 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../generics.fypp"
# 2 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp" 2
# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../instrumentation.fypp" 1
# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../subr_list.fypp" 1
!----------------------------------------------------------------------
! Header: subr_list
!> Subroutines/functions list
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
 
# 926 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../subr_list.fypp"
# 2 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../instrumentation.fypp" 2
!----------------------------------------------------------------------
! Header: instrumentation
!> Instrumentation functions
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
 
# 112 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../instrumentation.fypp"
# 3 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp" 2
!----------------------------------------------------------------------
! Module: tools_atlas
!> ATLAS tools
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
module tools_atlas
 
use atlas_module, only: atlas_field,atlas_integer,atlas_real,atlas_functionspace,atlas_functionspace_nodecolumns, &
 & atlas_functionspace_pointcloud,atlas_functionspace_structuredcolumns
use tools_const, only: rad2deg
use tools_kinds, only: kind_int,kind_real
use tools_func, only: convert_i2l,convert_l2i
use tools_netcdf, only: create_file
use type_mpl, only: mpl_type
 
 
implicit none
 
interface field_to_array
# 25 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 26 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_to_array_int_r2
# 26 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_to_array_real_r2
# 26 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_to_array_logical_r2
# 28 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 25 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 26 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_to_array_int_r3
# 26 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_to_array_real_r3
# 26 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_to_array_logical_r3
# 28 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 29 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
end interface
interface field_from_array
# 32 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_from_array_int_r2
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_from_array_real_r2
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_from_array_logical_r2
# 35 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 32 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_from_array_int_r3
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_from_array_real_r3
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
         module procedure atlas_field_from_array_logical_r3
# 35 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 36 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
end interface
interface create_atlas_function_space
   module procedure atlas_create_atlas_function_space
end interface
interface get_atlas_field_size
   module procedure atlas_get_atlas_field_size
end interface
 
private
public :: field_to_array,field_from_array,create_atlas_function_space,get_atlas_field_size
 
contains
 
# 50 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 51 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_to_array_int_r2
!> Convert ATLAS field to field
!----------------------------------------------------------------------
subroutine atlas_field_to_array_int_r2(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(in) :: afield               !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
integer(kind_int),intent(out) :: array(:,:) !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(2)
integer(kind_int),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_to_array_int_r2','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_integer(kind_int)) call mpl%abort('atlas_field_to_array_int_r2','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(2)
nnodes = product(shp(1:2-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_to_array_int_r2','wrong number of nodes for field '//afield%name())
 
! Initialization
array = 0
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
    array(:,nl2d) = ptr_1 
   
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_to_array_int_r2','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
       array(:,il0) = ptr_2(il0,:) 
      
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_to_array_int_r2
# 51 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_to_array_real_r2
!> Convert ATLAS field to field
!----------------------------------------------------------------------
subroutine atlas_field_to_array_real_r2(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(in) :: afield               !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
real(kind_real),intent(out) :: array(:,:) !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(2)
real(kind_real),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_to_array_real_r2','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_real(kind_real)) call mpl%abort('atlas_field_to_array_real_r2','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(2)
nnodes = product(shp(1:2-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_to_array_real_r2','wrong number of nodes for field '//afield%name())
 
! Initialization
array = 0.0_kind_real
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
    array(:,nl2d) = ptr_1 
   
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_to_array_real_r2','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
       array(:,il0) = ptr_2(il0,:) 
      
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_to_array_real_r2
# 129 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 50 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 51 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_to_array_int_r3
!> Convert ATLAS field to field
!----------------------------------------------------------------------
subroutine atlas_field_to_array_int_r3(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(in) :: afield               !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
integer(kind_int),intent(out) :: array(:,:,:) !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(3)
integer(kind_int),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_to_array_int_r3','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_integer(kind_int)) call mpl%abort('atlas_field_to_array_int_r3','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(3)
nnodes = product(shp(1:3-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_to_array_int_r3','wrong number of nodes for field '//afield%name())
 
! Initialization
array = 0
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
   
    array(:,:,nl2d) = reshape(ptr_1,shp(1:2)) 
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_to_array_int_r3','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
      
       array(:,:,il0) = reshape(ptr_2(il0,:),shp(1:2)) 
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_to_array_int_r3
# 51 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_to_array_real_r3
!> Convert ATLAS field to field
!----------------------------------------------------------------------
subroutine atlas_field_to_array_real_r3(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(in) :: afield               !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
real(kind_real),intent(out) :: array(:,:,:) !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(3)
real(kind_real),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_to_array_real_r3','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_real(kind_real)) call mpl%abort('atlas_field_to_array_real_r3','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(3)
nnodes = product(shp(1:3-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_to_array_real_r3','wrong number of nodes for field '//afield%name())
 
! Initialization
array = 0.0_kind_real
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
   
    array(:,:,nl2d) = reshape(ptr_1,shp(1:2)) 
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_to_array_real_r3','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
      
       array(:,:,il0) = reshape(ptr_2(il0,:),shp(1:2)) 
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_to_array_real_r3
# 129 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 130 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
 
# 132 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_to_array_logical_r2
!> Convert ATLAS field to field
!----------------------------------------------------------------------
subroutine atlas_field_to_array_logical_r2(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(in) :: afield        !< ATLAS field
type(mpl_type),intent(inout) :: mpl           !< MPI data
logical,intent(out) :: array(:,:)   !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d !< Level for 2D variables
 
! Local variables
integer :: shp(2)
integer,allocatable :: array_int(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_to_array_logical_r2','wrong lev2d')
 
! Allocation
shp = shape(array)
 allocate(array_int(shp(1),shp(2))) 
 
 
! Get integer array
call field_to_array(afield,mpl,array_int,lev2d)
 
! Convert integer to logical
call convert_i2l(mpl,array_int,array)
 
! Release memory
deallocate(array_int)
 
! Probe out
 
 
end subroutine atlas_field_to_array_logical_r2
# 132 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_to_array_logical_r3
!> Convert ATLAS field to field
!----------------------------------------------------------------------
subroutine atlas_field_to_array_logical_r3(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(in) :: afield        !< ATLAS field
type(mpl_type),intent(inout) :: mpl           !< MPI data
logical,intent(out) :: array(:,:,:)   !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d !< Level for 2D variables
 
! Local variables
integer :: shp(3)
integer,allocatable :: array_int(:,:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_to_array_logical_r3','wrong lev2d')
 
! Allocation
shp = shape(array)
 
 allocate(array_int(shp(1),shp(2),shp(3))) 
 
! Get integer array
call field_to_array(afield,mpl,array_int,lev2d)
 
! Convert integer to logical
call convert_i2l(mpl,array_int,array)
 
! Release memory
deallocate(array_int)
 
! Probe out
 
 
end subroutine atlas_field_to_array_logical_r3
# 181 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
 
# 183 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 184 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_from_array_int_r2
!> Convert field to ATLAS field, real
!----------------------------------------------------------------------
subroutine atlas_field_from_array_int_r2(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(inout) :: afield            !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
integer(kind_int),intent(in) :: array(:,:)  !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(2)
integer(kind_int),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_from_array_int_r2','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_integer(kind_int)) call mpl%abort('atlas_field_from_array_int_r2','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(2)
nnodes = product(shp(1:2-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_from_array_int_r2','wrong number of nodes for field '//afield%name())
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
    ptr_1 = array(:,nl2d) 
   
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_from_array_int_r2','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
       ptr_2(il0,:) = array(:,il0) 
      
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_from_array_int_r2
# 184 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_from_array_real_r2
!> Convert field to ATLAS field, real
!----------------------------------------------------------------------
subroutine atlas_field_from_array_real_r2(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(inout) :: afield            !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
real(kind_real),intent(in) :: array(:,:)  !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(2)
real(kind_real),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_from_array_real_r2','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_real(kind_real)) call mpl%abort('atlas_field_from_array_real_r2','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(2)
nnodes = product(shp(1:2-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_from_array_real_r2','wrong number of nodes for field '//afield%name())
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
    ptr_1 = array(:,nl2d) 
   
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_from_array_real_r2','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
       ptr_2(il0,:) = array(:,il0) 
      
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_from_array_real_r2
# 259 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 183 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 184 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_from_array_int_r3
!> Convert field to ATLAS field, real
!----------------------------------------------------------------------
subroutine atlas_field_from_array_int_r3(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(inout) :: afield            !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
integer(kind_int),intent(in) :: array(:,:,:)  !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(3)
integer(kind_int),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_from_array_int_r3','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_integer(kind_int)) call mpl%abort('atlas_field_from_array_int_r3','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(3)
nnodes = product(shp(1:3-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_from_array_int_r3','wrong number of nodes for field '//afield%name())
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
   
    ptr_1 = reshape(array(:,:,nl2d),(/product(shp(1:2))/)) 
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_from_array_int_r3','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
      
       ptr_2(il0,:) = reshape(array(:,:,il0),(/product(shp(1:2))/)) 
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_from_array_int_r3
# 184 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_from_array_real_r3
!> Convert field to ATLAS field, real
!----------------------------------------------------------------------
subroutine atlas_field_from_array_real_r3(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(inout) :: afield            !< ATLAS field
type(mpl_type),intent(inout) :: mpl                  !< MPI data
real(kind_real),intent(in) :: array(:,:,:)  !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d        !< Level for 2D variables
 
! Local variables
integer :: nmga,nnodes,nl0,nl2d,il0
integer :: shp(3)
real(kind_real),pointer :: ptr_1(:),ptr_2(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_from_array_real_r3','wrong lev2d')
 
! Check kind
if (afield%kind()/=atlas_real(kind_real)) call mpl%abort('atlas_field_from_array_real_r3','wrong kind for field '//afield%name())
 
! Get ATLAS field size
nmga = get_atlas_field_size(mpl,afield)
 
! Get number of nodes and number of levels
! - the size of the rightmost dimension of arr2d/arr3d is the number of levels (nl0)
! - the product of the other dimenstions give the number of nodes (nnodes)
shp = shape(array)
nl0 = shp(3)
nnodes = product(shp(1:3-1))
 
! Check number of nodes
if (nmga/=nnodes) call mpl%abort('atlas_field_from_array_real_r3','wrong number of nodes for field '//afield%name())
 
! Copy data
! afield%levels() is 0 for 2D ATLAS fields, positive for 3D fields
! For the 2D case (afield%levels()==0), the field is copied:
! - at the first level of array if (lev2d=='first')
! - at the last level of array if (lev2d=='last')
if (afield%levels()==0) then
   if (trim(llev2d)=='first') then
      nl2d = 1
   elseif (trim(llev2d)=='last') then
      nl2d = nl0
   end if
   call afield%data(ptr_1)
   
    ptr_1 = reshape(array(:,:,nl2d),(/product(shp(1:2))/)) 
else
   if (nl0>afield%levels()) call mpl%abort('atlas_field_from_array_real_r3','not enough levels in ATLAS field')
   call afield%data(ptr_2)
   do il0=1,nl0
      
       ptr_2(il0,:) = reshape(array(:,:,il0),(/product(shp(1:2))/)) 
   end do
end if
 
! Probe out
 
 
end subroutine atlas_field_from_array_real_r3
# 259 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
# 260 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
 
# 262 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_from_array_logical_r2
!> Convert ATLAS field from field
!----------------------------------------------------------------------
subroutine atlas_field_from_array_logical_r2(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(inout) :: afield     !< ATLAS field
type(mpl_type),intent(inout) :: mpl           !< MPI data
logical,intent(in) :: array(:,:)    !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d !< Level for 2D variables
 
! Local variables
integer :: shp(2)
integer,allocatable :: array_int(:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_from_array_logical_r2','wrong lev2d')
 
! Allocation
shp = shape(array)
 allocate(array_int(shp(1),shp(2))) 
 
 
! Convert logical to integer
call convert_l2i(array,array_int)
 
! Set integer array
call field_from_array(afield,mpl,array_int,lev2d)
 
! Release memory
deallocate(array_int)
 
! Probe out
 
 
end subroutine atlas_field_from_array_logical_r2
# 262 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
!----------------------------------------------------------------------
! Subroutine: atlas_field_from_array_logical_r3
!> Convert ATLAS field from field
!----------------------------------------------------------------------
subroutine atlas_field_from_array_logical_r3(afield,mpl,array,lev2d)
 
implicit none
 
! Passed variables
type(atlas_field),intent(inout) :: afield     !< ATLAS field
type(mpl_type),intent(inout) :: mpl           !< MPI data
logical,intent(in) :: array(:,:,:)    !< Array, the rightmost dimension being the vertical
character(len=*),intent(in),optional :: lev2d !< Level for 2D variables
 
! Local variables
integer :: shp(3)
integer,allocatable :: array_int(:,:,:)
character(len=1024) :: llev2d
 
! Set name
 
 
! Probe in
 
 
! Local lev2d
llev2d = 'first'
if (present(lev2d)) llev2d = lev2d
if (.not.((trim(llev2d)=='first').or.(trim(llev2d)=='last'))) call mpl%abort('atlas_field_from_array_logical_r3','wrong lev2d')
 
! Allocation
shp = shape(array)
 
 allocate(array_int(shp(1),shp(2),shp(3))) 
 
! Convert logical to integer
call convert_l2i(array,array_int)
 
! Set integer array
call field_from_array(afield,mpl,array_int,lev2d)
 
! Release memory
deallocate(array_int)
 
! Probe out
 
 
end subroutine atlas_field_from_array_logical_r3
# 311 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_atlas.fypp"
 
!----------------------------------------------------------------------
! Subroutine: atlas_create_atlas_function_space
!> Create ATLAS function space from lon/lat
!----------------------------------------------------------------------
subroutine atlas_create_atlas_function_space(nmga,lon_mga,lat_mga,afunctionspace)
 
implicit none
 
! Passed variables
integer,intent(in) :: nmga                              !< Number of nodes
real(kind_real),intent(in) :: lon_mga(nmga)             !< Longitudes [in degrees]
real(kind_real),intent(in) :: lat_mga(nmga)             !< Latitudes [in degrees]
type(atlas_functionspace),intent(out) :: afunctionspace !< ATLAS function space
 
! Local variables
integer :: imga
real(kind_real),pointer :: real_ptr(:,:)
type(atlas_field) :: afield
 
! Set name
 
 
! Probe in
 
 
! Create lon/lat field
afield = atlas_field(name='lonlat',kind=atlas_real(kind_real),shape=(/2,nmga/))
call afield%data(real_ptr)
do imga=1,nmga
   real_ptr(1,imga) = lon_mga(imga)
   real_ptr(2,imga) = lat_mga(imga)
end do
 
! Create function space PointCloud
afunctionspace = atlas_functionspace_pointcloud(afield)
 
! Probe out
 
 
end subroutine atlas_create_atlas_function_space
 
!----------------------------------------------------------------------
! Function: atlas_get_atlas_field_size
!> Get the local horizontal size of an ATLAS field
!----------------------------------------------------------------------
function atlas_get_atlas_field_size(mpl,afield) result(nmga)
 
implicit none
 
! Passed variables
type(mpl_type),intent(inout) :: mpl    !< MPI data
type(atlas_field),intent(in) :: afield !< ATLAS field
 
! Returned variable
integer :: nmga
 
! Local variables
type(atlas_functionspace) :: afunctionspace
type(atlas_functionspace_nodecolumns) :: afunctionspace_nc
type(atlas_functionspace_pointcloud) :: afunctionspace_pc
type(atlas_functionspace_structuredcolumns) :: afunctionspace_sc
 
! Set name
 
 
! Probe in
 
 
! Get generic functionspace
afunctionspace = afield%functionspace()
 
select case (afunctionspace%name())
case ('NodeColumns')
   ! Get NodeColumns function space
   afunctionspace_nc = afield%functionspace()
 
   ! Get number of nodes
   nmga = afunctionspace_nc%nb_nodes()
case ('PointCloud')
   ! Get PointCloud function space
   afunctionspace_pc = afield%functionspace()
 
   ! Get number of points
   nmga = afunctionspace_pc%size()
case ('StructuredColumns')
   ! Get StructuredColumns function space
   afunctionspace_sc = afield%functionspace()
 
   ! Get number of nodes
   nmga = afunctionspace_sc%size_owned()
case default
   call mpl%abort('atlas_get_atlas_field_size','wrong function space for field '//afield%name()//': '//afunctionspace%name())
end select
 
! Probe out
 
 
end function atlas_get_atlas_field_size
 
end module tools_atlas