       subroutine sig2p

       implicit none
       include 'param_o.h'
       include 'vrbls.comm'
       include 'extra.comm'
       include 'mapot.comm'
       include 'const.h'
       include 'dynam.comm'

       integer,parameter::im_jm_nm=(im+2)*(jm+2)*nm
       real,parameter::g=9.80616,RD1=287.04,GAMMA=6.5E-3,   &
                       RGAMOG=RD1*GAMMA/G
       integer::nhold,lp,i,j,n,lsl,nn,l,lmvij,lv
       real,dimension(0:im+1,0:jm+1,nm)::tsl,qsl,fsl
       integer,dimension(0:im+1,0:jm+1,nm)::nl1x
       real,dimension(0:im+1,0:jm+1,nm)::alpetux,alpet2x,usl,vsl
       integer,dimension(im_jm_nm)::ihold,jhold,nnhold
       real::pnl1,B,fac,pu,tu,tabv,pl,tl,tabo,ahf,tblo, &
             petal,petau,alpetl,alpetu,alpet2,fact,alpet1,trf

        open(1,file='../data_out/tmpfld.dat',form='unformatted')

        lsl=lsm
        DO 310 LP=1,LSL
        NHOLD=0

        do 125 n=1,nm
        DO 125 J=1,jm
        DO 125 I=1,IM
!
        TSL(I,J,n)=-1.E6
        QSL(I,J,n)=-1.E6
        FSL(I,J,n)=-1.E6
        TRF=2.*ALSL(LP)
!
!***  LOCATE VERTICAL INDEX OF MODEL INTERFACE JUST BELOW
!***  THE PRESSURE LEVEL TO WHICH WE ARE INTERPOLATING.
!
        DO 115 L=2,LP1
	  if(i.eq.10.and.j.eq.12.and.n.eq.1)then
!	     print *,l,alpint(i,j,n,l),alsl(lp)
           endif
        IF(ALPINT(I,J,n,L).GE.ALSL(LP))THEN
          NL1X(I,J,n)=L
          NHOLD=NHOLD+1
          IHOLD(NHOLD)=I
          JHOLD(NHOLD)=J
	  nnhold(nhold)=n
          GO TO 125
        ELSEIF(ALPINT(I,J,n,LP1).LT.ALSL(LP))THEN
          NL1X(I,J,n)=LP1
          NHOLD=NHOLD+1
          IHOLD(NHOLD)=I
          JHOLD(NHOLD)=J
	  nnhold(nhold)=n
          GO TO 125
        ENDIF
  115   CONTINUE
!
  125   CONTINUE

        DO 220 NN=1,NHOLD
        I=IHOLD(NN)
        J=JHOLD(NN)
        n=nnHOLD(NN)
        PNL1=PINT(I,J,n,NL1X(I,J,n))

        IF(NL1X(I,J,n).EQ.1)THEN
!---------------------------------------------------------------------
!***  EXTRAPOLATE ABOVE THE TOPMOST MIDLAYER OF THE MODEL
!---------------------------------------------------------------------
!
        PU=PINT(I,J,n,2)
        TU=0.5*(T(I,J,n,1)+T(I,J,n,2))

        TABV=TU*(SPL(LP)/PU)**RGAMOG

        B    =TABV
        FAC  =0.
        AHF  =0.
        ELSEIF(NL1X(I,J,n).EQ.LP1)THEN
!---------------------------------------------------------------------
!***  EXTRAPOLATE BELOW LOWEST MODEL MIDLAYER (BUT STILL ABOVE GROUND)
!---------------------------------------------------------------------
!
        PL=PINT(I,J,n,LM-1)
        TL=0.5*(T(I,J,n,LM-2)+T(I,J,n,LM-1))
        TBLO=TL*(SPL(LP)/PL)**RGAMOG

        B    =TBLO
        FAC  =0.
        AHF  =0.
        ELSE
!---------------------------------------------------------------------
!***  INTERPOLATION BETWEEN NORMAL LOWER AND UPPER BOUNDS
!---------------------------------------------------------------------
!
        B     =T(I,J,n,NL1X(I,J,n))
        FAC  =2.*ALOG(PT+PDSL(I,J,n)*AETA(NL1X(I,J,n)))
        AHF  =(B-T(I,J,n,NL1X(I,J,n)-1))/     &
               (ALPINT(I,J,n,NL1X(I,J,n)+1)-ALPINT(I,J,n,NL1X(I,J,n)-1))
        ENDIF

        TSL(I,J,n)=B+AHF*(TRF-FAC)
        FSL(I,J,n)=(PNL1-SPL(LP))/(SPL(LP)+PNL1)   &
            *((ALSL(LP)+ALPINT(I,J,n,NL1X(I,J,n))-FAC)*AHF+B)*Rd*2.  &
            +ZINT(I,J,n,NL1X(I,J,n))*G
        if(i.eq.30.and.j.eq.101.and.n.eq.3)then
             print *,i,j,n,tsl(i,j,n),t(i,j,n,37),t(i,j,n,38),spl(lp),pl
	endif
  220   CONTINUE


          do 281 n=1,nm
          DO 281 J=1,jm-1
          DO 281 I=1,IM-1
