!-------------------------------------- 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 vte_uv2img - convert wind components to image winds *subroutine vte_uv2img ( F_u, F_v, niu, nju, niv, njv, nk, 4 $ F_xdy_8, F_xdyv_8) #include "impnone.cdk"
integer niu, niv, nju, njv, nk real F_u(niu,nju,nk), F_v(niv,njv,nk) real*8 F_xdy_8(*),F_xdyv_8(*) * *author michel roch - rpn - june 96 * *revision * v2_30 - Corbeil L. - Renamed vte_ (e_uv2img no more called in * v2_30 gemntr), added xdy* stuff in the interface * *object * see above id * *arguments * Name I/O Description *---------------------------------------------------------------- * F_u I/O input - U wind component * output - U wind image * F_v I/O input - V wind component * output - V wind image * F_xdy_8 I latitude * F_xdyv_8 I latitude *---------------------------------------------------------------- * *implicits #include "model_macros_f.h"
#include "dcst.cdk"
* ** integer i,j,k real*8 pdsc1_8 * * ---------------------------------------------------------------- * do j=1,nju pdsc1_8 = (cos(F_xdy_8(j))) / Dcst_rayt_8 do k=1,nk do i=1,niu F_u(i,j,k) = pdsc1_8 * F_u(i,j,k) enddo enddo enddo * do j=1,njv pdsc1_8 = (cos(F_xdyv_8(j))) / Dcst_rayt_8 do k=1,nk do i=1,niv F_v(i,j,k) = pdsc1_8 * F_v(i,j,k) enddo enddo enddo * * ---------------------------------------------------------------- * return end