!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
! ... file sshifte.f contains code and documentation for subroutine sshifte
!     and its' initialization subroutine sshifti
!
! ... required files off spherepack3.0
!
!     hrfft.f
!
!     subroutine sshifte(ioff,nlon,nlat,goff,greg,wsav,lsav,work,lwork,ier)
!
! *** purpose
!
!     subroutine sshifte does a highly accurate 1/2 grid increment shift
!     in both longitude and latitude of equally spaced data on the sphere.
!     data is transferred between the nlon by nlat "offset grid" in goff
!     (which excludes poles) and the nlon by nlat+1 "regular grid" in greg
!     (which includes poles).  the transfer can go from goff to greg or from
!     greg to goff (see ioff).  the grids which underly goff and greg are
!     described below.  the north and south poles are at latitude 0.5*pi and
!     -0.5*pi radians respectively where pi = 4.*atan(1.).
!
! *** grid descriptions
!
!     let dlon = (pi+pi)/nlon and dlat = pi/nlat be the uniform grid
!     increments in longitude and latitude
!
!     offset grid
!
!     the "1/2 increment offset" grid (long(j),lat(i)) on which goff(j,i)
!     is given (ioff=0) or generated (ioff=1) is
!
!          long(j) =0.5*dlon + (j-1)*dlon  (j=1,...,nlon)
!
!     and
!
!          lat(i) = -0.5*pi + 0.5*dlat + (i-1)*dlat (i=1,...,nlat)
!
!     the data in goff is "shifted" one half a grid increment in longitude
!     and latitude and excludes the poles.  each goff(j,1) is given at
!     latitude -0.5*pi+0.5*dlat and goff(j,nlat) is given at 0.5*pi-0.5*dlat
!     (1/2 a grid increment away from the poles).  each goff(1,i),goff(nlon,i)
!     is given at longitude 0.5*dlon and 2.*pi-0.5*dlon.
!
!     regular grid
!
!     let dlat,dlon be as above.  then the nlon by nlat+1 grid on which
!     greg(j,i) is generated (ioff=0) or given (ioff=1) is given by
!
!          lone(j) = (j-1)*dlon (j=1,...,nlon)
!
!      and
!
!          late(i) = -0.5*pi + (i-1)*dlat (i=1,...,nlat+1)
!
!     values in greg include the poles and start at zero degrees longitude.
!
! *** remark
!
!     subroutine sshifte can be used in conjunction with subroutine trssph
!     when transferring data from an equally spaced "1/2 increment offset"
!     grid to a gaussian or equally spaced grid (which includes poles) of
!     any resolution.  this problem (personal communication with dennis
!     shea) is encountered in geophysical modeling and data analysis.
!
! *** method
!
!     fast fourier transform software from spherepack2 and trigonometric
!     identities are used to accurately "shift" periodic vectors half a
!     grid increment in latitude and longitude.  latitudinal shifts are
!     accomplished by setting periodic 2*nlat vectors over the pole for each
!     longitude.  when nlon is odd, this requires an additional longitude
!     shift.  longitudinal shifts are then executed for each shifted latitude.
!     when necessary (ioff=0) poles are obtained by averaging the nlon
!     shifted polar values.
!
! *** required files from spherepack3.0
!
!     hrfft.f
!
! *** argument description
!
! ... ioff
!
!     ioff = 0 if values on the offset grid in goff are given and values
!              on the regular grid in greg are to be generated.
!
!     ioff = 1 if values on the regular grid in greg are given and values
!              on the offset grid in goff are to be generated.
!
! ... nlon
!
!     the number of longitude points on both the "offset" and "regular"
!     uniform grid in longitude (see "grid description" above).  nlon
!     is also the first dimension of array goff and greg.  nlon determines
!     the grid increment in longitude as dlon = 2.*pi/nlon.  for example,
!     nlon = 144 for a 2.5 degree grid.  nlon can be even or odd and must
!     be greater than or equal to 4.  the efficiency of the computation
!     is improved when nlon is a product of small primes.
!
! ... nlat
!
!     the number of latitude points on the "offset" uniform grid.  nlat+1
!     is the number of latitude points on the "regular" uniform grid (see
!     "grid description" above).  nlat is the second dimension of array goff.
!     nlat+1 must be the second dimension of the array greg in the program
!     calling sshifte.  nlat determines the grid in latitude as pi/nlat.
!     for example, nlat = 36 for a five degree grid.  nlat must be at least 3.
!
! ... goff
!
!     a nlon by nlat array that contains data on the offset grid
!     described above.  goff is a given input argument if ioff=0.
!     goff is a generated output argument if ioff=1.
!
! ... greg
!
!     a nlon by nlat+1 array that contains data on the regular grid
!     described above.  greg is a given input argument if ioff=1.
!     greg is a generated output argument if ioff=0.
!
! ... wsav
!
!     a real saved work space array that must be initialized by calling
!     subroutine sshifti(ioff,nlon,nlat,wsav,ier) before calling sshifte.
!     wsav can then be used repeatedly by sshifte as long as ioff, nlon,
!     and nlat do not change.  this bypasses redundant computations and
!     saves time.  undetectable errors will result if sshifte is called
!     without initializing wsav whenever ioff, nlon, or nlat change.
!
! ... lsav
!
!     the length of the saved work space wsav in the routine calling sshifte
!     and sshifti.  lsave must be greater than or equal to 2*(2*nlat+nlon+16).
!
! ... work
!
!     a real unsaved work space
!
! ... lwork
!
!     the length of the unsaved work space in the routine calling sshifte
!     lwork must be greater than or equal to 2*nlon*(nlat+1) if nlon is even.
!     lwork must be greater than or equal to nlon*(5*nlat+1) if nlon is odd.
!
! ... ier
!
!     indicates errors in input parameters
!
!     = 0 if no errors are detected
!
!     = 1 if ioff is not equal to 0 or 1
!
!     = 1 if nlon < 4
!
!     = 2 if nlat < 3
!
!     = 3 if lsave < 2*(nlon+2*nlat+16)
!
!     = 4 if lwork < 2*nlon*(nlat+1) for nlon even or
!            lwork < nlon*(5*nlat+1) for nlon odd
!
! *** end of sshifte documentation
!
!     subroutine sshifti(ioff,nlon,nlat,lsav,wsav,ier)
!
!     subroutine sshifti initializes the saved work space wsav
!     for ioff and nlon and nlat (see documentation for sshifte).
!     sshifti must be called before sshifte whenever ioff or nlon
!     or nlat change.
!
! ... ier
!
!     = 0 if no errors with input arguments
!
!     = 1 if ioff is not 0 or 1
!
!     = 2 if nlon < 4
!
!     = 3 if nlat < 3
!
!     = 4 if lsav < 2*(2*nlat+nlon+16)
!
! *** end of sshifti documentation
!
      SUBROUTINE SSHIFTE(Ioff,Nlon,Nlat,Goff,Greg,Wsav,Lsav,Wrk,Lwrk,   &
                       & Ier)
      IMPLICIT NONE
