!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer, 
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms 
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer 
!version 3 or (at your option) any later version that should be found at: 
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html 
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software; 
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), 
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r adw_trajex - compute positions at origin (o) by 
*                   extrapolation using positions at 
*                   mid-trajectory (m)
*
#include "model_macros_f.h"
*

      subroutine adw_trajex ( F_xto,  F_yto,  F_xcto, F_ycto, 5
     %                        F_zcto, F_xctm, F_yctm, F_zctm,i0,in,j0,jn)
*
#include "impnone.cdk"
*
      real   F_xto (*), F_yto (*), F_xcto(*), F_ycto(*),
     %       F_zcto(*), F_xctm(*), F_yctm(*), F_zctm(*)
      integer i0,in,j0,jn
*
*author
*     alain patoine
*
*revision
* v3_00 - Desgagne & Lee    - Lam configuration
* v3_10 - Corbeil & Desgagne & Lee - AIXport+Opti+OpenMP
*
*object
*     see id section
*
*arguments
*______________________________________________________________________
*              |                                                 |     |
* NAME         | DESCRIPTION                                     | I/O |
*--------------|-------------------------------------------------|-----|
*              |                                                 |     |
* F_xto        | upstream x positions at origin                  |  o  |
* F_yto        | upstream y positions at origin                  |  o  |
* F_xcto       | upstream x cartesian positions at origin        |  o  |
* F_ycto       | upstream y cartesian positions at origin        |  o  |
* F_zcto       | upstream z cartesian positions at origin        |  o  |
* F_xctm       | upstream x cartesian positions at mid-traj.     |  i  |
* F_yctm       | upstream y cartesian positions at mid-traj.     |  i  |
* F_zctm       | upstream z cartesian positions at mid-traj.     |  i  |
*______________|_________________________________________________|_____|
*
*implicits
#include "glb_ld.cdk"
#include "adw.cdk"
#include "dcst.cdk"
************************************************************************
      integer i,j,k, n, ij, nij, vnij
*
      real*8 prx, pry, prz, prdot2, r2pi_8, two
      real*8 xasin(i0:in,j0:jn), yasin(i0:in,j0:jn)
      real*8 xatan(i0:in,j0:jn), yatan(i0:in,j0:jn), zatan(i0:in,j0:jn)
*
      parameter (two = 2.0)
************************************************************************
      nij  = l_ni*l_nj
      vnij = (in-i0+1)*(jn-j0+1)
*
      r2pi_8 = two * Dcst_pi_8
C     call tmg_start ( 34, 'adw_trajex' )
************************************************************************
!$omp parallel private(xasin,yasin,xatan,yatan,zatan,n,ij,prx,pry,prz,
!$omp& prdot2)
!$omp do
      do k=1,l_nk
         do j=j0,jn
         do i=i0,in
*
              n = (k-1)*nij+((j-1)*l_ni) + i
             ij = mod( n-1, nij ) + 1
            pry = dble(Adw_cy2d_8(ij))
            prx = dble(Adw_cx2d_8(ij)) * pry
            pry = dble(Adw_sx2d_8(ij)) * pry
            prz = dble(Adw_sy2d_8(ij))
*
            prdot2 = 2.0 * ( prx * dble(F_xctm(n)) +
     %                       pry * dble(F_yctm(n)) +
     %                       prz * dble(F_zctm(n)) )
*
            F_xcto(n) = prdot2 * dble(F_xctm(n)) - prx
            F_ycto(n) = prdot2 * dble(F_yctm(n)) - pry
            F_zcto(n) = prdot2 * dble(F_zctm(n)) - prz
*
            xatan(i,j) = F_xcto(n)
            yatan(i,j) = F_ycto(n)
            xasin(i,j) = max(-1.,min(1.,F_zcto(n)))
*
         enddo
         enddo
*
         call vatan2(zatan, yatan, xatan, vnij)
         call vasin(yasin, xasin, vnij)
*
         do j=j0,jn
         do i=i0,in
             n = (k-1)*nij+((j-1)*l_ni) + i
            F_xto(n) = zatan(i,j)
            F_yto(n) = yasin(i,j)
            if ( F_xto(n) .lt. 0.0 ) F_xto(n) = F_xto(n) + r2pi_8
         enddo
         enddo
      enddo
!$omp enddo
!$omp end parallel
*
C     call tmg_stop (34)
      return
      end