EnKF/EnKF-MPI-TOPAZ/TMP/m_confmap.f90

# 0 "<stdin>"
# 0 "<built-in>"
# 0 "<command-line>"


# 1 "/usr/include/stdc-predef.h" 1 3 4

# 17 "/usr/include/stdc-predef.h" 3 4











































# 2 "<command-line>" 2
# 1 "<stdin>"
# 10 "<stdin>"
module m_confmap
  implicit none

  logical :: confmap_initialised = .false.

  real :: pi_1
  real :: pi_2
  real :: deg
  real :: rad
  real :: theta_a
  real :: phi_a
  real :: theta_b
  real :: phi_b
  real :: di
  real :: dj
  complex :: imagone
  complex :: ac
  complex :: bc
  complex :: cmna
  complex :: cmnb
  real :: mu_s
  real :: psi_s
  real :: epsil
  logical :: mercator

  real :: lat_a, lon_a
  real :: lat_b, lon_b
  real :: wlim, elim
  real :: slim, nlim
  real :: mercfac
  integer :: ires, jres

contains

  ! This routine initializes constants used in the conformal mapping
  ! and must be called before the routines 'oldtonew' and 'newtoold'
  ! are called. The arguments of this routine are the locations of
  ! the two poles in the old coordiante system.
  !
  subroutine confmap_init(nx, ny)
    integer, intent(in) :: nx, ny

    real :: cx, cy, cz, theta_c, phi_c
    complex :: c, w
    logical :: ass, lold
    
    ! Read info file
    open(unit = 10, file = 'grid.info', form = 'formatted')
    read(10, *) lat_a, lon_a
    read(10, *) lat_b,lon_b
    read(10, *) wlim, elim, ires
    read(10, *) slim, nlim, jres
    read(10, *) ass
    read(10, *) ass
    read(10, *) ass
    read(10, *) mercator
    read(10, *) mercfac, lold
    close(10)
    if (ires /= nx .and. jres /= ny) then
       print *, 'initconfmap: WARNING -- the dimensions in grid.info are not'
       print *, 'initconfmap: WARNING -- consistent with nx and ny'
       print *, 'initconfmap: WARNING -- IGNORE IF RUNNING CURVIINT'
       stop '(initconfmap)'
    endif

    ! some constants
    !
    pi_1 = 3.14159265358979323846
    pi_2 = 0.5 * pi_1
    deg = 180.0 / pi_1
    rad = 1.0 / deg
    epsil = 1.0d-9

    di = (elim - wlim) / real(ires - 1)   ! delta lon'
    dj = (nlim - slim) / real(jres - 1)   ! delta lat' for spherical grid

    if (mercator) then
       dj = di
       if (lold) then
          print *, 'initconfmap: lold'
          slim = -mercfac * jres * dj
       else
          print *, 'initconfmap: not lold'
          slim = mercfac
       endif
    endif

    ! transform to spherical coordinates
    !
    theta_a = lon_a * rad
    phi_a = pi_2 - lat_a * rad
    theta_b = lon_b * rad
    phi_b = pi_2 - lat_b * rad

    ! find the angles of a vector pointing at a point located exactly
    ! between the poles
    !
    cx = cos(theta_a) * sin(phi_a) + cos(theta_b) * sin(phi_b)
    cy = sin(theta_a) * sin(phi_a) + sin(theta_b) * sin(phi_b)
    cz = cos(phi_a) + cos(phi_b)

    theta_c = atan2(cy, cx)
    phi_c = pi_2 - atan2(cz, sqrt(cx * cx + cy * cy))

    ! initialize constants used in the conformal mapping
    !
    imagone = (0.0, 1.0)
    ac = tan(0.5 * phi_a) * exp(imagone * theta_a)
    bc = tan(0.5 * phi_b) * exp(imagone * theta_b)
    c = tan(0.5 * phi_c) * exp(imagone * theta_c)
    cmna = c - ac
    cmnb = c - bc

    w = cmnb / cmna
    mu_s = atan2(aimag(w), real(w))
    psi_s = 2.0 * atan(abs(w))

    confmap_initialised = .true.
  end subroutine confmap_init

end module m_confmap