SUBROUTINE read_mtn_hprim_oz(SLMSK,HPRIME,NEEDORO,ORO,
     &           iozondp,ozplin,global_lats_r,lonsperlar)
!
!***********************************************************************
!
      use resol_def
      use layout1
      use mpi_def
      use ozne_def
      implicit none

!
      integer              global_lats_r(latr)
      integer                 lonsperlar(latr)
      real (kind=kind_io8) SLMSK(lonr,lats_node_r),
     &  HPRIME(NMTVR,lonr,lats_node_r),ORO(lonr,lats_node_r)
 
      integer iozondp
      real (kind=kind_io8) ozplin(latsozp,levozp,pl_coeff,timeoz)
 
      real(kind=kind_io4) buff1(lonr,latr),buffm(lonr,latr,nmtvr)
      real(kind=kind_io8) buffo(lonr,lats_node_r)
      real(kind=kind_io8) buff2(lonr,lats_node_r)
      integer kmsk0(lonr,latr)
      integer i,j,k,nmtn
      integer needoro
!
      kmsk0=0
!
!     Read HPRIME from file MTNVAR
!     ****************************
      nmtn=24
!jfe  IF (me.eq.0) THEN
      IF (icolor.eq.2.and.me.eq.nodes-1) THEN
        READ(nmtn) buffm
!!      do k=1,nmtvr
!!        write(200) buffm(:,:,k)
!!      enddo
      ENDIF
      DO k=1,nmtvr
       call split2d(buffm(1,1,k),buffo,global_lats_r)
       CALL interpred(1,kmsk0,buffo,buff2,global_lats_r,
     &                lonsperlar)
       HPRIME(k,:,:)=buff2(:,:)
      ENDDO
 
!my jordan's mb
!sela  print *, ' (*j*)  nmtvr= ',nmtvr, 'reading hprime'
!my      DO j=1,lats_node_r
!my      DO i=1,lonr
!my      DO k=1,NMTVR
!my        IF(SLMSK(i,j).NE.1.) HPRIME(k,i,j) = 0.
!my      ENDDO
!my      ENDDO
!my      ENDDO
 

 
      IF (iozondp.eq.1) CALL readoz_disprd(ozplin)
!
!     reading the grib orography and scattering the data
!
      if(needoro.eq.1) then

      IF (icolor.eq.2.and.me.eq.nodes-1) print *,'read grb orography'
      IF (icolor.eq.2.and.me.eq.nodes-1) THEN
        CALL ORORD(101,lonr,latr,buff1)
      endif
      call split2d(buff1,buffo,global_lats_r)
      CALL interpred(1,kmsk0,buffo,oro,global_lats_r,lonsperlar)
 
      endif
      RETURN
      END
      SUBROUTINE read_sfc(sfc_fld,NEEDORO,nread,
     &                    cfile,global_lats_r,lonsperlar)
!
!***********************************************************************
!
      use sfcio_module
      use resol_def
      use layout1
      use mpi_def
      use Sfc_Flx_ESMFMod
      use namelist_soilveg , only : salp_data, snupx
      use physcons, only : tgice => con_tice
      implicit none
!
      TYPE(Sfc_Var_Data)        :: sfc_fld
      integer              global_lats_r(latr)
      integer                 lonsperlar(latr)

      integer jump
      integer needoro

      real(kind=kind_io4) buff1(lonr,latr),buff2(lonr,latr,LSOIL)
!    &,    buff4(lonr,latr,4),xhour
!$$$     &     buff4(lonr,latr,4),slmskful(lonr,latr),xhour
      real(kind=kind_io8) buffo(lonr,lats_node_r)
      real(kind=kind_io8) buff3(lonr,lats_node_r)
      integer nread,i,j,k,ij,idate(4),lonsfc,latsfc,lplsfc(latr2)
      character*(*) cfile
      integer kmsk(lonr,latr),kmskcv(lonr,latr)
      CHARACTER*8 labfix(4)
!$$$      common /comfixio/slmskful
      real t1,t2,timef,rsnow
      type(sfcio_head) head
      type(sfcio_data) data
      integer iret, vegtyp
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
      t1=timef()

      print *,' nread=',nread,' cfile=',cfile
      IF (icolor.eq.2.and.me.eq.nodes-1) THEN
        call sfcio_srohdc(nread,cfile,head,data,iret)

        PRINT 99,nread,head%fhour,head%idate,
     &           head%lonb,head%latb,head%lsoil,head%ivs,iret
99      FORMAT(1H ,'in fixio nread=',i3,2x,'HOUR=',f8.2,3x,'IDATE=',
     &  4(1X,I4),4x,'lonsfc,latsfc,lsoil,ivssfc,iret=',5i8)

        if(iret.ne.0) goto 5000
!       if(head%ivs.ne.200412.and.head%ivs.ne.200501) goto 5000
        if(head%lonb.ne.lonr) goto 5000
        if(head%latb.ne.latr) goto 5000
        if(head%lsoil.ne.lsoil) goto 5000

      ENDIF

      kmsk=0

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tsea
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%TSEA,global_lats_r,lonsperlar)

      DO K=1, LSOIL
        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%smc(:,:,k)
        call split2d(buff1, buffo,global_lats_r)
        CALL interpred(1,kmsk,buffo,buff3,global_lats_r,lonsperlar)
        sfc_fld%SMC(k,:,:)=buff3(:,:)
      ENDDO

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%sheleg
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SHELEG,
     &               global_lats_r,lonsperlar)

      DO K = 1, LSOIL
        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%stc(:,:,k)
        call split2d(buff1, buffo,global_lats_r)
        CALL interpred(1,kmsk,buffo,buff3,global_lats_r,lonsperlar)
        sfc_fld%STC(k,:,:)=buff3(:,:)
      ENDDO

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tg3
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%TG3,global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%zorl
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ZORL,global_lats_r,lonsperlar)

      sfc_fld%cv  = 0
      sfc_fld%cvb = 0
      sfc_fld%cvt = 0

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alvsf
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALVSF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alvwf
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALVWF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alnsf
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALNSF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alnwf
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALNWF,
     &               global_lats_r,lonsperlar)