!*--SSHIFTE203
      INTEGER Ioff , Nlon , Nlat , n2 , nr , nlat2 , nlatp1 , Lsav ,    &
            & Lwrk , i1 , i2 , Ier
      REAL Goff(Nlon,Nlat) , Greg(Nlon,*) , Wsav(Lsav) , Wrk(Lwrk)
!
!     check input parameters
!
      Ier = 1
      IF ( Ioff*(Ioff-1)/=0 ) RETURN
      Ier = 2
      IF ( Nlon<4 ) RETURN
      Ier = 3
      IF ( Nlat<3 ) RETURN
      Ier = 4
      IF ( Lsav<2*(2*Nlat+Nlon+16) ) RETURN
      Ier = 5
      n2 = (Nlon+1)/2
      IF ( 2*n2==Nlon ) THEN
         IF ( Lwrk<2*Nlon*(Nlat+1) ) RETURN
         i1 = 1
         nr = n2
      ELSE
         IF ( Lwrk<Nlon*(5*Nlat+1) ) RETURN
         i1 = 1 + 2*Nlat*Nlon
         nr = Nlon
      ENDIF
      Ier = 0
      nlat2 = Nlat + Nlat
      i2 = i1 + (Nlat+1)*Nlon
      IF ( Ioff==0 ) THEN
         CALL SHFTOFF(Nlon,Nlat,Goff,Greg,Wsav,nr,nlat2,Wrk,Wrk(i1),    &
                    & Wrk(i2))
      ELSE
         nlatp1 = Nlat + 1
         CALL SHFTREG(Nlon,Nlat,Goff,Greg,Wsav,nr,nlat2,nlatp1,Wrk,     &
                    & Wrk(i1),Wrk(i2))
      ENDIF
      END SUBROUTINE SSHIFTE 

      
      SUBROUTINE SHFTOFF(Nlon,Nlat,Goff,Greg,Wsav,Nr,Nlat2,Rlat,Rlon,   &
                       & Wrk)
