new_NS_Basis.F90 Source File

#include "MAPL_ErrLog.h"

submodule (mapl3g_VectorBasis) new_NS_Basis_smod
   use mapl_base, only: MAPL_GridGetCorners
contains


   module function new_NS_Basis(geom, rc) result(basis)
      type(VectorBasis) :: basis
      type(ESMF_Geom), intent(inout) :: geom
      integer, optional, intent(out) :: rc

      integer :: status
      real(kind=ESMF_KIND_R8), pointer :: longitudes(:)
      real(kind=ESMF_KIND_R8), pointer :: latitudes(:)

      call create_fields(basis%elements, geom, _RC)
      call MAPL_GeomGetCoords(geom, longitudes, latitudes, _RC)
      call fill_fields(basis, longitudes, latitudes, _RC)

      _RETURN(ESMF_SUCCESS)

   contains

      subroutine fill_fields(basis, longitudes, latitudes, rc)
         type(VectorBasis), intent(inout) :: basis
         real(kind=ESMF_KIND_R8), intent(in) :: longitudes(:)
         real(kind=ESMF_KIND_R8), intent(in) :: latitudes(:)
         integer, optional, intent(out) :: rc

         integer :: status
         type(Ptr_1d) :: x(NI,NJ)
         integer :: i, j, n
         real(kind=ESMF_KIND_R8) :: local_basis(NI,NJ)

         do j = 1, NJ
            do i = 1, NI
               call assign_fptr(basis%elements(i,j), x(i,j)%ptr, _RC)
            end do
         end do

         do n = 1, size(x(1,1)%ptr)
            local_basis = fill_element(longitudes(i), latitudes(i))

            do j = 1, NJ
               do i = 1, NI
                  x(i,j)%ptr(n) = local_basis(i,j)
               end do
            end do

         end do

         _RETURN(ESMF_SUCCESS)
      end subroutine fill_fields

      pure function fill_element(longitude, latitude) result(x)
         real(kind=ESMF_KIND_R8) :: x(NI,NJ)
         real(kind=ESMF_KIND_R8), intent(in) :: longitude
         real(kind=ESMF_KIND_R8), intent(in) :: latitude

         x(:,1) = [ -sin(longitude), cos(longitude), 0._ESMF_KIND_R8 ]
         x(:,2) = [ -sin(latitude)*cos(longitude), -sin(latitude)*sin(longitude), cos(latitude) ]

      end function fill_element

   end function new_NS_Basis

end submodule new_NS_Basis_smod