SUBROUTINE WRTCLIM
USE PARKIND1  ,ONLY : JPIM     ,JPRB

!**** *WRTCLIM*  - writes fixed climate fields to NetCDF files

!     Purpose.
!     --------
!        writes out fixed climate fields

!**   Interface.
!     ----------
!        *CALL* *WRTCLIM

!     Explicit arguments :
!     --------------------


!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!        None

!     Reference.
!     ----------

!     Author.
!     -------
!        Bart vd Hurk (KNMI)

!     Modifications.
!     --------------
!        original: 14/7/2000

USE YOMLUN1S , ONLY : NPOSCLM  ,RMISS
USE YOMLOG1S , ONLY : LWRCLM   ,NACCUR   ,NDIMCDF
USE YOMGC1S  , ONLY : LMASK
USE YOEPHY   , ONLY : LEVGEN
USE YOESOIL1S, ONLY : RDAW     ,RWPWP    ,RWSAT , RWCAP,&
 & RWPWPM    ,RWSATM , RWCAPM
USE YOMDPHY  , ONLY : NLAT     ,NLON     ,NSLAB    ,NCSS,  NPOI &
     &  ,             ISLAB    ,NLALO    ,NSOTY , YDSURF
USE YOMGPD1S , ONLY : VFSOTY,VFCVL    ,VFCVH    ,VFTVL    ,VFTVH
USE MPL_MODULE
IMPLICIT NONE

!* Netcdf Interface
INTEGER NVARID,NPOS,IERR
INTEGER ISTART3(3)
INTEGER ICOUNT3(3)
REAL*4,ALLOCATABLE :: ZOUTPUT3S(:,:)
REAL*8,ALLOCATABLE :: ZOUTPUT3(:,:)

!* Local variables
REAL(KIND=JPRB),ALLOCATABLE :: ZVALUE(:),ZRVROOTSA(:,:),ZRVCOV(:)
INTEGER(KIND=JPIM) IPOS,ITYPL,ITYPH
LOGICAL LPOS
INTEGER(KIND=JPIM) :: IX1,IX2,IY1,IY2,NLEN,IST,IEN,JK,JL,JS
REAL(KIND=JPRB) :: ZCVL,ZCVH
INTERFACE
#include "surf_inq.h"
END INTERFACE
#include "netcdf.inc"

IF(NDIMCDF == 2)THEN
  IX1=1
  IX2=NLON
  IY1=(ISLAB-1)*NSLAB+1
  IY2=MIN(NLAT,ISLAB*NSLAB)
  NLEN=(IX2-IX1+1)*(IY2-IY1+1)
  IST=IX1+(IY1-1)*NLON
  IEN=IST+NLEN-1
ELSE
  IST=(ISLAB-1)*NSLAB+1
  IEN=MIN(NLALO,ISLAB*NSLAB)
  NLEN=IEN-IST+1
ENDIF
ALLOCATE (ZOUTPUT3(NLEN,NCSS))	!INFLATED OUTPUT ARRAY
ALLOCATE (ZOUTPUT3S(NLEN,NCSS))	!INFLATED OUTPUT ARRAY

!* ===============================================================
!     START OUTPUT
!* ===============================================================

IPOS=NPOSCLM
LPOS=LWRCLM

IF(NDIMCDF == 2)THEN
  ISTART3(1)=IX1
  ISTART3(2)=IY1
  ISTART3(3)=1
  ICOUNT3(1)=IX2-IX1+1
  ICOUNT3(2)=IY2-IY1+1
  ICOUNT3(3)=NCSS
ELSE
  ISTART3(1)=IST
  ISTART3(2)=1
  ICOUNT3(1)=NLEN
  ICOUNT3(2)=NCSS
ENDIF

ALLOCATE (ZVALUE(NPOI))

IF(LWRCLM)THEN
IF (.NOT.ALLOCATED(ZRVROOTSA)) ALLOCATE(ZRVROOTSA(NCSS,0:20))
IF (.NOT.ALLOCATED(ZRVCOV)) ALLOCATE(ZRVCOV(0:20))
!* -- The fixed variables
!******************************************************************
  IF (LEVGEN) THEN
    IF (.NOT.ALLOCATED(RWSATM)) ALLOCATE(RWSATM(0:NSOTY))
    IF (.NOT.ALLOCATED(RWCAPM)) ALLOCATE(RWCAPM(0:NSOTY))
    IF (.NOT.ALLOCATED(RWPWPM)) ALLOCATE(RWPWPM(0:NSOTY))
!EC     CALL SURF_INQ(YDSURF,PRVCOV=ZRVCOV,PRDAW=RDAW,PRWSATM=RWSATM,PRWCAPM=RWCAPM,PRWPWPM=RWPWPM,&
!EC                   PRVROOTSA=ZRVROOTSA)
      CALL SURF_INQ(PRVCOV=ZRVCOV,PRDAW=RDAW,PRWSATM=RWSATM,PRWCAPM=RWCAPM,PRWPWPM=RWPWPM,&
                    PRVROOTSA=ZRVROOTSA)

  ELSE
!EC     CALL SURF_INQ(YDSURF,PRVCOV=ZRVCOV,PRDAW=RDAW,PRWSAT=RWSAT,PRWCAP=RWCAP,PRWPWP=RWPWP,&
!EC                   PRVROOTSA=ZRVROOTSA)
    CALL SURF_INQ(PRVCOV=ZRVCOV,PRDAW=RDAW,PRWSAT=RWSAT,PRWCAP=RWCAP,PRWPWP=RWPWP,&
                  PRVROOTSA=ZRVROOTSA)
  ENDIF

  NPOS = NPOSCLM