!
!     shift offset grid to regular grid, i.e.,
!     goff is given, greg is to be generated
!
      IMPLICIT NONE
!*--SHFTOFF250
      INTEGER Nlon , Nlat , Nlat2 , n2 , Nr , j , i , js , isav
      REAL Goff(Nlon,Nlat) , Greg(Nlon,Nlat+1)
      REAL Rlat(Nr,Nlat2) , Rlon(Nlat,Nlon)
      REAL Wsav(*) , Wrk(*)
      REAL gnorth , gsouth
      isav = 4*Nlat + 17
      n2 = (Nlon+1)/2
!
!     execute full circle latitude shifts for nlon odd or even
!
      IF ( 2*n2>Nlon ) THEN
!
!     odd number of longitudes
!
         DO i = 1 , Nlat
            DO j = 1 , Nlon
               Rlon(i,j) = Goff(j,i)
            ENDDO
         ENDDO
!
!       half shift in longitude
!
         CALL SHIFTH(Nlat,Nlon,Rlon,Wsav(isav),Wrk)
!
!       set full 2*nlat circles in rlat using shifted values in rlon
!
         DO j = 1 , n2 - 1
            js = j + n2
            DO i = 1 , Nlat
               Rlat(j,i) = Goff(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+1-i,js)
            ENDDO
         ENDDO
         DO j = n2 , Nlon
            js = j - n2 + 1
            DO i = 1 , Nlat
               Rlat(j,i) = Goff(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+1-i,js)
            ENDDO
         ENDDO
!
!       shift the nlon rlat vectors one half latitude grid
!
         CALL SHIFTH(Nlon,Nlat2,Rlat,Wsav,Wrk)
!
!       set nonpole values in greg and average for poles
!
         gnorth = 0.0
         gsouth = 0.0
         DO j = 1 , Nlon
            gnorth = gnorth + Rlat(j,1)
            gsouth = gsouth + Rlat(j,Nlat+1)
            DO i = 2 , Nlat
               Greg(j,i) = Rlat(j,i)
            ENDDO
         ENDDO
         gnorth = gnorth/Nlon
         gsouth = gsouth/Nlon
 
      ELSE
!
!     even number of longitudes (no initial longitude shift necessary)
!     set full 2*nlat circles (over poles) for each longitude pair (j,js)
!
         DO j = 1 , n2
            js = n2 + j
            DO i = 1 , Nlat
               Rlat(j,i) = Goff(j,i)
               Rlat(j,Nlat+i) = Goff(js,Nlat+1-i)
            ENDDO
         ENDDO
!
!       shift the n2=(nlon+1)/2 rlat vectors one half latitude grid
!
         CALL SHIFTH(n2,Nlat2,Rlat,Wsav,Wrk)
!
!       set nonpole values in greg and average poles
!
         gnorth = 0.0
         gsouth = 0.0
         DO j = 1 , n2
            js = n2 + j
            gnorth = gnorth + Rlat(j,1)
            gsouth = gsouth + Rlat(j,Nlat+1)
            DO i = 2 , Nlat
               Greg(j,i) = Rlat(j,i)
               Greg(js,i) = Rlat(j,Nlat2-i+2)
            ENDDO
         ENDDO
         gnorth = gnorth/n2
         gsouth = gsouth/n2
      ENDIF
!
!     set poles
!
      DO j = 1 , Nlon
         Greg(j,1) = gnorth
         Greg(j,Nlat+1) = gsouth
      ENDDO