!     The mask cannot be interpolated
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%slmsk
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SLMSK,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%vfrac
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%VFRAC,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%canopy
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%CANOPY,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%f10m
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%F10M,global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%vtype
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%VTYPE,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%stype
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%STYPE,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%facsf
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%FACSF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%facwf
      call split2d(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%FACWF,
     &               global_lats_r,lonsperlar)

!szunyogh 06/16/99
        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%uustar
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%UUSTAR,
     &               global_lats_r,lonsperlar)

        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%ffmm
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%FFMM,
     &                  global_lats_r,lonsperlar)

        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%ffhh
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%FFHH,
     &                  global_lats_r,lonsperlar)

!c-- XW: FOR SEA-ICE Nov04
!    Sea-ice (hice/fice) was added to the surface files.

         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%hice
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%HICE,
     &                  global_lats_r,lonsperlar)

         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%fice
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%FICE,
     &                  global_lats_r,lonsperlar)

         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tisfc
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%TISFC,
     &                  global_lats_r,lonsperlar)
         if (lats_node_r > 0 )  then
           if (sfc_fld%tisfc(1,1) < 0.0)  then
             DO j=1,lats_node_r
               DO i=1,LONR
                 sfc_fld%TISFC(i,j) = sfc_fld%TSEA(i,j)
                 IF(sfc_fld%SLMSK(i,j) >=  2. .AND.
     &             sfc_fld%FICE(i,j)  >= 0.5) THEN
                   sfc_fld%TISFC(i,j) = (sfc_fld%TSEA(i,j)
     &            -tgice*(1.-sfc_fld%FICE(i,j))) / sfc_fld%FICE(i,j)
                   sfc_fld%TISFC(i,j)=MIN(sfc_fld%TISFC(i,j),tgice)
                 ENDIF
               ENDDO
             ENDDO
           endif
         endif

!c-- XW: END SEA-ICE

!lu   11/10/2004
!*     surface files for GFS/Noah contain 8 additional records:
!*     tprcp, srflag, snwdph, slc, shdmin, shdmax, slope, snoalb

         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tprcp
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%TPRCP,
     &                  global_lats_r,lonsperlar)

!* srflag
         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%srflag
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%SRFLAG,
     &                  global_lats_r,lonsperlar)

!* snwdph
         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%snwdph
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%SNWDPH,
     &                  global_lats_r,lonsperlar)

!* slc
         DO K=1, LSOIL
         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%slc(:,:,k)
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,buff3,global_lats_r,lonsperlar)
         sfc_fld%SLC(k,:,:) = buff3(:,:)
         ENDDO

!* shdmin
         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%shdmin
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%SHDMIN,
     &                  global_lats_r,lonsperlar)

!* shdmax
         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%shdmax
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%SHDMAX,
     &                  global_lats_r,lonsperlar)

!* slope
         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%slope
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%SLOPE,
     &                  global_lats_r,lonsperlar)

!* snoalb
         if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%snoalb
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%SNOALB,
     &                  global_lats_r,lonsperlar)
!     print *,' snoalb=',sfc_fld%snoalb(1,:)
!lu [+67L]: the addition of 8 Noah records ends here .........................

       if(needoro.eq.1) then
         if(icolor.eq.2.and.me.eq.nodes-1) then
           buff1=data%orog
           needoro=1
           if(all(data%orog.ne.sfcio_realfill)) needoro=0
           print *,'read sfc orography'
         endif
         call split2d(buff1, buffo,global_lats_r)
         CALL interpred(1,kmsk,buffo,sfc_fld%ORO,
     &                  global_lats_r,lonsperlar)
         call skip(needoro)
       endif
!
!Wei initialize snow fraction(sheleg is in mm)
      DO j=1,lats_node_r
        DO i=1,LONR
          sfc_fld%SNCOVR(i,j) = 0.0
          if (sfc_fld%slmsk(i,j) > 0.001) then
            vegtyp = sfc_fld%VTYPE(i,j)
            if( vegtyp == 0 ) vegtyp = 7
            RSNOW  = 0.001*sfc_fld%SHELEG(i,j)/SNUPX(vegtyp)
            IF (0.001*sfc_fld%SHELEG(i,j) < SNUPX(vegtyp)) THEN
              sfc_fld%SNCOVR(i,j) = 1.0 - ( EXP(-SALP_DATA*RSNOW)
     &                                    - RSNOW*EXP(-SALP_DATA))
            ELSE
              sfc_fld%SNCOVR(i,j) = 1.0
            ENDIF
!           if (i == 1)
!    &       print*,SNUPX(vegtyp),SALP_DATA,sfc_fld%SNCOVR(i,j),
!    &       '************debug',sfc_fld%SHELEG(i,j),vegtyp,' j=',j
!    &,      ' snoalb1=',sfc_fld%snoalb(i,j)
!
          endif
        ENDDO
       ENDDO
!

       IF (icolor.eq.2.and.me.eq.nodes-1) then
         call sfcio_axdata(data,iret)
         t2=timef()
         print *,'FIXIO TIME ',t2-t1,t1,t2
       endif
!
      RETURN
 5000 PRINT *, ' ERROR IN INPUT IN FIXIO'
      STOP
      END
