!-------------------------------------- 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_trajsp - improves estimates of upwind positions
*
#include "model_macros_f.h"
*
subroutine adw_trajsp ( F_lon, F_lat, F_x, F_y, F_z, 5
% F_u, F_v, F_dt,i0,in,j0,jn)
*
implicit none
*
real F_lon(*),F_lat(*),F_x(*),F_y(*),F_z(*),F_u(*),F_v(*),F_dt
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_lon | upwind longitudes at central time | o |
* F_lat | upwind latitudes at central time | o |
* F_x | upwind x cartesian positions at central time | o |
* F_y | upwind y cartesian positions at central time | o |
* F_z | upwind z cartesian positions at central time | o |
* F_u | real E-W wind components at upwind positions | i |
* F_v | real N-S wind components at upwind positions | i |
* F_dt | timestep lenght | i |
*______________|_________________________________________________|_____|
*
*implicits
#include "glb_ld.cdk"
#include "adw.cdk"
#include "dcst.cdk"
************************************************************************
integer n, ij, nij,vnij, i,j,k
*
real*8 pdsa, pdca, pdcai, pdso, pdco, pdx, pdy, pdz,
% pdux, pduy, pduz, pdsinal, pdcosal, r2pi_8, two
real*8 xcos(i0:in,j0:jn), ycos(i0:in,j0:jn)
real*8 xsin(i0:in,j0:jn), ysin(i0:in,j0:jn)
real*8 yrec(i0:in,j0:jn)
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 ( 33, 'adw_trajsp' )
!$omp parallel do private(ysin,ycos,yrec,xasin,xatan,yatan,
!$omp& zatan,yasin,xsin,xcos, n,ij,pdx,pdy,pdz,pdsa,pdca,
!$omp& pdcai,pdso,pdco,pdux,pduy,pduz,pdsinal,pdcosal)
do k=1,l_nk
do j=j0,jn
do i=i0,in
n = (k-1)*nij + ((j-1)*l_ni) + i
xcos(i,j) = F_lat(n)
xsin(i,j) = sqrt( F_u(n) ** 2 + F_v(n) ** 2 ) * F_dt
end do
end do
call vsin(ysin, xsin, vnij)
call vcos(ycos, xcos, vnij)
call vrec(yrec, ycos, vnij)
do j=j0,jn
do i=i0,in
n = (k-1)*nij + ((j-1)*l_ni) + i
ij = mod( n-1, nij ) + 1
************************************************************************
* cartesian coordinates of grid points *
************************************************************************
pdx = Adw_cx2d_8(ij)
pdy = Adw_sx2d_8(ij)
pdz = Adw_sy2d_8(ij)
************************************************************************
* if very small wind set upwind point to grid point *
************************************************************************
if ( abs(F_u(n))+abs(F_v(n)) .lt. 1.e-10 ) go to 99
*
pdx = pdx * Adw_cy2d_8(ij)
pdy = pdy * Adw_cy2d_8(ij)
************************************************************************
* sin and cosin of first guess of upwind positions *
************************************************************************
pdsa = F_z(n)
pdca = ycos(i,j)
pdcai = yrec(i,j)
pdso = F_y(n) * pdcai
pdco = F_x(n) * pdcai
************************************************************************
* wind components in cartesian coordinate at upwind positions *
************************************************************************
pdux = ( - F_u(n) * pdso - F_v(n) * pdco * pdsa )
pduy = ( F_u(n) * pdco - F_v(n) * pdso * pdsa )
pduz = F_v(n) * pdca
*
pdsinal = pdx * pdux + pdy * pduy + pdz * pduz
pdux = pdux - pdx * pdsinal
pduy = pduy - pdy * pdsinal
pduz = pduz - pdz * pdsinal
pdcosal = sqrt( ( 1.0 + ysin(i,j) ) * ( 1.0 - ysin(i,j) ) )
pdsinal = ysin(i,j) /
% sqrt( pdux * pdux + pduy * pduy + pduz * pduz )
*
F_x(n) = pdcosal * pdx - pdsinal * pdux
F_y(n) = pdcosal * pdy - pdsinal * pduy
F_z(n) = pdcosal * pdz - pdsinal * pduz
99 F_z(n) = min(1.0D0,max(1.0d0*F_z(n),-1.0D0))
*
xasin(i,j) = F_z(n)
xatan(i,j) = F_x(n)
yatan(i,j) = F_y(n)
*
enddo
enddo
*
call vasin ( yasin, xasin, vnij )
call vatan2 ( zatan, yatan, xatan, vnij )
*
do j=j0,jn
do i=i0,in
n = (k-1)*nij + ((j-1)*l_ni) + i
F_lat(n) = yasin(i,j)
F_lon(n) = zatan(i,j)
if ( F_lon(n) .lt. 0.0 ) F_lon(n) = F_lon(n) + r2pi_8
end do
end do
enddo
!$omp end parallel do
*
C call tmg_stop (33)
return
end