direct_transform Subroutine

private subroutine direct_transform(stretch_factor, lon_p, lat_p, lon, lat)

Arguments

Type IntentOptional Attributes Name
real(kind=ESMF_KIND_R8), intent(in) :: stretch_factor

Stretching factor
real(kind=ESMF_KIND_R8), intent(in) :: lon_p

center location of the target face, radian
real(kind=ESMF_KIND_R8), intent(in) :: lat_p

center location of the target face, radian
real(kind=ESMF_KIND_R8), intent(inout) :: lon(:,:)
real(kind=ESMF_KIND_R8), intent(inout) :: lat(:,:)

Called by

proc~~direct_transform~~CalledByGraph proc~direct_transform direct_transform proc~esmf_utilcreatecscoords ESMF_UtilCreateCSCoords proc~esmf_utilcreatecscoords->proc~direct_transform proc~esmf_utilcreatecscoordspar ESMF_UtilCreateCSCoordsPar proc~esmf_utilcreatecscoordspar->proc~direct_transform proc~esmf_gridcreatecubedsphereireg ESMF_GridCreateCubedSphereIReg proc~esmf_gridcreatecubedsphereireg->proc~esmf_utilcreatecscoordspar proc~esmf_gridcreatecubedspherereg ESMF_GridCreateCubedSphereReg proc~esmf_gridcreatecubedspherereg->proc~esmf_utilcreatecscoordspar proc~esmf_meshcreatecubedsphere ESMF_MeshCreateCubedSphere proc~esmf_meshcreatecubedsphere->proc~esmf_utilcreatecscoords interface~esmf_gridcreatecubedsphere ESMF_GridCreateCubedSphere interface~esmf_gridcreatecubedsphere->proc~esmf_gridcreatecubedsphereireg interface~esmf_gridcreatecubedsphere->proc~esmf_gridcreatecubedspherereg proc~test_bilinear_regrid_csmesh test_bilinear_regrid_csmesh proc~test_bilinear_regrid_csmesh->proc~esmf_meshcreatecubedsphere proc~test_conserve_regrid_csmesh test_conserve_regrid_csmesh proc~test_conserve_regrid_csmesh->proc~esmf_meshcreatecubedsphere proc~test_nearest_regrid_csmesh test_nearest_regrid_csmesh proc~test_nearest_regrid_csmesh->proc~esmf_meshcreatecubedsphere proc~test_nearest_regrid_csmesh->interface~esmf_gridcreatecubedsphere proc~test_patch_regrid_csmesh test_patch_regrid_csmesh proc~test_patch_regrid_csmesh->proc~esmf_meshcreatecubedsphere program~esmf_meshex ESMF_MeshEx program~esmf_meshex->proc~esmf_meshcreatecubedsphere proc~createfields createFields proc~createfields->interface~esmf_gridcreatecubedsphere proc~f_esmf_gridcreatecubedsphere f_esmf_gridcreatecubedsphere proc~f_esmf_gridcreatecubedsphere->interface~esmf_gridcreatecubedsphere proc~iocomputestsetup IOCompUTestSetup proc~iocomputestsetup->interface~esmf_gridcreatecubedsphere proc~test_bilinear_regrid_csgrid test_bilinear_regrid_csgrid proc~test_bilinear_regrid_csgrid->interface~esmf_gridcreatecubedsphere proc~test_bilinear_regrid_csgrid_sph_rad test_bilinear_regrid_csgrid_sph_rad proc~test_bilinear_regrid_csgrid_sph_rad->interface~esmf_gridcreatecubedsphere proc~test_conserve_regrid_csgrid test_conserve_regrid_csgrid proc~test_conserve_regrid_csgrid->interface~esmf_gridcreatecubedsphere proc~test_csgridtogrid test_CSGridToGrid proc~test_csgridtogrid->interface~esmf_gridcreatecubedsphere proc~test_csgridtogrid_2nd test_CSGridToGrid_2nd proc~test_csgridtogrid_2nd->interface~esmf_gridcreatecubedsphere proc~test_csgridtogridwmasks test_CSGridToGridWMasks proc~test_csgridtogridwmasks->interface~esmf_gridcreatecubedsphere proc~test_mesh_dual_w_bilinear test_mesh_dual_w_bilinear proc~test_mesh_dual_w_bilinear->interface~esmf_gridcreatecubedsphere proc~test_nearest_regrid_csgrid test_nearest_regrid_csgrid proc~test_nearest_regrid_csgrid->interface~esmf_gridcreatecubedsphere proc~test_patch_regrid_csgrid test_patch_regrid_csgrid proc~test_patch_regrid_csgrid->interface~esmf_gridcreatecubedsphere proc~test_sph_vec_blnr_csg_to_llg test_sph_vec_blnr_csG_to_llG proc~test_sph_vec_blnr_csg_to_llg->interface~esmf_gridcreatecubedsphere proc~test_sph_vec_blnr_csg_to_llg_p test_sph_vec_blnr_csG_to_llG_p proc~test_sph_vec_blnr_csg_to_llg_p->interface~esmf_gridcreatecubedsphere program~esmf_gridcreateex ESMF_GridCreateEx program~esmf_gridcreateex->interface~esmf_gridcreatecubedsphere program~esmf_gridcreateutest ESMF_GridCreateUTest program~esmf_gridcreateutest->interface~esmf_gridcreatecubedsphere

Source Code

  subroutine direct_transform(stretch_factor, lon_p, lat_p, lon, lat)
    real(ESMF_KIND_R8),    intent(in):: stretch_factor !< Stretching factor
    real(ESMF_KIND_R8),    intent(in):: lon_p, lat_p   !< center location of the target face, radian
!  0 <= lon <= 2*pi ;    -pi/2 <= lat <= pi/2
    real(ESMF_KIND_R8), intent(inout) :: lon(:,:), lat(:,:)
!
    real(ESMF_KIND_R8)  :: lat_t, sin_p, cos_p, sin_lat, cos_lat, sin_o, p2, two_pi
    real(ESMF_KIND_R8)  :: c2p1, c2m1
    integer:: i, j

    p2 = 0.5d0*pi
    two_pi = 2.d0*pi

    c2p1 = 1.d0 + stretch_factor*stretch_factor
    c2m1 = 1.d0 - stretch_factor*stretch_factor

    sin_p = sin(lat_p)
    cos_p = cos(lat_p)

    do j=1,size(lon,2)
       do i=1,size(lon,1)
          if ( abs(c2m1) > 1.d-7 ) then
               sin_lat = sin(lat(i,j))
               lat_t = asin( (c2m1+c2p1*sin_lat)/(c2p1+c2m1*sin_lat) )
          else         ! no stretching
               lat_t = lat(i,j)
          endif
          sin_lat = sin(lat_t)
          cos_lat = cos(lat_t)
            sin_o = -(sin_p*sin_lat + cos_p*cos_lat*cos(lon(i,j)))
          if ( (1.-abs(sin_o)) < 1.d-7 ) then    ! poles
               lon(i,j) = 0.d0
               lat(i,j) = sign( p2, sin_o )
          else
               lat(i,j) = asin( sin_o )
               lon(i,j) = lon_p + atan2( -cos_lat*sin(lon(i,j)),   &
                          -sin_lat*cos_p+cos_lat*sin_p*cos(lon(i,j)))
               if ( lon(i,j) < 0.d0 ) then
                    lon(i,j) = lon(i,j) + two_pi
               elseif( lon(i,j) >= two_pi ) then
                    lon(i,j) = lon(i,j) - two_pi
               endif
          endif
       enddo
    enddo

  end subroutine direct_transform