!
!***********************************************************************
!
      subroutine interpred(iord,kmsk,f,fi,global_lats_r,lonsperlar)
!!
      use resol_def
      use layout1
      implicit none
!!
      integer              global_lats_r(latr)
      integer,intent(in):: iord
      integer,intent(in):: kmsk(lonr,lats_node_r)
      integer,intent(in):: lonsperlar(latr)
      real(kind=kind_io8),intent(in):: f(lonr,lats_node_r)
      real(kind=kind_io8),intent(out):: fi(lonr,lats_node_r)
      integer j,lons,lat
!!
      do j=1,lats_node_r
          lat=global_lats_r(ipt_lats_node_r-1+j)
          lons=lonsperlar(lat)
          if(lons.ne.lonr) then
            call intlon(iord,1,1,lonr,lons,
     &                  kmsk(1,j),f(1,j),fi(1,j))
cjfe        fi(lons+1:lonr,j)=-9999.e9
            fi(lons+1:lonr,j)=0.
          else
            fi(:,j)=f(:,j)
          endif
        enddo
      end subroutine
c
c***********************************************************************
c
      subroutine intlon(iord,imon,imsk,m1,m2,k1,f1,f2)
      use machine
      implicit none
      integer,intent(in):: iord,imon,imsk,m1,m2
      integer,intent(in):: k1(m1)
      real (kind=kind_io8),intent(in):: f1(m1)
      real (kind=kind_io8),intent(out):: f2(m2)
      integer i2,in,il,ir
      real (kind=kind_io8) r,x1
      r=real(m1)/real(m2)
      do i2=1,m2
         x1=(i2-1)*r
         il=int(x1)+1
         ir=mod(il,m1)+1
          if(iord.eq.2.and.(imsk.eq.0.or.k1(il).eq.k1(ir))) then
            f2(i2)=f1(il)*(il-x1)+f1(ir)*(x1-il+1)
          else
            in=mod(nint(x1),m1)+1
            f2(i2)=f1(in)
          endif
      enddo
      end subroutine
c
c**********************************************************************
c
      SUBROUTINE readoz_disprd(ozplin)
 
      use resol_def
      use layout1
      use ozne_def
      implicit none
!!
      integer n,k,kk,i
      real (kind=kind_phys) ozplin(latsozp,levozp,pl_coeff,timeoz)
      real(kind=kind_io4) tempin(latsozp)
!
      DO I=1,timeoz
        do n=1,pl_coeff
          DO k=1,levozp
            READ(kozpl) tempin
            ozplin(:,k,n,i) = tempin(:)
          ENDDO
        enddo
      ENDDO
 
      RETURN
      END
c
c***********************************************************************
c
      SUBROUTINE ORORD(LUGB,IORO,JORO,ORO)
!
      use resol_def
      use layout1
      implicit none
!!
      integer lugb, ioro, joro, kpdoro, ior, jor, i,k
      CHARACTER*80 FNOROG
!
      real (kind=kind_io4) oro(ioro,joro)
      real (kind=kind_io8) orog(ioro,joro), blnm, bltm
      logical gausm
!
      FNOROG = 'orography'
      kpdoro = 8
      IOR    = IORO
      JOR    = JORO
      CALL FIXRDG(LUGB,IOR,JOR,FNOROG,
     &            KPDORO,OROG,GAUSM,BLNM,BLTM,me)
!
      if (ior .ne. ioro .or. jor .ne. joro) then
         print *,' orography file not o.k. run aborted'
         call abort
      endif
      ORO = OROG
!
      RETURN
      END
c
c***********************************************************************
c
      subroutine split2d(x,xl,global_lats_r)
c
c***********************************************************************
c
      use resol_def
      use layout1
      use mpi_def
      implicit none
!!
      real(kind=kind_io4) x(lonr,latr)
      real (kind=kind_io8) xl(lonr,lats_node_r)
      real(kind=kind_io4) tmp(lonr,latr)
      integer global_lats_r(latr)
      integer nprocf,nodesr
!     integer maxfld,nprocf,nodesr
!     integer proc,j,lat,msgtag,nproc,i,msgtag1,buff,startlat,ierr
      integer proc,j,lat,nproc,i,buff,startlat,ierr
      integer ifld/0/
      save ifld
      real t1,t2,t3,t4,timef,ta,tb
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
!!
      XL=0.
!     maxfld=50
      ifld=ifld+1
!!
      IF (icolor.eq.2.and.me.eq.nodes-1) THEN
        ta=timef()
        t3=ta
c        DO proc=1,nodes-1
         do proc=1,1
c
c         Sending the data
c         ----------------
         tmp=0.
         do j=1,latr
            do i=1,lonr
              tmp(i,j)=X(i,j)
            enddo
         enddo
!Moor    msgtag=1000+proc*nodes*maxfld+ifld
         t1=timef()
!sela    print *,' GWVX BROADCASTING FROM ',nodes-1
         call mpi_bcast
     1 (tmp,lonr*latr,MPI_R_IO,nodes-1,MPI_COMM_ALL,info)
         call mpi_comm_rank(MPI_COMM_ALL,i,info)
c         CALL mpi_send(tmp,lonr*latr,MPI_R_IO,proc-1,msgtag,
c     &                  MPI_COMM_ALL,info)
         t2=timef()
!sela    print 102,t2-t1
 
 102    format(' SEND TIME ',f10.5)
        enddo
        t4=timef()
      ELSE
        if (.NOT.LIOPE) then
          nodesr=nodes
        else
          nodesr=nodes+1
        endif
