!-------------------------------------- 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_corrval_south - Polar correction if scalar interpolation near south pole,
* based on EZ_CORRVAL_AUSUD (Y.Chartier EZSCINT 2001)
*
subroutine v4d_corrval_south (zo,npts,zi,zisouth,ax,ay,cx,cy,i1,i2,j1,j2,nk, 1,5
% jmin,jmax,ni,pxzone,pyzone,indzone,nzone,grtypi,degree)
*
#include "impnone.cdk"
*
integer npts,i1,i2,j1,j2,nk,jmin,jmax,ni,degree
*
real zo(nk,npts),zi(i1:i2,j1:j2,nk),zisouth(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
*----------------------------------------------------------------
* zo O Interpolated scalar field corrected at pxzone,pyzone
* npts I Number of positions in zo
* zi I Scalar field on INPUT grid
* zisouth I Scalar field 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 zo is corrected
* pyzone I Position py near south pole where zo is corrected
* indzone I Index of positions where zo is 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(:,:,:) :: lines
real, pointer, dimension(:,:) :: corrs
* _______________________________________________________________________
*
if(degree.ne.1 .and. degree.ne.3) call gefstop('v4d_corrval_south')
* _______________________________________________________________________
*
allocate( lines(i1:i2,4,nk), STAT=status )
allocate( corrs(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
lines(i,j+1,k) = zi(i,jmin-1+j,k)
enddo
enddo
*
* Recover segment of circle at south pole
* ---------------------------------------
do i=i1,i2
lines(i,1,k) = zisouth(i,k)
enddo
*
enddo
!$omp end parallel do
*
* case CUBIC
* ----------
if(degree.eq.3) then
*
ay_ext(0) = -90.0
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 (corrs,pxzone,pyzone,nzone,ax,ay_ext,cx,cy_ext,lines,
% i1,i2,j1x,j2x,nk,j1x,j2x)
endif
if(grtypi.eq.'G') then
call v4d_irgdint_3_w (corrs,pxzone,pyzone,nzone,ax,ay_ext,cx,cy_ext,lines,
% ni,j1x,j2x,nk)
endif
*
endif
*
* case LINEAR
* -----------
if(degree.eq.1) then
*
ay_ext(0) = -90.0
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 (corrs,pxzone,pyzone,nzone,ax,ay_ext,lines,
% i1,i2,j1x,j2x,nk,j1x,j2x)
endif
if(grtypi.eq.'G') then
call v4d_irgdint_1_w (corrs,pxzone,pyzone,nzone,ax,ay_ext,lines,
% ni,j1x,j2x,nk)
endif
*
endif
*
* Replace corrected zo near south pole
* ------------------------------------
do i = 1,nzone
*
do k=1,nk
zo(k,indzone(i)) = corrs(k,i)
enddo
*
enddo
*
deallocate( lines, STAT=status )
deallocate( corrs, STAT=status )
*
return
end