cart_to_latlon_new Subroutine

private subroutine cart_to_latlon_new(q, xs, ys)

Arguments

Type IntentOptional Attributes Name
real(kind=ESMF_KIND_R8), intent(inout) :: q(:,:,:)
real(kind=ESMF_KIND_R8), intent(inout) :: xs(:,:)
real(kind=ESMF_KIND_R8), intent(inout) :: ys(:,:)

Called by

proc~~cart_to_latlon_new~~CalledByGraph proc~cart_to_latlon_new cart_to_latlon_new proc~get_gnomonic_angl_coords get_gnomonic_angl_coords proc~get_gnomonic_angl_coords->proc~cart_to_latlon_new proc~get_gnomonic_dist_coords get_gnomonic_dist_coords proc~get_gnomonic_dist_coords->proc~cart_to_latlon_new proc~get_gnomonic_ed_coords get_gnomonic_ed_coords proc~get_gnomonic_ed_coords->proc~cart_to_latlon_new proc~get_gnomonic_local_coords get_gnomonic_local_coords proc~get_gnomonic_local_coords->proc~get_gnomonic_angl_coords proc~get_gnomonic_local_coords->proc~get_gnomonic_dist_coords proc~get_gnomonic_local_coords->proc~get_gnomonic_ed_coords proc~esmf_utilcreatecscoordspar ESMF_UtilCreateCSCoordsPar proc~esmf_utilcreatecscoordspar->proc~get_gnomonic_local_coords proc~esmf_gridcreatecubedsphereireg ESMF_GridCreateCubedSphereIReg proc~esmf_gridcreatecubedsphereireg->proc~esmf_utilcreatecscoordspar proc~esmf_gridcreatecubedspherereg ESMF_GridCreateCubedSphereReg proc~esmf_gridcreatecubedspherereg->proc~esmf_utilcreatecscoordspar

Source Code

 subroutine cart_to_latlon_new(q, xs, ys)
    ! vector version of cart_to_latlon1
    real(ESMF_KIND_R8), intent(inout) :: q(:,:,:)
    real(ESMF_KIND_R8), intent(inout) :: xs(:,:), ys(:,:)
    
    ! local
    real(ESMF_KIND_R8), parameter:: esl=1.e-10
    real(ESMF_KIND_R8) :: p(3)
    real(ESMF_KIND_R8) :: dist, lat, lon
    integer i, j, k
    
    
    do j = 1, size(q,3)
       do i = 1, size(q,2)
          p = q(:,i,j)
          
          dist = sqrt(p(1)**2 + p(2)**2 + p(3)**2)
          p = p/dist
          
          if ( (abs(p(1))+abs(p(2)))  < esl ) then
             lon = 0.
          else
             lon = atan2( p(2), p(1) )   ! range [-pi,pi]
          endif
          
          if ( lon < 0.) lon = 2.*pi + lon
          lat = asin(p(3))
          
          xs(i,j) = lon
          ys(i,j) = lat
          ! q Normalized:
          q(:,i,j) = p
       enddo
    end do
    
 end  subroutine cart_to_latlon_new