!Moor   msgtag=1000+(me+1)*nodesr*maxfld+ifld
!sela    print *,' GWVX BROADCASTREC  FROM ',nodesr-1
         call mpi_bcast
     1 (tmp,lonr*latr,MPI_R_IO,nodesr-1,MPI_COMM_ALL,info)
         call mpi_comm_rank(MPI_COMM_ALL,i,info)
!sela    print *,'GWVX IPT ',ipt
c        CALL mpi_recv(tmp,lonr*latr,MPI_R_IO,nodesr-1,
c     &                msgtag,MPI_COMM_ALL,stat,info)
        do j=1,lats_node_r
           lat=global_lats_r(ipt_lats_node_r-1+j)
           do i=1,lonr
              xl(i,j)=tmp(i,lat)
           enddo
        enddo
!!
      ENDIF
!!
!!     for pes nodes-1
      if (.NOT.LIOPE) then
        if (me.eq.nodes-1) then
          do j=1,lats_node_r
             lat=global_lats_r(ipt_lats_node_r-1+j)
             do i=1,lonr
                xl(i,j)=X(i,lat)
             enddo
          enddo
        endif
      endif
!!
      tb=timef()
         call mpi_comm_rank(MPI_COMM_ALL,i,info)
 
!sela  if(icolor.eq.2.and.me.eq.nodes-1)print 103,tb-ta,t4-t3
 103  format(' GLOBAL AND SEND TIMES  SPLIT2D',2f10.5)
      return
      end
c
c***********************************************************************
c
      SUBROUTINE skip(jump)
 
c*************************************************************************
 
      use resol_def
      use layout1
      use mpi_def
      implicit none
 
      integer jump,ipe
 
      IF (icolor.eq.2) then
         ipe=nodes-1
      else
         ipe=nodes
      endif
 
      CALL MPI_BCAST(jump,1,MPI_INTEGER,ipe,MPI_COMM_ALL,info)
 
      RETURN
      END
!
c
c***********************************************************************
c
      SUBROUTINE EXCHA(lats_nodes_r,global_lats_r,X1,X2,Y1,Y2)
c
c***********************************************************************
c
      use resol_def
      use layout1
      use mpi_def
      implicit none
 
      integer n,i,j,ierr,ilat,lat,node,nsend
      integer              global_lats_r(latr)
      integer              lats_nodes_r(nodes)
      real(kind=kind_io8) X1(lats_node_r),X2(lats_node_r)
      real(kind=kind_io8) Y1(latr),Y2(latr)
cjfe  real(kind=kind_mpi) tmps(2,lats_node_r_max,nodes)
cjfe  real(kind=kind_mpi) tmpr(2,lats_node_r_max,nodes)
      real(kind=kind_io8) tmps(2,lats_node_r_max,nodes)
      real(kind=kind_io8) tmpr(2,lats_node_r_max,nodes)
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      if (nodes.ne.1) then
        do node=1,nodes
          do i=1,lats_node_r
           lat=global_lats_r(ipt_lats_node_r-1+i)
           tmps(1,i,node)=X1(I)
           tmps(2,i,node)=X2(I)
          enddo
        enddo
!!
        nsend=2*lats_node_r_max
cjfe    call mpi_alltoall(tmps,nsend,MPI_R_MPI,
cjfe x                     tmpr,nsend,MPI_R_MPI,
cjfe x                     MC_COMP,ierr)
        call mpi_alltoall(tmps,nsend,MPI_R_DEF,
     x                     tmpr,nsend,MPI_R_DEF,
     x                     MC_COMP,ierr)
!!
        ilat=1
        do node=1,nodes
          do i=1,lats_nodes_r(node)
             lat=global_lats_r(ilat)
             Y1(lat)=tmpr(1,i,node)
             Y2(lat)=tmpr(2,i,node)
             ilat=ilat+1
          enddo
        enddo
!!
      ELSE
        Y1=X1
        Y2=X2
      ENDIF
!!
      RETURN
      END
c
c***********************************************************************
c
      SUBROUTINE SUMLAT(n,X,nodes)
c
c***********************************************************************
c
      use mpi_def
      implicit none
 
      integer n,i,j,np,mr,nodes
      real(kind=kind_io8) X(n),Y(N)
      real(kind=kind_io4) Z(n)
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      if (nodes.ne.1) then
        DO i=1,n
          Y(i)=X(i)
        ENDDO
        CALL mpi_allreduce(Y,X,n,MPI_R_DEF,MPI_SUM,
     &                    MC_COMP   ,info)
      endif
        DO i=1,n
          Z(i)=X(i)
        ENDDO
        DO i=1,n
          X(i)=Z(i)
        ENDDO
!!
      RETURN
      END
c
c***********************************************************************
c
      subroutine unsplit2d(ioproc,x,xl,global_lats_r)
c
c***********************************************************************
c
      use resol_def
      use layout1
      use mpi_def
      implicit none
!!
      real(kind=kind_io4) x(lonr,latr)
      real (kind=kind_io8) xl(lonr,lats_node_r)
      real(kind=kind_io4) tmp(lonr,latr+2)
      integer global_lats_r(latr),ipt_lats_node_rl,nodesr
      integer lats_nodes_rl
      integer maxfld,ioproc,nproct
      integer proc,j,lat,msgtag,nproc,i,msgtag1,buff,startlat,ierr
      integer ifldu/0/
      save ifldu
      integer illen,ncc
      data ncc/0/
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
!!
      X=0.
      maxfld=50
      ifldu=ifldu+1
!!
      IF (me.ne.ioproc) THEN