!
!     execute full circle longitude shift
!
      DO j = 1 , Nlon
         DO i = 1 , Nlat
            Rlon(i,j) = Greg(j,i)
         ENDDO
      ENDDO
      CALL SHIFTH(Nlat,Nlon,Rlon,Wsav(isav),Wrk)
      DO j = 1 , Nlon
         DO i = 2 , Nlat
            Greg(j,i) = Rlon(i,j)
         ENDDO
      ENDDO
    END SUBROUTINE SHFTOFF
    

    SUBROUTINE SHFTREG(Nlon,Nlat,Goff,Greg,Wsav,Nr,Nlat2,Nlatp1,Rlat, &
                       & Rlon,Wrk)
!
!     shift regular grid to offset grid, i.e.,
!     greg is given, goff is to be generated
!
      IMPLICIT NONE
!*--SHFTREG374
      INTEGER Nlon , Nlat , Nlat2 , Nlatp1 , n2 , Nr , j , i , js , isav
      REAL Goff(Nlon,Nlat) , Greg(Nlon,Nlatp1)
      REAL Rlat(Nr,Nlat2) , Rlon(Nlatp1,Nlon)
      REAL Wsav(*) , Wrk(*)
      isav = 4*Nlat + 17
      n2 = (Nlon+1)/2
!
!     execute full circle latitude shifts for nlon odd or even
!
      IF ( 2*n2>Nlon ) THEN
!
!     odd number of longitudes
!
         DO i = 1 , Nlat + 1
            DO j = 1 , Nlon
               Rlon(i,j) = Greg(j,i)
            ENDDO
         ENDDO
!
!       half shift in longitude in rlon
!
         CALL SHIFTH(Nlat+1,Nlon,Rlon,Wsav(isav),Wrk)
!
!       set full 2*nlat circles in rlat using shifted values in rlon
!
         DO j = 1 , n2
            js = j + n2 - 1
            Rlat(j,1) = Greg(j,1)
            DO i = 2 , Nlat
               Rlat(j,i) = Greg(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+2-i,js)
            ENDDO
            Rlat(j,Nlat+1) = Greg(j,Nlat+1)
         ENDDO
         DO j = n2 + 1 , Nlon
            js = j - n2
            Rlat(j,1) = Greg(j,1)
            DO i = 2 , Nlat
               Rlat(j,i) = Greg(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+2-i,js)
            ENDDO
            Rlat(j,Nlat+1) = Greg(j,Nlat+1)
         ENDDO
!
!       shift the nlon rlat vectors one halflatitude grid
!
         CALL SHIFTH(Nlon,Nlat2,Rlat,Wsav,Wrk)
!
!       set values in goff
!
         DO j = 1 , Nlon
            DO i = 1 , Nlat
               Goff(j,i) = Rlat(j,i)
            ENDDO
         ENDDO
 
      ELSE
!
!     even number of longitudes (no initial longitude shift necessary)
!     set full 2*nlat circles (over poles) for each longitude pair (j,js)
!
         DO j = 1 , n2
            js = n2 + j
            Rlat(j,1) = Greg(j,1)
            DO i = 2 , Nlat
               Rlat(j,i) = Greg(j,i)
               Rlat(j,Nlat+i) = Greg(js,Nlat+2-i)
            ENDDO
            Rlat(j,Nlat+1) = Greg(j,Nlat+1)
         ENDDO
!
!       shift the n2=(nlon+1)/2 rlat vectors one half latitude grid
!
         CALL SHIFTH(n2,Nlat2,Rlat,Wsav,Wrk)
!
!       set values in goff
!
         DO j = 1 , n2
            js = n2 + j
            DO i = 1 , Nlat
               Goff(j,i) = Rlat(j,i)
               Goff(js,i) = Rlat(j,Nlat2+1-i)
            ENDDO
         ENDDO
      ENDIF
