!-------------------------------------- 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 v4d_corrvec_south - Polar correction if wind interpolation near south pole,
* based on EZ_CORRVEC_AUSUD (Y.Chartier EZSCINT 2001)
*
subroutine v4d_corrvec_south (zuo,zvo,npts,zui,zvi,zuisouth,zvisouth,ax,ay,cx,cy, 1,9
% i1,i2,j1,j2,nk,jmin,jmax,ni,pxzone,pyzone,indzone,nzone,
% grtypi,degree)
*
#include "impnone.cdk"
*
integer npts,i1,i2,j1,j2,nk,jmin,jmax,ni,degree
*
real zuo(nk,npts),zvo(nk,npts),zui(i1:i2,j1:j2,nk),zvi(i1:i2,j1:j2,nk),
% zuisouth(i1:i2,nk),zvisouth(i1:i2,nk),ax(i1:i2),ay(j1:j2),
% cx(i1:i2,6),cy(j1:j2,6)
*
character*1 grtypi
*
integer nzone,indzone(nzone)
real pxzone(nzone),pyzone(nzone)
*
*author Tanguay M.
*
*revision
* v3_00 - Tanguay M. - initial MPI version
* v3_31 - Tanguay M. - Add OPENMP directives
*
*object
* see id section
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* zuo zvo O Interpolated wind fields corrected at pxzone,pyzone
* npts I Number of positions in zuo zvo
* zui zvi I Wind fields on INPUT grid
* zui zvi south I Wind fields on segment of latitude circle at south pole
* ax I X axe of INPUT grid
* ay I Y axe of INPUT grid
* cx I AX difference on INPUT grid
* cy I AY difference on INPUT grid
* i1-i2 I Dimension x in INPUT grid
* j1-j2 I Dimension y in INPUT grid
* nk I Dimension z in INPUT grid
* jmin I Lower limit j
* jmax I Higher limit j
* ni I Period if grid='G', Heart if grid = 'Z'
* pxzone I Position px near south pole where zuo,zvo are corrected
* pyzone I Position py near south pole where zuo,zvo are corrected
* indzone I Index of positions where zuo,zvo are corrected
* nzone I Number of positions pxzone,pyzone to correct
* grtypi I Type of INPUT grid
* degree I Degree of interpolation
*----------------------------------------------------------------
*
integer i,j,k,pnerr,j1x,j2x,status
*
real ay_ext(0:3),cy_ext(0:3,6)
real, allocatable, dimension(:,:,:) :: lineu,linev
real, pointer, dimension(:,:) :: corru,corrv
* _______________________________________________________________________
*
if(degree.ne.1 .and. degree.ne.3) call gefstop('v4d_corrvec_south')
* _______________________________________________________________________
*
allocate( lineu(i1:i2,4,nk), STAT=status )
allocate( linev(i1:i2,4,nk), STAT=status )
allocate( corru(nk,nzone), STAT=status )
allocate( corrv(nk,nzone), STAT=status )
*
j1x = jmin-1
j2x = jmin+2
*
!$omp parallel do
do k=1,nk
*
* Store segments of 3 last circles near south pole
* ------------------------------------------------
do j=1,3
do i=i1,i2
*
lineu(i,j+1,k) = zui(i,jmin-1+j,k)
linev(i,j+1,k) = zvi(i,jmin-1+j,k)
*
enddo
enddo
*
* Recover segment of circle at south pole
* ---------------------------------------
do i=i1,i2
lineu(i,1,k) = zuisouth(i,k)
linev(i,1,k) = zvisouth(i,k)
enddo
*
enddo
!$omp end parallel do
*
* case CUBIC
* ----------
if(degree.eq.3) then
*
ay_ext(0) = -90.
ay_ext(1) = ay(jmin )
ay_ext(2) = ay(jmin+1)
ay_ext(3) = ay(jmin+2)
*
do j=0+1,3-2
cy_ext(j,1) = 1. / (ay_ext(j ) - ay_ext(j-1))
cy_ext(j,2) = 1. / (ay_ext(j+1) - ay_ext(j-1))
cy_ext(j,3) = 1. / (ay_ext(j+1) - ay_ext(j ))
cy_ext(j,4) = 1. / (ay_ext(j+2) - ay_ext(j-1))
cy_ext(j,5) = 1. / (ay_ext(j+2) - ay_ext(j ))
cy_ext(j,6) = 1. / (ay_ext(j+2) - ay_ext(j+1))
enddo
*
if(grtypi.eq.'Z') then
call v4d_irgdint_3_nw (corru,pxzone,pyzone,nzone,ax,ay_ext,cx,cy_ext,lineu,
% i1,i2,j1x,j2x,nk,j1x,j2x)
call v4d_irgdint_3_nw (corrv,pxzone,pyzone,nzone,ax,ay_ext,cx,cy_ext,linev,
% i1,i2,j1x,j2x,nk,j1x,j2x)
endif
if(grtypi.eq.'G') then
call v4d_irgdint_3_w (corru,pxzone,pyzone,nzone,ax,ay_ext,cx,cy_ext,lineu,
% ni,j1x,j2x,nk)
call v4d_irgdint_3_w (corrv,pxzone,pyzone,nzone,ax,ay_ext,cx,cy_ext,linev,
% ni,j1x,j2x,nk)
endif
*
endif
*
* case LINEAR
* -----------
if(degree.eq.1) then
*
ay_ext(0) = -90.
ay_ext(1) = ay(jmin )
ay_ext(2) = ay(jmin+1)
ay_ext(3) = ay(jmin+2)
*
if(grtypi.eq.'Z') then
call v4d_irgdint_1_nw (corru,pxzone,pyzone,nzone,ax,ay_ext,lineu,
% i1,i2,j1x,j2x,nk,j1x,j2x)
call v4d_irgdint_1_nw (corrv,pxzone,pyzone,nzone,ax,ay_ext,linev,
% i1,i2,j1x,j2x,nk,j1x,j2x)
endif
if(grtypi.eq.'G') then
call v4d_irgdint_1_w (corru,pxzone,pyzone,nzone,ax,ay_ext,lineu,
% ni,j1x,j2x,nk)
call v4d_irgdint_1_w (corrv,pxzone,pyzone,nzone,ax,ay_ext,linev,
% ni,j1x,j2x,nk)
endif
*
endif
*
* Replace corrected zuo,zvo near south pole
* -----------------------------------------
do i = 1,nzone
*
do k=1,nk
zuo(k,indzone(i)) = corru(k,i)
zvo(k,indzone(i)) = corrv(k,i)
enddo
*
enddo
*
deallocate( lineu, STAT=status )
deallocate( linev, STAT=status )
deallocate( corru, STAT=status )
deallocate( corrv, STAT=status )
*
return
end