c
c         Sending the data
c         ----------------
         tmp=0.
         tmp(lonr,latr+1)=ipt_lats_node_r
         tmp(lonr,latr+2)=lats_node_r
         do j=1,lats_node_r
            do i=1,lonr
              tmp(i,j)=XL(i,j)
            enddo
         enddo
         if (.NOT.LIOPE) then
           nodesr=nodes
         else
           nodesr=nodes+1
         endif
         msgtag=1000+(me+1)*nodesr*maxfld+ifldu
          call MPI_SEND(tmp(lonr,latr+1),1,MPI_R_IO,ioproc,
     &                  msgtag,MPI_COMM_ALL,info)
          call MPI_SEND(tmp(lonr,latr+2),1,MPI_R_IO,ioproc,
     &                  msgtag,MPI_COMM_ALL,info)
         illen=tmp(lonr,latr+2)
c send the local grid domain
         CALL mpi_send(tmp(1,1),illen*lonr,MPI_R_IO,ioproc,
     &                  msgtag,MPI_COMM_ALL,info)
      ELSE
!!
!!     for pes ioproc
        if (.NOT.LIOPE) then
          nproct=nodes
          do j=1,lats_node_r
             lat=global_lats_r(ipt_lats_node_r-1+j)
             do i=1,lonr
                x(i,lat)=XL(i,j)
             enddo
          enddo
        else
          nproct=nodes-1
        endif
        DO proc=1,nproct
         if (proc.ne.ioproc+1) then
         msgtag=1000+proc*nodes*maxfld+ifldu
          CALL mpi_recv(tmp(lonr,latr+1),1,MPI_R_IO,proc-1,
     &                msgtag,MPI_COMM_ALL,stat,info)
          CALL mpi_recv(tmp(lonr,latr+2),1,MPI_R_IO,proc-1,
     &                msgtag,MPI_COMM_ALL,stat,info)
         illen=tmp(lonr,latr+2)
          CALL mpi_recv(tmp(1,1),illen*lonr ,MPI_R_IO,proc-1,
     &                msgtag,MPI_COMM_ALL,stat,info)
         if (.NOT.LIOPE) then
           ipt_lats_node_rl=tmp(lonr,latr+1)
           lats_nodes_rl=tmp(lonr,latr+2)
         else
           ipt_lats_node_rl=tmp(lonr,lats_node_r_max+1)
           lats_nodes_rl=tmp(lonr,lats_node_r_max+2)
         endif
         do j=1,lats_nodes_rl
           lat=global_lats_r(ipt_lats_node_rl-1+j)
           do i=1,lonr
              x(i,lat)=tmp(i,j)
           enddo
         enddo
         endif   !(proc.ne.ioproc+1)
        enddo
!!
      ENDIF
         ncc=ncc+1
 
!!
      return
      end
c
c***********************************************************************
c
      subroutine uninterpred(iord,kmsk,f,fi,global_lats_r,lonsperlar)
!!
      use resol_def
      use layout1
      implicit none
!!
      integer              global_lats_r(latr)
      integer,intent(in):: iord
      integer,intent(in):: kmsk(lonr,lats_node_r)
      integer,intent(in):: lonsperlar(latr)
      real(kind=kind_io8),intent(out):: f(lonr,lats_node_r)
      real(kind=kind_io8),intent(in):: fi(lonr,lats_node_r)
      integer j,lons,lat
!!
      do j=1,lats_node_r
          lat=global_lats_r(ipt_lats_node_r-1+j)
          lons=lonsperlar(lat)
          if(lons.ne.lonr) then
            call intlon(iord,1,1,lons,lonr,
     &                  kmsk(1,j),fi(1,j),f(1,j))
          else
            f(:,j)=fi(:,j)
          endif
        enddo
      end subroutine
      subroutine uninterprez(iord,kmsk,f,fi,global_lats_r,lonsperlar)
!!
      use resol_def
      use mod_state
      use layout1
      implicit none
!!
      integer              global_lats_r(latr)
      integer,intent(in):: iord
      integer,intent(in):: kmsk(lonr,lats_node_r)
      integer,intent(in):: lonsperlar(latr)
      real(kind=kind_io8),intent(out):: f(lonr,lats_node_r)
      real(kind=kind_io8),intent(in):: fi(lonr,lats_node_r)
       real(kind=4) f4(lonr,lats_node_r)
      integer j,lons,lat
      integer i,ubound
!!
      do j=1,lats_node_r
          lat=global_lats_r(ipt_lats_node_r-1+j)
          lons=lonsperlar(lat)
          if(lons.ne.lonr) then
            call intlon(iord,1,1,lons,lonr,
     &                  kmsk(1,j),fi(1,j),f(1,j))
          f4(:,j)=fi(:,j)
          else
            f(:,j)=fi(:,j)
            f4(:,j)=fi(:,j)
          endif
        enddo
      do j=1,lats_node_r
      do i=1,lonr
      buff_mult_piecea(i,ngrid,j)=f (i,j)
      end do
      end do
      ngrid=ngrid+1
      end subroutine
       subroutine unsplit2z(ioproc,x,global_lats_r)
c
c***********************************************************************
c
      use resol_def
      use mod_state
      use layout1
      use mpi_def
      implicit none
!!
      real(kind=kind_io4) x(lonr,latr)
      real(kind=kind_io4) tmp(lonr,latr+2)
      integer global_lats_r(latr),ipt_lats_node_rl,nodesr
      integer lats_nodes_rl
      integer maxfld,ioproc,nproct
      integer proc,j,lat,msgtag,nproc,i,msgtag1,buff,startlat,ierr
      integer ifldu/0/
      save ifldu
      integer illen
       character*8 cna
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
!!
      write(cna,985)600+ngrid
 985   format('fort.',i3)
      X=0.
      maxfld=50
      ifldu=ifldu+1
!!
      IF (me.ne.ioproc) THEN
            continue
      ELSE
