! $Id: ropp_pp_wopt_window.f90 r4887 2016-05-25 15:48:28Z sti $

!****s* WaveOpticsPropagator/ropp_pp_wopt_window *
!
! NAME
!   ropp_pp_wopt_window
!
! SYNOPSIS
!   CALL ropp_pp_wopt_window(x, y, rad, ymax, U)
!
! DESCRIPTION
!   This routine 'apodizes' the signal U by multiplying it by
!   a Gaussian decay envelope below y_bot and above y_top.
!
! REFERENCES
!   Description of wave optics modelling in ROPP-9 and suggested
!   improvements for ROPP-9.1, S. B. Healy, ROM SAF Report 28,
!   SAF/ROM/ECMWF/REP/RSR/028
!
! AUTHOR
!   ECMWF, Reading, UK.
!   Any comments on this software should be given via the ROM SAF
!   Helpdesk at http://www.romsaf.org
!
! COPYRIGHT
!   (c) EUMETSAT. All rights reserved.
!   For further details please refer to the file COPYRIGHT
!   which you should have received as part of this distribution.
!
!****

SUBROUTINE ropp_pp_wopt_window(x, y, rad, ymax, U)

  USE typesizes, ONLY: wp => EightByteReal

  IMPLICIT NONE

! Input/output
  REAL(wp), INTENT(IN)        :: x, rad, ymax
  REAL(wp), INTENT(IN)        :: y(:)
  COMPLEX(wp), INTENT(INOUT)  :: U(:)

! Local variables
  INTEGER                     :: i
  REAL(wp), PARAMETER         :: width = 0.5e3_wp
  REAL(wp)                    :: y_shift, y_top, y_bot

  y_top = ymax - width

  y_shift = rad * (SQRT(1.0_wp - (x/rad)**2) - 1.0_wp)

  y_bot = y_shift

  DO i = 1, SIZE(y)

    IF (y(i) <= y_bot) THEN

      U(i) = U(i) * EXP(-(1.0_wp*(y(i)-y_bot)/width)**2)

    ELSE IF (y(i) >= y_top) THEN

      U(i) = U(i) * EXP(-(1.0_wp*(y(i)-y_top)/width)**2)

    END IF

  END DO

END SUBROUTINE ropp_pp_wopt_window