!NOTE
!NOTE         29 JANUARY 1993, RUSS TREADON.
!NOTE          - AS FOR THE OTHER FIELDS WE INTERPOLATE ONLY
!NOTE            BETWEEN THE FAL AND THE MODEL TOP.  BELOW
!NOTE            SURFACE VALUES ARE FAL VALUES.
!
          LMVIJ=LM
!
          DO 280 LV=2,LMVIJ+1
          PETAL=PT+PDVP1(I,J,n)*ETA(LV)
          PETAU=PT+PDVP1(I,J,n)*ETA(LV-1)
          ALPETL=ALOG(PETAL)
          ALPETU=ALOG(PETAU)
          ALPET2=SQRT(0.5*(ALPETL*ALPETL+ALPETU*ALPETU))
!
!***  SEARCH FOR HIGHEST MID-LAYER MODEL SURFACE
!***  THAT IS BELOW THE GIVEN STANDARD PRESSURE LEVEL.
!
          IF(ALSL(LP).LT.ALPET2)THEN
            NL1X(I,J,n)=LV-1
            ALPETUX(I,J,n)=ALPETU
            ALPET2X(I,J,n)=ALPET2
            GO TO 281
          ENDIF
  280     CONTINUE
!
          NL1X(I,J,n)=LMVIJ+1
          ALPETUX(I,J,n)=ALPETU
          ALPET2X(I,J,n)=ALPET2
  281     CONTINUE
!
!---------------------------------------------------------------------
!***      BELOW GROUND USE WIND IN LOWEST LAYER
!---------------------------------------------------------------------
!
          do 290 n=1,nm 
          DO 290 J=1,jm-1
          DO 290 I=1,IM-1
          LMVIJ=LM
          IF(NL1X(I,J,n).GT.LMVIJ)THEN
            USL(I,J,n)=U(I,J,n,LMVIJ)
            VSL(I,J,n)=V(I,J,n,LMVIJ)
!
!---------------------------------------------------------------------
!***  IF REQUESTED PRESSURE LEVEL IS NOT BELOW THE LOCAL GROUND
!***  THEN WE HAVE TWO POSSIBILITIES.  IF THE REQUESTED PRESSURE
!***  LEVEL IS BETWEEN THE LOCAL SURFACE PRESSURE AND TOP OF
!***  MODEL PRESSURE, VERTICALLY INTERPOLATE BETWEEN NEAREST
!***  BOUNDING ETA LEVELS TO GET THE WIND COMPONENTS.  IF THE
!***  REQUESTED PRESSURE LEVEL IS ABOVE THE MODEL TOP, USE
!***  CONSTANT EXTRAPOLATION OF TOP ETA LAYER (L=1) WINDS.
!---------------------------------------------------------------------
!
          ELSE
            IF(NL1X(I,J,n).GT.1)THEN
              ALPETL=ALPETUX(I,J,n)
              PETAU=PT+PDVP1(I,J,n)*ETA(NL1X(I,J,n)-1)
              ALPETU=ALOG(PETAU)
              ALPET1=SQRT(0.5*(ALPETL*ALPETL+ALPETU*ALPETU))
              FACT=(ALPET2X(I,J,n)-ALSL(LP))/(ALPET2X(I,J,n)-ALPET1)
              USL(I,J,n)=U(I,J,n,NL1X(I,J,n))  &
                    +(U(I,J,n,NL1X(I,J,n)-1)-U(I,J,n,NL1X(I,J,n)))*FACT
              VSL(I,J,n)=V(I,J,n,NL1X(I,J,n))+(V(I,J,n,NL1X(I,J,n)-1) &
                     -V(I,J,n,NL1X(I,J,n)))*FACT
            ELSE
              USL(I,J,n)=U(I,J,n,NL1X(I,J,n))
              VSL(I,J,n)=V(I,J,n,NL1X(I,J,n))
            ENDIF
!
!---------------------------------------------------------------------
!***  ALPET2 IS MID-LAYER ETA SURFACE JUST BELOW STANDARD PRESSURE
!***  LEVEL AND ALPET1 IS MID-LAYER ETA SURFACE JUST ABOVE.
!***  NOTE THAT IF THE STANDARD PRESSURE SURFACE IS SUBMERGED, THEN
!***  ALPET2 AND ALPET1 ARE THE LOWEST AND 2ND LOWEST MID-LAYER
!***  ETA SURFACES ABOVE THE TOPOGRAPHY (WITH OLDRD=.TRUE., ZJ).
!---------------------------------------------------------------------
!
          ENDIF
  290     CONTINUE

        call bocoh(fsl,im,jm,nm)
	call bocov(usl,vsl,im,jm,nm)
	write(1)fsl
	write(1)usl
	write(1)vsl
	write(1)tsl

  310   continue

	do n=1,nm
	do j=1,jm
	do i=1,im
!	  print *,i,j,n,fsl(i,j,n,1)
        enddo
        enddo
        enddo

	close(1)

       end subroutine sig2p