!!
!!     for pes ioproc
c        if (.NOT.LIOPE) then
c            continue
c        else
c          nproct=nodes-1
c        endif
           nproct=nodes_comp
        DO proc=1,nproct
c         if (proc.ne.ioproc+1) then
c         if (.NOT.LIOPE) then
c             continue
c         else
            ipt_lats_node_rl=ivar_global_a(1,proc)
            lats_nodes_rl=ivar_global_a(2,proc)
c         endif
         do j=1,lats_nodes_rl
           lat=global_lats_r(ipt_lats_node_rl-1+j)
           do i=1,lonr
c              x(i,lat)=tmp(i,j)
              x(i,lat)=buff_mult_piecesa(i,ngrid,j,proc)
           enddo
         enddo
c         endif   !(proc.ne.ioproc+1)
        enddo
!!
c        call baclose(563,i)
c         print *,cna,' UNSPLITFCLOSE  ',i
c        call baopenw(563,cna,i)
c         print *,cna,' UNSPLITF OPEN  ',i
      ENDIF
        ngrid=ngrid+1
!!
      return
      end
 
c
c***********************************************************************
c
      subroutine unsplit2d_r(ioproc,x,xl,global_lats_r)
c
c***********************************************************************
c
      use resol_def
      use layout1
      use mpi_def
      implicit none
!!
      real(kind=kind_ior) x(lonr,latr)
      real (kind=kind_io8) xl(lonr,lats_node_r)
      real(kind=kind_ior) tmp(lonr,latr+2)
      integer global_lats_r(latr),ipt_lats_node_rl,nodesr
      integer lats_nodes_rl
      integer maxfld,ioproc,nproct
      integer proc,j,lat,msgtag,nproc,i,msgtag1,buff,startlat,ierr
      integer ifldu/0/
      save ifldu
      integer illen,ncc
      data ncc/0/
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
!!
!     X=0.               ! commented by moorthi on 20051117
      maxfld=50
      ifldu=ifldu+1
!!
      IF (me.ne.ioproc) THEN
c
c         Sending the data
c         ----------------
         tmp=0.
         tmp(lonr,latr+1)=ipt_lats_node_r
         tmp(lonr,latr+2)=lats_node_r
         do j=1,lats_node_r
            do i=1,lonr
              tmp(i,j)=XL(i,j)
            enddo
         enddo
         if (.NOT.LIOPE) then
           nodesr=nodes
         else
           nodesr=nodes+1
         endif
         msgtag=1000+(me+1)*nodesr*maxfld+ifldu
          call MPI_SEND(tmp(lonr,latr+1),1,MPI_R_IO_R,ioproc,
     &                  msgtag,MPI_COMM_ALL,info)
          call MPI_SEND(tmp(lonr,latr+2),1,MPI_R_IO_R,ioproc,
     &                  msgtag,MPI_COMM_ALL,info)
         illen=tmp(lonr,latr+2)
c send the local grid domain
         CALL mpi_send(tmp(1,1),illen*lonr,MPI_R_IO_R,ioproc,
     &                  msgtag,MPI_COMM_ALL,info)
      ELSE
!!
!!     for pes ioproc
        x = 0.0               ! added by Moorthi on 2005111700
        if (.NOT.LIOPE) then
          nproct=nodes
          do j=1,lats_node_r
             lat=global_lats_r(ipt_lats_node_r-1+j)
             do i=1,lonr
                x(i,lat)=XL(i,j)
             enddo
          enddo
        else
          nproct=nodes-1
        endif
        DO proc=1,nproct
         if (proc.ne.ioproc+1) then
         msgtag=1000+proc*nodes*maxfld+ifldu
          CALL mpi_recv(tmp(lonr,latr+1),1,MPI_R_IO_R,proc-1,
     &                msgtag,MPI_COMM_ALL,stat,info)
          CALL mpi_recv(tmp(lonr,latr+2),1,MPI_R_IO_R,proc-1,
     &                msgtag,MPI_COMM_ALL,stat,info)
         illen=tmp(lonr,latr+2)
          CALL mpi_recv(tmp(1,1),illen*lonr ,MPI_R_IO_R,proc-1,
     &                msgtag,MPI_COMM_ALL,stat,info)
         if (.NOT.LIOPE) then
           ipt_lats_node_rl=tmp(lonr,latr+1)
           lats_nodes_rl=tmp(lonr,latr+2)
         else
           ipt_lats_node_rl=tmp(lonr,lats_node_r_max+1)
           lats_nodes_rl=tmp(lonr,lats_node_r_max+2)
         endif
         do j=1,lats_nodes_rl
           lat=global_lats_r(ipt_lats_node_rl-1+j)
           do i=1,lonr
              x(i,lat)=tmp(i,j)
           enddo
         enddo
         endif   !(proc.ne.ioproc+1)
        enddo
!!
      ENDIF
         ncc=ncc+1
 
!!
      return
      end
c
c***********************************************************************
c
      subroutine split2d_r(x,xl,global_lats_r)
c
c***********************************************************************
c
      use resol_def
      use layout1
      use mpi_def
      implicit none
!!
      real(kind=kind_ior) x(lonr,latr)
      real (kind=kind_io8) xl(lonr,lats_node_r)
      real(kind=kind_ior) tmp(lonr,latr)
      integer global_lats_r(latr)
      integer nprocf,nodesr
!     integer maxfld,nprocf,nodesr
      integer proc,j,lat,nproc,i,buff,startlat,ierr
!     integer proc,j,lat,msgtag,nproc,i,msgtag1,buff,startlat,ierr
      integer ifld/0/
      save ifld
      real t1,t2,t3,t4,timef,ta,tb
