!-------------------------------------- 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 -------------------------------------- ! #include "model_macros_f.h"! !**s/r wind_rot2ll - transform (rotate) U/V from grid winds to E-W/N-S
SUBROUTINE wind_rot2ll(uu,vv,lon,lat,nbpts) 1 IMPLICIT NONE ! INTEGER, INTENT(IN) :: nbpts REAL,DIMENSION(nbpts) :: uu,vv,lon,lat !author ! Stephane Chamberland - rpn - Feb 2006 ! !revision * v3_30 - Chamberland - Initial version * v3_31 - Chamberland&Desgagne - Multiple fix ! !arguments ! Name I/O Description !---------------------------------------------------------------- ! uull O - wind's W-E component ! vvll O - wind's S-N component ! uurot I - wind's X component (on model grid) ! vvrot I - wind's Y component (on model grid) ! lon I - grid point's Longitude ! lat I - grid point's Latitude ! nbpts I - number of points !---------------------------------------------------------------- ! !implicits #include "grd.cdk"
! INTEGER :: ii,jj REAL,DIMENSION(3,3) :: rr,ri REAL,DIMENSION(3,nbpts) :: xyz,uvcart REAL,DIMENSION(nbpts) :: lon_rot, lat_rot, uull, vvll ! !---------------------------------------------------------------- ! CALL ez_gfxyfll(lon,lat,lon_rot,lat_rot,nbpts, Grd_xlat1,Grd_xlon1,Grd_xlat2,Grd_xlon2) CALL ez_crot(rr, ri, Grd_xlon1,Grd_xlat1,Grd_xlon2,Grd_xlat2) CALL ez_uvacart(xyz,uu,vv,lon_rot,lat_rot,nbpts,1) CALL mxm(ri, 3, xyz, 3, uvcart, nbpts) CALL ez_cartauv(uull, vvll, uvcart, lon, lat, nbpts, 1) uu = uull vv = vvll ! !---------------------------------------------------------------- RETURN END SUBROUTINE wind_rot2ll !**s/r wind_ll2rot - transform (rotate) U/V from E-W/N-S to grid winds
SUBROUTINE wind_ll2rot(uurot,vvrot,uull,vvll,lon,lat,nbpts) IMPLICIT NONE ! INTEGER, INTENT(IN) :: nbpts REAL,DIMENSION(nbpts), INTENT(OUT) :: uurot,vvrot REAL,DIMENSION(nbpts), INTENT(IN) :: uull,vvll,lon,lat !author ! Stephane Chamberland - rpn - Feb 2006 ! !revision ! Stephane Chamberland - rpn - Feb 2006 ! !arguments ! Name I/O Description !---------------------------------------------------------------- ! uurot O - wind's X component (on model grid) ! vvrot O - wind's Y component (on model grid) ! uull I - wind's W-E component ! vvll I - wind's S-N component ! lon I - grid point's Longitude ! lat I - grid point's Latitude ! nbpts I - number of points !---------------------------------------------------------------- ! !implicits #include "grd.cdk"
!* INTEGER :: ii,jj REAL,DIMENSION(3,nbpts) :: xyz,uvcart REAL,DIMENSION(nbpts) :: lon_rot, lat_rot,lond,latd REAL,DIMENSION(3,3) :: rr,ri real*8 CLXXX_8, rad2deg_8, my_pi_8 parameter( CLXXX_8 = 180.0 ) parameter( my_pi_8 = 0.3141592653590E+01 ) !---------------------------------------------------------------- ! rad2deg_8 = CLXXX_8/my_pi_8 DO ii=1,nbpts lond(ii)=real(DBLE(lon(ii))*rad2deg_8) latd(ii)=real(DBLE(lat(ii))*rad2deg_8) END DO CALL ez_gfxyfll(lond,latd,lon_rot,lat_rot,nbpts, $ Grd_xlat1,Grd_xlon1,Grd_xlat2,Grd_xlon2) ! DO ii=1,3 ! DO jj=1,3 ! rr(ii,jj) = real(Grd_rot_8(ii,jj)) ! END DO ! END DO CALL ez_crot(rr, ri, Grd_xlon1,Grd_xlat1,Grd_xlon2,Grd_xlat2) CALL ez_uvacart(xyz, uurot, vvrot, lond, latd, nbpts, 1) CALL mxm(rr, 3, xyz, 3, uvcart, nbpts) CALL ez_cartauv(uull, vvll, uvcart, lon_rot, lat_rot, nbpts, 1) ! !---------------------------------------------------------------- RETURN END SUBROUTINE wind_ll2rot