SUBROUTINE SETFGESURF 1
#if defined (DOC)
*
***s/r SURFC1DZ  - Computation of Jo and the residuals to the observations
*                 FOR SURFACE DATAFILES
*
*
*Author  : P. Koclas *CMC/AES  September 2000
*Revision:
*         JM Belanger CMDA/SMC Feb 2004
*                   . Introduce "scatterometer family SC"
*          Y. Yang,  ARQI Feb. 2010
*           - Switched order of comnumbr.cdk and cvcord.cdk due to dependencies
*
**    Purpose:  -Interpolate vertically the contents of commvo to
*                the pressure levels of the observations. Then
*                compute Jo.
*                A linear interpolation in ln(p) is performed.
*
*
*Arguments
*
#endif
      IMPLICIT NONE
*implicits
#include "comlun.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comphy.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "commvog.cdk"
#include "comnumbr.cdk"
#include "cvcord.cdk"
#include "comfilt.cdk"
*
      INTEGER IPB,IPT,IXTR,IDIM
      INTEGER IOBS,IPOS,IK,IBEGIN,ILAST,JO,IDATA,IDATEND
      INTEGER J,JDATA,IBEGINOB,ILASTOB,ITYP,JJ,ISTYP,JDATA2
      INTEGER ICOUNT,IERR,ILEN,JLIST,JCOUNT,IPOINTR(1)
      REAL*8 ZVAR,ZOER,ZCON,ZINC,ZPHI,ZJON,ZGAMI,ZSLEV,ZQCARG,ZPPOST
      REAL*8 ZWB,ZWT,ZEXP,zexpgz,ZGAMMA,ZTVG,ZPSGOBS
      REAL*8 ZLEV,ZPT,ZPB,ZHHH,ZGAMAZ
      LOGICAL LLOK, LLPRINT,LLUV
      POINTER(PXPOINTR    ,IPOINTR)

C
C     Temperature lapse rate for extrapolation of gz below model surface
C
      LLPRINT = .FALSE.
c        LLPRINT = .TRUE.
      ZGAMMA = 0.0065 / GRAV
      zexp = 1/(RGASD*ZGAMMA)
      zexpgz = (RGASD*ZGAMMA)
C
      DO J = 1,NFILES
         IF ( (CFAMTYP(J) == 'SF') .AND.( NBEGINTYP(J) > 0) .OR.
     &        (CFAMTYP(J) == 'UA') .AND.( NBEGINTYP(J) > 0) .OR.
     &        (CFAMTYP(J) == 'SC') .AND.( NBEGINTYP(J) > 0)   )    THEN
           IBEGIN=NBEGINTYP(J)
           ILAST=NENDTYP(J)
C
C*    1. Computation of (HX - Z)/SIGMA
C     .  -----------------------------
C
 100      CONTINUE
C
C     Process all data within the domain of the model
C
C
          ILEN = ILAST - IBEGIN +1
          CALL HPALLOC(PXPOINTR,ILEN,IERR,1)
          DO JLIST = 1,NELEMS
            ICOUNT = 0
            DO JDATA=IBEGIN,ILAST
              LLOK=.FALSE.
              IF ( MOBDATA(NCMVCO,JDATA) == 1 ) THEN
                ITYP = MOBDATA(NCMVNM,JDATA)
                IF (ITYP == NETS .OR. ITYP == NEPS .OR.
     &              ITYP == NEPN .OR. ITYP == NESS .OR.
     &              ITYP == NEUS .OR. ITYP == NEVS    ) THEN
                  LLOK=(MOBDATA(NCMASS,JDATA) .EQ. 1 .AND.
     &                 ITYP .EQ. NLIST(JLIST))
                ELSE
                  LLOK=(MOBDATA(NCMASS,JDATA) .EQ. 1 .AND.
     &                 ITYP .EQ. NLIST(JLIST)        .AND.
     &                 MOBDATA(NCMXTR,JDATA)  .ge. 0)
                ENDIF
                IF ( LLOK ) THEN
                  ICOUNT = ICOUNT + 1
                  IPOINTR(ICOUNT) = JDATA
                ENDIF
              ENDIF
            ENDDO
C
C-------------- Surfacde data and data with height vertical coordinate
C
            IF(ICOUNT.GT.0)          THEN
              DO JCOUNT = 1,ICOUNT
                JDATA = IPOINTR(JCOUNT)
                IOBS = MOBDATA(NCMOBS,JDATA)
                ITYP = MOBDATA(NCMVNM,JDATA)
                IPOS = MOBDATA(NCMPOS,JDATA)
                idim=1
                if ( ipos .gt. 5 )idim=0
                IK   = ROBDATA(NCMLYR,JDATA)
                ZLEV = ROBDATA8(NCMPPP,JDATA)
                ZHHH = ZLEV * GRAV

                IF (ITYP == NETS .OR. ITYP == NEPS .OR.
     &              ITYP == NEPN .OR. ITYP == NESS .OR.
     &              ITYP == NEUS .OR. ITYP == NEVS    ) THEN

                  IPT  = IK + IPOS*NFLEV
                  IPB  = IPT+1
                  ROBDATA(NCMFGE,JDATA) = GOMOBS(IPB,IOBS)
                ELSE
                  IPT  = IK + IPOS*NFLEV
                  IPB  = IPT+1
                  ZPT  = GOMGZG(IK,IOBS)
                  ZPB  = GOMGZG(IK+1,IOBS)
                  ZWB  = idim*(ZPT-ZHHH)/(ZPT-ZPB)
                  ZWT  = 1. - ZWB
                  IF ( MOBDATA(NCMXTR,JDATA) .eq. 0) then
                    ROBDATA(NCMFGE,JDATA) = zwb*GOMOBS(IPB,IOBS)
     +                   + ZWT*GOMOBS(IPT,IOBS)
                  ELSE
                    ROBDATA(NCMFGE,JDATA) = GOMOBS(IK + IPOS*NFLEV
     &                   ,IOBS)
                  ENDIF
                if(cstnid(iobs) .eq. '83208') then
                  write(nulout,*) 'setfgesurf:stn,ityp,xtr,ipt,ipb,zwt,zwb'
     &                 ,cstnid(iobs),ityp,MOBDATA(NCMXTR,JDATA),ipt,ipb
     &                 ,zwt,zwb
                  write(nulout,*) 'setfgesurf:gobs(ipb),gobs(ipt),fge'
     &                 ,GOMOBS(IPB,IOBS),GOMOBS(IPT,IOBS),ROBDATA(NCMFGE
     &                 ,JDATA)
                endif
                ENDIF
              ENDDO
            ENDIF
          ENDDO
          CALL HPDEALLC(PXPOINTR,IERR,1)
C
C
        ENDIF
      END DO
C--------------------------------------------------------------------
      RETURN
      END