c
c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
!!
      XL=0.
!     maxfld=50
      ifld=ifld+1
!!
      IF (icolor.eq.2.and.me.eq.nodes-1) THEN
        ta=timef()
        t3=ta
c        DO proc=1,nodes-1
         do proc=1,1
c
c         Sending the data
c         ----------------
         tmp=0.
         do j=1,latr
            do i=1,lonr
              tmp(i,j)=X(i,j)
            enddo
         enddo
!Moor    msgtag=1000+proc*nodes*maxfld+ifld
         t1=timef()
!sela    print *,' GWVX BROADCASTING FROM ',nodes-1
         call mpi_bcast
     1 (tmp,lonr*latr,MPI_R_IO_R,nodes-1,MPI_COMM_ALL,info)
         call mpi_comm_rank(MPI_COMM_ALL,i,info)
c         CALL mpi_send(tmp,lonr*latr,MPI_R_IO_R,proc-1,msgtag,
c     &                  MPI_COMM_ALL,info)
         t2=timef()
!sela    print 102,t2-t1
 
 102    format(' SEND TIME ',f10.5)
        enddo
        t4=timef()
      ELSE
        if (.NOT.LIOPE) then
          nodesr=nodes
        else
          nodesr=nodes+1
        endif
!Moor   msgtag=1000+(me+1)*nodesr*maxfld+ifld
!sela    print *,' GWVX BROADCASTREC  FROM ',nodesr-1
         call mpi_bcast
     1 (tmp,lonr*latr,MPI_R_IO_R,nodesr-1,MPI_COMM_ALL,info)
         call mpi_comm_rank(MPI_COMM_ALL,i,info)
!sela    print *,'GWVX IPT ',ipt
c        CALL mpi_recv(tmp,lonr*latr,MPI_R_IO_R,nodesr-1,
c     &                msgtag,MPI_COMM_ALL,stat,info)
        do j=1,lats_node_r
           lat=global_lats_r(ipt_lats_node_r-1+j)
           do i=1,lonr
              xl(i,j)=tmp(i,lat)
           enddo
        enddo
!!
      ENDIF
!!
!!     for pes nodes-1
      if (.NOT.LIOPE) then
        if (me.eq.nodes-1) then
          do j=1,lats_node_r
             lat=global_lats_r(ipt_lats_node_r-1+j)
             do i=1,lonr
                xl(i,j)=X(i,lat)
             enddo
          enddo
        endif
      endif
!!
      tb=timef()
         call mpi_comm_rank(MPI_COMM_ALL,i,info)
 
!sela  if(icolor.eq.2.and.me.eq.nodes-1)print 103,tb-ta,t4-t3
 103  format(' GLOBAL AND SEND TIMES  SPLIT2D',2f10.5)
      return
      end
      SUBROUTINE read_sfc_r(sfc_fld,NEEDORO,nread,
     &                    cfile,global_lats_r,lonsperlar)
!
!***********************************************************************
!
      use sfcio_module
      use resol_def
      use layout1
      use mpi_def
      use Sfc_Flx_ESMFMod
      use namelist_soilveg , only : salp_data, snupx
      use physcons, only : tgice => con_tice
      implicit none
!
      TYPE(Sfc_Var_Data)        :: sfc_fld
      integer              global_lats_r(latr)
      integer                 lonsperlar(latr)

      integer jump
      integer needoro

      real(kind=kind_ior) buff1(lonr,latr),buff2(lonr,latr,LSOIL)
!    &,    buff4(lonr,latr,4)
!     real(kind=kind_io4) xhour
c$$$     &     buff4(lonr,latr,4),slmskful(lonr,latr),xhour
      real(kind=kind_io8) buffo(lonr,lats_node_r)
      real(kind=kind_io8) buff3(lonr,lats_node_r)
      integer nread,i,j,k,ij,idate(4),lonsfc,latsfc,lplsfc(latr2)
      character*(*) cfile
      integer kmsk(lonr,latr),kmskcv(lonr,latr)
      CHARACTER*8 labfix(4)
c$$$      common /comfixio/slmskful
      real t1,t2,timef,rsnow
      type(sfcio_head) head
      type(sfcio_dbta) data
      integer iret, vegtyp
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
      t1=timef()

      IF (icolor.eq.2.and.me.eq.nodes-1) THEN
        call sfcio_srohdc(nread,cfile,head,data,iret)

        PRINT 99,nread,head%fhour,head%idate,
     &           head%lonb,head%latb,head%lsoil,head%ivs,iret
99      FORMAT(1H ,'in fixio nread=',i3,2x,'HOUR=',f8.2,3x,'IDATE=',
     &  4(1X,I4),4x,'lonsfc,latsfc,lsoil,ivssfc,iret=',5i8)

        if(iret.ne.0) goto 5000
!       if(head%ivs.ne.200412.and.head%ivs.ne.200501) goto 5000
        if(head%lonb.ne.lonr) goto 5000
        if(head%latb.ne.latr) goto 5000
        if(head%lsoil.ne.lsoil) goto 5000

      ENDIF

      kmsk=0

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tsea
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%TSEA,global_lats_r,lonsperlar)

      DO K=1, LSOIL
        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%smc(:,:,k)
        call split2d_r(buff1, buffo,global_lats_r)
        CALL interpred(1,kmsk,buffo,buff3,global_lats_r,lonsperlar)
        sfc_fld%SMC(k,:,:) = buff3(:,:)
      ENDDO

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%sheleg
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SHELEG,
     &               global_lats_r,lonsperlar)

      DO K = 1, LSOIL
        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%stc(:,:,k)
        call split2d_r(buff1, buffo,global_lats_r)
        CALL interpred(1,kmsk,buffo,buff3,global_lats_r,lonsperlar)
        sfc_fld%STC(k,:,:) = buff3(:,:)
      ENDDO

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tg3
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%TG3,global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%zorl
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ZORL,global_lats_r,lonsperlar)

      sfc_fld%cv  = 0
      sfc_fld%cvb = 0
      sfc_fld%cvt = 0

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alvsf
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALVSF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alvwf
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALVWF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alnsf
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALNSF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%alnwf
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%ALNWF,
     &               global_lats_r,lonsperlar)