!
!     execute full circle longitude shift for all latitude circles
!
      DO j = 1 , Nlon
         DO i = 1 , Nlat
            Rlon(i,j) = Goff(j,i)
         ENDDO
      ENDDO
      CALL SHIFTH(Nlat+1,Nlon,Rlon,Wsav(isav),Wrk)
      DO j = 1 , Nlon
         DO i = 1 , Nlat
            Goff(j,i) = Rlon(i,j)
         ENDDO
      ENDDO
    END SUBROUTINE SHFTREG

    
      SUBROUTINE SSHIFTI(Ioff,Nlon,Nlat,Lsav,Wsav,Ier)
      IMPLICIT NONE
      INTEGER Lsav
      INTEGER Ioff , Nlat , Nlon , nlat2 , isav , Ier
      REAL Wsav(Lsav)
      REAL pi , dlat , dlon , dp
      Ier = 1
      IF ( Ioff*(Ioff-1)/=0 ) RETURN
      Ier = 2
      IF ( Nlon<4 ) RETURN
      Ier = 3
      IF ( Nlat<3 ) RETURN
      Ier = 4
      IF ( Lsav<2*(2*Nlat+Nlon+16) ) RETURN
      Ier = 0
      pi = 4.0*ATAN(1.0)
!
!     set lat,long increments
!
      dlat = pi/Nlat
      dlon = (pi+pi)/Nlon
!
!     initialize wsav for left or right latitude shifts
!
      IF ( Ioff==0 ) THEN
         dp = -0.5*dlat
      ELSE
         dp = 0.5*dlat
      ENDIF
      nlat2 = Nlat + Nlat
      CALL SHIFTHI(nlat2,dp,Wsav)
!
!     initialize wsav for left or right longitude shifts
!
      IF ( Ioff==0 ) THEN
         dp = -0.5*dlon
      ELSE
         dp = 0.5*dlon
      ENDIF
      isav = 4*Nlat + 17
      CALL SHIFTHI(Nlon,dp,Wsav(isav))
      END

      
      SUBROUTINE SHIFTH(M,N,R,Wsav,Work)
      IMPLICIT NONE
      INTEGER M , N , n2 , k , l
      REAL R(M,N) , Wsav(*) , Work(*) , r2km2 , r2km1
      n2 = (N+1)/2
!
!     compute fourier coefficients for r on shifted grid
!
      CALL HRFFTF(M,N,R,M,Wsav(N+2),Work)
      DO l = 1 , M
         DO k = 2 , n2
            r2km2 = R(l,k+k-2)
            r2km1 = R(l,k+k-1)
            R(l,k+k-2) = r2km2*Wsav(n2+k) - r2km1*Wsav(k)
            R(l,k+k-1) = r2km2*Wsav(k) + r2km1*Wsav(n2+k)
         ENDDO
      ENDDO
!
!     shift r with fourier synthesis and normalization
!
      CALL HRFFTB(M,N,R,M,Wsav(N+2),Work)
      DO l = 1 , M
         DO k = 1 , N
            R(l,k) = R(l,k)/N
         ENDDO
      ENDDO
    END SUBROUTINE SHIFTH
    
    SUBROUTINE SHIFTHI(N,Dp,Wsav)
!
!     initialize wsav for subroutine shifth
!
      IMPLICIT NONE
!*--SHIFTHI559
      INTEGER N , n2 , k
      REAL Wsav(*) , Dp
      n2 = (N+1)/2
      DO k = 2 , n2
         Wsav(k) = SIN((k-1)*Dp)
         Wsav(k+n2) = COS((k-1)*Dp)
      ENDDO
      CALL HRFFTI(N,Wsav(N+2))
      END SUBROUTINE SHIFTHI


      SUBROUTINE DSSHIFTE(Ioff,Nlon,Nlat,Goff,Greg,Wsav,Lsav,Wrk,Lwrk,   &
                       & Ier)
      IMPLICIT NONE
      INTEGER Ioff , Nlon , Nlat , n2 , nr , nlat2 , nlatp1 , Lsav ,    &
            & Lwrk , i1 , i2 , Ier
      DOUBLE PRECISION Goff(Nlon,Nlat) , Greg(Nlon,*) , Wsav(Lsav) , Wrk(Lwrk)
