      SUBROUTINE GETSLP(PIK,THS,SLP)
Status: R

#include "slgcm.slgprm"
#include "slgcm.slgcon"
      DIMENSION THS(IMP3,JM), SLP(IMP3,JM), PIK(IMP3,JM)
C
      FAC = 1000.0 ** RKAP
      DO 10 I=1,IJM0M0
      IF (PHIS(I) .GT. 0.0) THEN
         SLP(I,1) = (PHIS(I) / THS(I,1)*(1.0/CP) + PIK(I,1)*PRJ(LMP1))
     *                         * FAC
      ELSE
         SLP(I,1) = PIK(I,1)
      ENDIF
   10 CONTINUE
      DO 20 I=1,IJM0M0
      SLP(I,1) = SLP(I,1) ** (1.0/RKAP)
   20 CONTINUE
C
      RETURN
      END
      SUBROUTINE INTERP(UOT,PIK,U,PSTR)
#include "slgcm.slgprm"
#include "slgcm.slgcon"
#include "slgcm.slgwrk"
C
C*********************************************************************
C*********************** ARIES   MODEL *******************************
C********************* SUBROUTINE INTERP *****************************
C********************** 30 JUNE, 1987   ******************************
C*********************************************************************
C
      PARAMETER (LMA=13+LM+LM)
C
      DIMENSION UOT(IMP3,JM,LM), PIK(IMP3,JM), U(IMP3,JM)
C
      DIMENSION PK1(IMP3,JM),    PK2(IMP3,JM)
     *,         TX1(IMP3,JM),    TX2(IMP3,JM)
      LOGICAL   LEQ1(IMP3,JM),   LEQLMM1(IMP3,JM)
C
      EQUIVALENCE (WKX(1,LMA), TX1(1,1))
     *,           (WKX(1,LMA+1), TX2(1,1))
     *,           (WKX(1,LMA+2), PK1(1,1))
     *,           (WKX(1,LMA+3), PK2(1,1))
C
C     IF (4 .GT. SCRSIZE-21) THEN
C        PRINT *, ' ALLOCATION ERROR IN P INTERP'
C        STOP
C     ENDIF
C
      PKSTR = (PSTR/P00)**RKAP
      PKMIN = 1.0E30
      PKMAX = -1.0E30
      DO 5 I=1,IJM0M0
      PKMIN = AMIN1(PKMIN,PIK(I,1))
      PKMAX = AMAX1(PKMAX,PIK(I,1))
    5 CONTINUE
c     print *,' pkmin=',pkmin,' pkmax=',pkmax
c     print *,' pik=',(pik(1,j),j=1,jm,5)
C
c     print *,' before 10 loop'
      DO 10 I=1,IJM0M0
      U(I,1) = UNDEF
   10 CONTINUE
      DO 310 L=1,LMM1
C
      IF (L.EQ.1) THEN
         DO 312 I=1,IJM0M0
         LEQ1(I,1) = .TRUE.
  312    CONTINUE
      ELSE
         DO 314 I=1,IJM0M0
         LEQ1(I,1) = .FALSE.
  314    CONTINUE
      ENDIF
C
      IF (L.EQ.LMM1) THEN
         DO 316 I=1,IJM0M0
         LEQLMM1(I,1) = .TRUE.
  316    CONTINUE
      ELSE
         DO 318 I=1,IJM0M0
         LEQLMM1(I,1) = .FALSE.
  318    CONTINUE
      ENDIF
C
c     print *,' after 318 loop l=',l
c     print *,' pkstr=',pkstr,' pkmin=',pkmin,' prh=',prh(l)
c    *,    prh(l+1), 'pkmax=',pkmax
      IF ((PKSTR .LE. PKMAX*PRH(L+1) .OR. L.EQ.LMM1 ).AND.
     *    (PKSTR .GE. PKMIN*PRH(L  ) .OR. L.EQ.1    )     ) THEN
C
         DO 400 I=1,IJM0M0
         PK1(I,1) = PIK(I,1)*PRH(L)
         PK2(I,1) = PIK(I,1)     * PRH(L+1)
         TX1(I,1) = PK1(I,1)     - PKSTR
         TX2(I,1) = PK1(I,1)     - PK2(I,1)
         TX1(I,1) = TX1(I,1)     / TX2(I,1)
         TX2(I,1) = UOT(I,1,L+1) * TX1(I,1)
         TX1(I,1) = ONE          - TX1(I,1)
         TX1(I,1) = UOT(I,1,L)   * TX1(I,1)
  400    CONTINUE
c     print *,' after 400 loop'
C
         DO 420 I=1,IJM0M0
         IF ((PKSTR.LE.PK2(I,1).OR.LEQLMM1(I,1)) .AND.
     *       (PKSTR.GE.PK1(I,1).OR.LEQ1(I,1)))
     *            U(I,1) = TX1(I,1) + TX2(I,1)
  420    CONTINUE
C
      ENDIF
310   CONTINUE
c     print *,' after 310 loop'
C
      IF (PKSTR .GE. PRJ(LMP1)*PKMIN) THEN
         DO 430 I=1,IJM0M0
         IF (PKSTR .GE. PRJ(LMP1)*PIK(I,1)) U(I,1) = UNDEF
  430    CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE INTERU(UOT,PIK,U,PSTR)
#include "slgcm.slgprm"
#include "slgcm.slgwrk"
C
C*********************************************************************
C*********************** ARIES   MODEL *******************************
C********************* SUBROUTINE INTERU *****************************
C********************** 30 JUNE, 1987   ******************************
C*********************************************************************
C
C
      DIMENSION UOT(IMP3,JM,LM), PIK(IMP3,JM)
     *,         U(IMP3,JM),      PK1(IMP3,JM)
C     EQUIVALENCE (WKX(1,1,11), PK1(1,1))
C
C     IF (1 .GT. SCRSIZE-10) THEN
C        PRINT *, ' ALLOCATION ERROR IN U INTERP'
C        STOP
C     ENDIF
      DO 10 I=1,IJM0M1
      PK1(I,1) = HALF * (PIK(I,1) + PIK(I+1,1))
   10 CONTINUE
      DO 15 I=1,IJM0M0,IMP3
      PK1(I+IMP2,1) = PK1(I+2,1)
   15 CONTINUE
      CALL INTERP(UOT,PK1,U,PSTR)
C
      RETURN
      END
      SUBROUTINE INTERV(VOT,PIK,V,PSTR)
#include "slgcm.slgprm"
#include "slgcm.slgwrk"
C
C*********************************************************************
C*********************** ARIES   MODEL *******************************
C********************* SUBROUTINE INTERV *****************************
C********************** 30 JUNE, 1987   ******************************
C*********************************************************************
C
C
      DIMENSION VOT(IMP3,JM,LM), PIK(IMP3,JM)
     *,         V(IMP3,JM),      PK1(IMP3,JM)
C     EQUIVALENCE (WKX(1,1,11), PK1(1,1))
C
C     IF (1 .GT. SCRSIZE-10) THEN
C        PRINT *, ' ALLOCATION ERROR IN V INTERP'
C        STOP
C     ENDIF
      DO 10 I=1,IJM1M0
      PK1(I,1) = HALF * (PIK(I,1)+PIK(I,2))
   10 CONTINUE
      DO 20 I=1,IMP3
      PK1(I,JM) = PK1(I,JM-1)
   20 CONTINUE
      CALL INTERP(VOT,PK1,V,PSTR)
C     DO 30 I=1,IMP3
C     V(I,1)  = UNDEF
C     V(I,JM) = UNDEF
C  30 CONTINUE
C
      RETURN
      END