!     The mask cannot be interpolated
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%slmsk
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SLMSK,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%vfrac
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%VFRAC,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%canopy
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%CANOPY,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%f10m
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%F10M,global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%vtype
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%VTYPE,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%stype
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%STYPE,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%facsf
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%FACSF,
     &               global_lats_r,lonsperlar)
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%facwf
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%FACWF,
     &               global_lats_r,lonsperlar)

!szunyogh 06/16/99
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%uustar
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%UUSTAR,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%ffmm
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%FFMM,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%ffhh
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%FFHH,
     &               global_lats_r,lonsperlar)

!c-- XW: FOR SEA-ICE Nov04
!    Sea-ice (hice/fice) was added to the surface files.

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%hice
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%HICE,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%fice
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%FICE,
     &               global_lats_r,lonsperlar)

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tisfc
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%tisfc,
     &               global_lats_r,lonsperlar)
      if (lats_node_r > 0 )  then
        if (sfc_fld%tisfc(1,1) < 0.0) then
          DO j=1,lats_node_r
            DO i=1,LONR
              sfc_fld%TISFC(i,j) = sfc_fld%TSEA(i,j)
              IF(sfc_fld%SLMSK(i,j) >=  2. .AND.
     &          sfc_fld%FICE(i,j)  >= 0.5) THEN
                sfc_fld%TISFC(i,j) = (sfc_fld%TSEA(i,j)
     &         -tgice*(1.-sfc_fld%FICE(i,j))) / sfc_fld%FICE(i,j)
                sfc_fld%TISFC(i,j) = MIN(sfc_fld%TISFC(i,j),tgice)
              ENDIF
            ENDDO
          ENDDO
        endif
      endif

!c-- XW: END SEA-ICE

!lu   11/10/2004
!*     surface files for GFS/Noah contain 8 additional records:
!*     tprcp, srflag, snwdph, slc, shdmin, shdmax, slope, snoalb

      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%tprcp
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%TPRCP,
     &               global_lats_r,lonsperlar)

!* srflag
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%srflag
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SRFLAG,
     &               global_lats_r,lonsperlar)

!* snwdph
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%snwdph
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SNWDPH,
     &               global_lats_r,lonsperlar)

!* slc
      DO K=1, LSOIL
        if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%slc(:,:,k)
        call split2d_r(buff1, buffo,global_lats_r)
        CALL interpred(1,kmsk,buffo,buff3,global_lats_r,lonsperlar)
        sfc_fld%SLC(k,:,:) = buff3(:,:)
      ENDDO

!* shdmin
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%shdmin
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SHDMIN,
     &               global_lats_r,lonsperlar)

!* shdmax
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%shdmax
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SHDMAX,
     &               global_lats_r,lonsperlar)

!* slope
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%slope
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SLOPE,
     &               global_lats_r,lonsperlar)

!* snoalb
      if(icolor.eq.2.and.me.eq.nodes-1) buff1=data%snoalb
      call split2d_r(buff1, buffo,global_lats_r)
      CALL interpred(1,kmsk,buffo,sfc_fld%SNOALB,
     &               global_lats_r,lonsperlar)
!lu [+67L]: the addition of 8 Noah records ends here .........................

      if(needoro.eq.1) then
        if(icolor.eq.2.and.me.eq.nodes-1) then
          buff1=data%orog
          needoro=1
          if(all(data%orog.ne.sfcio_realfill)) needoro=0
          print *,'read sfc orography'
        endif
        call split2d(buff1, buffo,global_lats_r)
        CALL interpred(1,kmsk,buffo,sfc_fld%ORO,
     &                 global_lats_r,lonsperlar)
        call skip(needoro)
      endif
!
!Wei initialize snow fraction(sheleg is in mm)
      DO j=1,lats_node_r
        DO i=1,LONR
          sfc_fld%SNCOVR(i,j) = 0.0
          if (sfc_fld%slmsk(i,j) > 0.001) then
            vegtyp = sfc_fld%VTYPE(i,j)
            if( vegtyp == 0 ) vegtyp = 7
            RSNOW  = 0.001*sfc_fld%SHELEG(i,j)/SNUPX(vegtyp)
            IF (0.001*sfc_fld%SHELEG(i,j) < SNUPX(vegtyp)) THEN
              sfc_fld%SNCOVR(i,j) = 1.0 - ( EXP(-SALP_DATA*RSNOW)
     &                                    - RSNOW*EXP(-SALP_DATA))
            ELSE
              sfc_fld%SNCOVR(i,j) = 1.0
            ENDIF
!          print*,SNUPX(vegtyp2d(i,j)),SALP_DATA,sfc_fld%SNCOVR(i,j),
!    & '************debug',SHELEG(i,j),vegtyp2d(i,j)
          endif
        ENDDO
       ENDDO
!

       IF (icolor.eq.2.and.me.eq.nodes-1) then
         call sfcio_axdbta(data,iret)
         t2=timef()
         print *,'FIXIO TIME ',t2-t1,t1,t2
       endif
!
      RETURN
 5000 PRINT *, ' ERROR IN INPUT IN FIXIO'
      STOP
      END
!
!***********************************************************************
!