!
!     check input parameters
!
      Ier = 1
      IF ( Ioff*(Ioff-1)/=0 ) RETURN
      Ier = 2
      IF ( Nlon<4 ) RETURN
      Ier = 3
      IF ( Nlat<3 ) RETURN
      Ier = 4
      IF ( Lsav<2*(2*Nlat+Nlon+16) ) RETURN
      Ier = 5
      n2 = (Nlon+1)/2
      IF ( 2*n2==Nlon ) THEN
         IF ( Lwrk<2*Nlon*(Nlat+1) ) RETURN
         i1 = 1
         nr = n2
      ELSE
         IF ( Lwrk<Nlon*(5*Nlat+1) ) RETURN
         i1 = 1 + 2*Nlat*Nlon
         nr = Nlon
      ENDIF
      Ier = 0
      nlat2 = Nlat + Nlat
      i2 = i1 + (Nlat+1)*Nlon
      IF ( Ioff==0 ) THEN
         CALL DSHFTOFF(Nlon,Nlat,Goff,Greg,Wsav,nr,nlat2,Wrk,Wrk(i1),    &
                    & Wrk(i2))
      ELSE
         nlatp1 = Nlat + 1
         CALL DSHFTREG(Nlon,Nlat,Goff,Greg,Wsav,nr,nlat2,nlatp1,Wrk,     &
                    & Wrk(i1),Wrk(i2))
      ENDIF
      END SUBROUTINE DSSHIFTE 

      
      SUBROUTINE DSHFTOFF(Nlon,Nlat,Goff,Greg,Wsav,Nr,Nlat2,Rlat,Rlon,   &
                       & Wrk)
!
!     shift offset grid to regular grid, i.e.,
!     goff is given, greg is to be generated
!
      IMPLICIT NONE
!*--SHFTOFF250
      INTEGER Nlon , Nlat , Nlat2 , n2 , Nr , j , i , js , isav
      DOUBLE PRECISION Goff(Nlon,Nlat) , Greg(Nlon,Nlat+1)
      DOUBLE PRECISION Rlat(Nr,Nlat2) , Rlon(Nlat,Nlon)
      DOUBLE PRECISION Wsav(*) , Wrk(*)
      DOUBLE PRECISION gnorth , gsouth
      isav = 4*Nlat + 17
      n2 = (Nlon+1)/2
!
!     execute full circle latitude shifts for nlon odd or even
!
      IF ( 2*n2>Nlon ) THEN
!
!     odd number of longitudes
!
         DO i = 1 , Nlat
            DO j = 1 , Nlon
               Rlon(i,j) = Goff(j,i)
            ENDDO
         ENDDO
!
!       half shift in longitude
!
         CALL DSHIFTH(Nlat,Nlon,Rlon,Wsav(isav),Wrk)
!
!       set full 2*nlat circles in rlat using shifted values in rlon
!
         DO j = 1 , n2 - 1
            js = j + n2
            DO i = 1 , Nlat
               Rlat(j,i) = Goff(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+1-i,js)
            ENDDO
         ENDDO
         DO j = n2 , Nlon
            js = j - n2 + 1
            DO i = 1 , Nlat
               Rlat(j,i) = Goff(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+1-i,js)
            ENDDO
         ENDDO
!
!       shift the nlon rlat vectors one half latitude grid
!
         CALL DSHIFTH(Nlon,Nlat2,Rlat,Wsav,Wrk)
!
!       set nonpole values in greg and average for poles
!
         gnorth = 0.0
         gsouth = 0.0
         DO j = 1 , Nlon
            gnorth = gnorth + Rlat(j,1)
            gsouth = gsouth + Rlat(j,Nlat+1)
            DO i = 2 , Nlat
               Greg(j,i) = Rlat(j,i)
            ENDDO
         ENDDO
         gnorth = gnorth/Nlon
         gsouth = gsouth/Nlon
 
      ELSE
!
!     even number of longitudes (no initial longitude shift necessary)
!     set full 2*nlat circles (over poles) for each longitude pair (j,js)
!
         DO j = 1 , n2
            js = n2 + j
            DO i = 1 , Nlat
               Rlat(j,i) = Goff(j,i)
               Rlat(j,Nlat+i) = Goff(js,Nlat+1-i)
            ENDDO
         ENDDO
!
!       shift the n2=(nlon+1)/2 rlat vectors one half latitude grid
!
         CALL DSHIFTH(n2,Nlat2,Rlat,Wsav,Wrk)