!     soil depth
  NVARID = NCVID(NPOS,'SoilThick',IERR)
  DO JK=1,NCSS
    ZVALUE(:)=RDAW(JK)
    ZOUTPUT3(:,JK)= UNPACK(ZVALUE,LMASK(IST:IEN),RMISS)
  ENDDO
  IF(NACCUR == 1)THEN
    ZOUTPUT3S(:,:)=ZOUTPUT3(:,:)
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3S,IERR)
  ELSE
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3,IERR)
  ENDIF

!     field capacity
  NVARID = NCVID(NPOS,'SoilFC',IERR)
  IF(LEVGEN)THEN
    DO JL=1,NPOI
      JS=NINT(VFSOTY(JL))
      ZVALUE(JL)=RWCAPM(JS)
    ENDDO
  ELSE
    ZVALUE(:)=RWCAP
  ENDIF

  DO JK=1,NCSS
    ZOUTPUT3(:,JK)= UNPACK(ZVALUE,LMASK(IST:IEN),RMISS)
  ENDDO
  IF(NACCUR == 1)THEN
    ZOUTPUT3S(:,:)=ZOUTPUT3(:,:)
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3S,IERR)
  ELSE
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3,IERR)
  ENDIF

!     wilting point
  NVARID = NCVID(NPOS,'SoilWilt',IERR)
  IF(LEVGEN)THEN
    DO JL=1,NPOI
      JS=NINT(VFSOTY(JL))
      ZVALUE(JL)=RWPWPM(JS)
    ENDDO
  ELSE
    ZVALUE(:)=RWPWP
  ENDIF
  DO JK=1,NCSS
    ZOUTPUT3(:,JK)= UNPACK(ZVALUE,LMASK(IST:IEN),RMISS)
  ENDDO
  IF(NACCUR == 1)THEN
    ZOUTPUT3S(:,:)=ZOUTPUT3(:,:)
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3S,IERR)
  ELSE
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3,IERR)
  ENDIF

!     saturation
  NVARID = NCVID(NPOS,'SoilSat',IERR)
  IF(LEVGEN)THEN
    DO JL=1,NPOI
      JS=NINT(VFSOTY(JL))
      ZVALUE(JL)=RWSATM(JS)
    ENDDO
  ELSE
    ZVALUE(:)=RWSAT
  ENDIF
  DO JK=1,NCSS
    ZOUTPUT3(:,JK)= UNPACK(ZVALUE,LMASK(IST:IEN),RMISS)
  ENDDO
  IF(NACCUR == 1)THEN
    ZOUTPUT3S(:,:)=ZOUTPUT3(:,:)
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3S,IERR)
  ELSE
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3,IERR)
  ENDIF

  !     root fraction
  NVARID = NCVID(NPOS,'RootDist',IERR)
! !   do jl=0,20
! !     print*,'cov',jl,ZRVCOV(jl)
! !     do jk=1,ncss
! !       print*,'root',jk,ZRVROOTSA(JK,jl)
! !     enddo
! !   enddo
! ! call abort()
! !   print*,ZRVCOV
! !   print*,ZRVROOTSA
! !   print*,'**'
!   do jl=1,npoi
!     ITYPL=NINT(VFTVL(JL))
!     ITYPH=NINT(VFTVH(JL))
!     ZCVL=VFCVL(JL)*ZRVCOV(ITYPL)
!     ZCVH=VFCVH(JL)*ZRVCOV(ITYPH)
!     print*,jl,ITYPL,ZRVCOV(ITYPL),ZCVL
!     print*,jl,ITYPH,ZRVCOV(ITYPH),ZCVH
!   enddo
  DO JK=1,NCSS
!     print*,'jk1 ',jk
    ZVALUE(:) = 0._JPRB
    DO JL=1,NPOI
      ITYPL=NINT(VFTVL(JL))
      ITYPH=NINT(VFTVH(JL))
      ZCVL=VFCVL(JL)*ZRVCOV(ITYPL)
      ZCVH=VFCVH(JL)*ZRVCOV(ITYPH)
      IF((ZCVL > 0. .AND. ZRVROOTSA(JK,ITYPL) > 0.) .OR.&
         &(ZCVH > 0. .AND. ZRVROOTSA(JK,ITYPH) > 0.)) THEN
        ZVALUE(JL)=(ZCVL*ZRVROOTSA(JK,ITYPL)+ZCVH*ZRVROOTSA(JK,ITYPH))/(ZCVL+ZCVH)
      ENDIF
    ENDDO
!      print*,'jk2 ',jk
    ZOUTPUT3(:,JK)= UNPACK(ZVALUE,LMASK(IST:IEN),RMISS)
  ENDDO
  IF(NACCUR == 1)THEN
    ZOUTPUT3S(:,:)=ZOUTPUT3(:,:)
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3S,IERR)
  ELSE
    CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT3,IERR)
  ENDIF
ENDIf

DEALLOCATE (ZOUTPUT3)	!INFLATED OUTPUT ARRAY
DEALLOCATE (ZOUTPUT3S)	!INFLATED OUTPUT ARRAY
DEALLOCATE (ZVALUE)
IF (ALLOCATED(ZRVROOTSA)) DEALLOCATE(ZRVROOTSA)
IF (ALLOCATED(ZRVCOV)) DEALLOCATE(ZRVCOV)
RETURN
END SUBROUTINE WRTCLIM
