#include <misc.h>#include <params.h>subroutine extys(pkcnst  ,pkdim   ,fb      ,kloop)!----------------------------------------------------------------------- ! ! Purpose: ! Fill latitude extensions of a scalar extended array and! Copy data to the longitude extensions of the extended array! ! Method: ! This is done in 2 steps:!   1) interpolate to the pole points; use the mean field value on the!      Gaussian latitude closest to the pole.!   2) add latitude lines beyond the poles.! ! Author: J. Olson! !-----------------------------------------------------------------------!! $Id: extys.F90,v 1.1.2.2 2002/05/13 17:56:06 erik Exp $! $Author: erik $!!-----------------------------------------------------------------------  use precision  use pmgrid  use rgrid  implicit none!------------------------------Parameters-------------------------------  integer, parameter :: istart = nxpt+1           ! index to start computation  integer, parameter :: js = 1    + nxpt + jintmx ! index of southernmost model lat  integer, parameter :: jn = plat + nxpt + jintmx ! index of northernmost model lat!-----------------------------------------------------------------------!------------------------------Arguments--------------------------------  integer , intent(in) :: pkcnst   ! dimensioning construct for 3-D arrays  integer , intent(in) :: pkdim    ! vertical dimension  real(r8), intent(inout) :: fb(plond,pkdim*pkcnst,beglatex:endlatex) ! Output is same as on entry                           !except with the pole latitude and extensions beyond it filled.  integer, intent(in) :: kloop ! If you want to limit the extent of looping over pcnst!-----------------------------------------------------------------------!---------------------------Local variables-----------------------------  integer i,j,k             ! indices  integer istop             ! index to stop  computation  integer nlon2             ! half the number of real longitudes  real(r8) zave             ! accumulator for zonal averaging  integer pk                ! dimension to loop over!-----------------------------------------------------------------------!! Fill north pole line.!  pk = pkdim*kloop#if ( defined SPMD )  if (jn+1<=endlatex) then#endif     do k=1,pkdim*pkcnst        zave = 0.0        istop  = nxpt + nlonex(jn)        do i=istart,istop           zave = zave + fb(i,k,jn  )        end do        zave = zave/nlonex(jn)        istop  = nxpt + nlonex(jn+1)        do i=istart,istop           fb(i,k,jn+1) = zave        end do     end do#if ( defined SPMD )  end if#endif!! Fill northern lines beyond pole line.!  if( jn+2 <= platd )then     do j=jn+2,platd#if ( defined SPMD )        if (j<=endlatex) then#endif           nlon2 = nlonex(j)/2           do k=1,pk!CDIR$ IVDEP              do i=istart,istart+nlon2-1                 fb(      i,k,j) = fb(nlon2+i,k,2*jn+2-j)                 fb(nlon2+i,k,j) = fb(      i,k,2*jn+2-j)              end do           end do#if ( defined SPMD )        end if#endif     end do  end if!! Fill south pole line.!#if ( defined SPMD )  if (js-1>=beglatex) then#endif     do k=1,pk        zave = 0.0        istop  = nxpt + nlonex(js)        do i = istart,istop           zave = zave + fb(i,k,js  )        end do        zave = zave/nlonex(js)        istop  = nxpt + nlonex(js-1)        do i=istart,istop           fb(i,k,js-1) = zave        end do     end do#if ( defined SPMD )  end if#endif!! Fill southern lines beyond pole line.!  if( js-2 >= 1 )then     do j=1,js-2#if ( defined SPMD )        if (j>=beglatex) then#endif           nlon2 = nlonex(j)/2           do k=1,pk!CDIR$ IVDEP              do i=istart,istart+nlon2-1                 fb(      i,k,j) = fb(nlon2+i,k,2*js-2-j)                 fb(nlon2+i,k,j) = fb(      i,k,2*js-2-j)              end do           end do#if ( defined SPMD )        end if#endif     end do  end if  returnend subroutine extys