!
!       set nonpole values in greg and average poles
!
         gnorth = 0.0
         gsouth = 0.0
         DO j = 1 , n2
            js = n2 + j
            gnorth = gnorth + Rlat(j,1)
            gsouth = gsouth + Rlat(j,Nlat+1)
            DO i = 2 , Nlat
               Greg(j,i) = Rlat(j,i)
               Greg(js,i) = Rlat(j,Nlat2-i+2)
            ENDDO
         ENDDO
         gnorth = gnorth/n2
         gsouth = gsouth/n2
      ENDIF
!
!     set poles
!
      DO j = 1 , Nlon
         Greg(j,1) = gnorth
         Greg(j,Nlat+1) = gsouth
      ENDDO
!
!     execute full circle longitude shift
!
      DO j = 1 , Nlon
         DO i = 1 , Nlat
            Rlon(i,j) = Greg(j,i)
         ENDDO
      ENDDO
      CALL DSHIFTH(Nlat,Nlon,Rlon,Wsav(isav),Wrk)
      DO j = 1 , Nlon
         DO i = 2 , Nlat
            Greg(j,i) = Rlon(i,j)
         ENDDO
      ENDDO
    END SUBROUTINE DSHFTOFF
    

    SUBROUTINE DSHFTREG(Nlon,Nlat,Goff,Greg,Wsav,Nr,Nlat2,Nlatp1,Rlat, &
                       & Rlon,Wrk)
!
!     shift regular grid to offset grid, i.e.,
!     greg is given, goff is to be generated
!
      IMPLICIT NONE
!*--SHFTREG374
      INTEGER Nlon , Nlat , Nlat2 , Nlatp1 , n2 , Nr , j , i , js , isav
      DOUBLE PRECISION Goff(Nlon,Nlat) , Greg(Nlon,Nlatp1)
      DOUBLE PRECISION Rlat(Nr,Nlat2) , Rlon(Nlatp1,Nlon)
      DOUBLE PRECISION Wsav(*) , Wrk(*)
      isav = 4*Nlat + 17
      n2 = (Nlon+1)/2
!
!     execute full circle latitude shifts for nlon odd or even
!
      IF ( 2*n2>Nlon ) THEN
!
!     odd number of longitudes
!
         DO i = 1 , Nlat + 1
            DO j = 1 , Nlon
               Rlon(i,j) = Greg(j,i)
            ENDDO
         ENDDO
!
!       half shift in longitude in rlon
!
         CALL DSHIFTH(Nlat+1,Nlon,Rlon,Wsav(isav),Wrk)
!
!       set full 2*nlat circles in rlat using shifted values in rlon
!
         DO j = 1 , n2
            js = j + n2 - 1
            Rlat(j,1) = Greg(j,1)
            DO i = 2 , Nlat
               Rlat(j,i) = Greg(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+2-i,js)
            ENDDO
            Rlat(j,Nlat+1) = Greg(j,Nlat+1)
         ENDDO
         DO j = n2 + 1 , Nlon
            js = j - n2
            Rlat(j,1) = Greg(j,1)
            DO i = 2 , Nlat
               Rlat(j,i) = Greg(j,i)
               Rlat(j,Nlat+i) = Rlon(Nlat+2-i,js)
            ENDDO
            Rlat(j,Nlat+1) = Greg(j,Nlat+1)
         ENDDO
!
!       shift the nlon rlat vectors one halflatitude grid
!
         CALL DSHIFTH(Nlon,Nlat2,Rlat,Wsav,Wrk)
!
!       set values in goff
!
         DO j = 1 , Nlon
            DO i = 1 , Nlat
               Goff(j,i) = Rlat(j,i)
            ENDDO
         ENDDO
 
      ELSE
!
!     even number of longitudes (no initial longitude shift necessary)
!     set full 2*nlat circles (over poles) for each longitude pair (j,js)
!
         DO j = 1 , n2
            js = n2 + j
            Rlat(j,1) = Greg(j,1)
            DO i = 2 , Nlat
               Rlat(j,i) = Greg(j,i)
               Rlat(j,Nlat+i) = Greg(js,Nlat+2-i)
            ENDDO
            Rlat(j,Nlat+1) = Greg(j,Nlat+1)
         ENDDO
!
!       shift the n2=(nlon+1)/2 rlat vectors one half latitude grid
!
         CALL DSHIFTH(n2,Nlat2,Rlat,Wsav,Wrk)
!
!       set values in goff
!
         DO j = 1 , n2
            js = n2 + j
            DO i = 1 , Nlat
               Goff(j,i) = Rlat(j,i)
               Goff(js,i) = Rlat(j,Nlat2+1-i)
            ENDDO
         ENDDO
      ENDIF
!
!     execute full circle longitude shift for all latitude circles
!
      DO j = 1 , Nlon
         DO i = 1 , Nlat
            Rlon(i,j) = Goff(j,i)
         ENDDO
      ENDDO
      CALL DSHIFTH(Nlat+1,Nlon,Rlon,Wsav(isav),Wrk)
      DO j = 1 , Nlon
         DO i = 1 , Nlat
            Goff(j,i) = Rlon(i,j)
         ENDDO
      ENDDO
    END SUBROUTINE DSHFTREG

    
      SUBROUTINE DSSHIFTI(Ioff,Nlon,Nlat,Lsav,Wsav,Ier)
      IMPLICIT NONE
      INTEGER Lsav
      INTEGER Ioff , Nlat , Nlon , nlat2 , isav , Ier
      DOUBLE PRECISION Wsav(Lsav)
      DOUBLE PRECISION pi , dlat , dlon , dp
      Ier = 1
      IF ( Ioff*(Ioff-1)/=0 ) RETURN
      Ier = 2
      IF ( Nlon<4 ) RETURN
      Ier = 3
      IF ( Nlat<3 ) RETURN
      Ier = 4
      IF ( Lsav<2*(2*Nlat+Nlon+16) ) RETURN
      Ier = 0
      pi = 4.0*ATAN(1.0)
!
!     set lat,long increments
!
      dlat = pi/Nlat
      dlon = (pi+pi)/Nlon
!
!     initialize wsav for left or right latitude shifts
!
      IF ( Ioff==0 ) THEN
         dp = -0.5*dlat
      ELSE
         dp = 0.5*dlat
      ENDIF
      nlat2 = Nlat + Nlat
      CALL DSHIFTHI(nlat2,dp,Wsav)
!
!     initialize wsav for left or right longitude shifts
!
      IF ( Ioff==0 ) THEN
         dp = -0.5*dlon
      ELSE
         dp = 0.5*dlon
      ENDIF
      isav = 4*Nlat + 17
      CALL DSHIFTHI(Nlon,dp,Wsav(isav))
      END SUBROUTINE DSSHIFTI

      
      SUBROUTINE DSHIFTH(M,N,R,Wsav,Work)
      IMPLICIT NONE
      INTEGER M , N , n2 , k , l
      DOUBLE PRECISION R(M,N) , Wsav(*) , Work(*) , r2km2 , r2km1
      n2 = (N+1)/2
!
!     compute fourier coefficients for r on shifted grid
!
      CALL DHRFFTF(M,N,R,M,Wsav(N+2),Work)
      DO l = 1 , M
         DO k = 2 , n2
            r2km2 = R(l,k+k-2)
            r2km1 = R(l,k+k-1)
            R(l,k+k-2) = r2km2*Wsav(n2+k) - r2km1*Wsav(k)
            R(l,k+k-1) = r2km2*Wsav(k) + r2km1*Wsav(n2+k)
         ENDDO
      ENDDO
!
!     shift r with fourier synthesis and normalization
!
      CALL DHRFFTB(M,N,R,M,Wsav(N+2),Work)
      DO l = 1 , M
         DO k = 1 , N
            R(l,k) = R(l,k)/N
         ENDDO
      ENDDO
    END SUBROUTINE DSHIFTH

    
    SUBROUTINE DSHIFTHI(N,Dp,Wsav)
!
!     initialize wsav for subroutine shifth
!
      IMPLICIT NONE
!*--SHIFTHI559
      INTEGER N , n2 , k
      DOUBLE PRECISION Wsav(*) , Dp
      n2 = (N+1)/2
      DO k = 2 , n2
         Wsav(k) = SIN((k-1)*Dp)
         Wsav(k+n2) = COS((k-1)*Dp)
      ENDDO
      CALL DHRFFTI(N,Wsav(N+2))
      END SUBROUTINE DSHIFTHI
