read_isban.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE read_isba_n (DTCO, I, U, &
                              hprogram)
!     ##################################
!
!!****  *READ_ISBA_n* - routine to initialise ISBA variables
!!                         
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003
!!
!!      READ_SURF for general reading : 08/2003 (S.Malardel)
!!      B. Decharme  2008    : Floodplains
!!      B. Decharme  01/2009 : Optional Arpege deep soil temperature read
!!      A.L. Gibelin   03/09 : modifications for CENTURY model 
!!      A.L. Gibelin    04/2009 : BIOMASS and RESP_BIOMASS arrays 
!!      A.L. Gibelin    06/2009 : Soil carbon variables for CNT option
!!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
!!      T. Aspelien  08/2013 : Read diagnostics for assimilation
!!      P. Samuelsson   10/2014 : MEB
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_isba_n, ONLY : isba_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_co2v_par,       ONLY : xanfminit, xcondctmin
!                          
USE modd_assim,          ONLY : lassim,cassim_isba,xat2m_isba,xahu2m_isba,&
                                xazon10m_isba,xamer10m_isba,nific,nvar, &
                                cobs,nobstype,cvar,lprt,xtprt,nivar,cbio, &
                                xaddinfl,nens,xsigma,nie
!                                
USE modd_surf_par,       ONLY : xundef, nundef
USE modd_snow_par,       ONLY : xz0sn
!
USE modi_read_surf
!
USE modi_read_gr_snow
USE modi_abor1_sfx
USE modi_io_buff
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_get_type_dim_n
USE mode_random
USE mode_ekf
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! calling program
!
!*       0.2   Declarations of local variables
!              -------------------------------
INTEGER           :: ilu          ! 1D physical dimension
!
INTEGER           :: iresp          ! Error code after redding
!
 CHARACTER(LEN=12) :: yrecfm         ! Name of the article to be read
!
 CHARACTER(LEN=4)  :: ylvl
!
REAL, DIMENSION(:,:,:),ALLOCATABLE :: zlai
REAL, DIMENSION(:,:),ALLOCATABLE  :: zwork      ! 2D array to write data in file
REAL, DIMENSION(:), ALLOCATABLE :: zcofswi
!
REAL,DIMENSION(I%NPATCH) :: zvlaimin
REAL :: zcoef
!
INTEGER :: iwork   ! Work integer
!
INTEGER :: jp, jl, jnbiomass, jnlitter, jnsoilcarb, jnlittlevs  ! loop counter on layers
INTEGER :: jvar, ji
!
INTEGER           :: iversion       ! surface version
INTEGER           :: ibugfix
INTEGER           :: iivar
INTEGER           :: iobs
INTEGER           :: ibsup
INTEGER           :: isize_lmeb_patch
!
LOGICAL :: gknown
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!
!* 1D physical dimension
!
IF (lhook) CALL dr_hook('READ_ISBA_N',0,zhook_handle)
yrecfm='SIZE_NATURE'
 CALL get_type_dim_n(dtco, u, &
                     'NATURE',ilu)
!
!
!*       2.     Prognostic fields:
!               -----------------
!
ALLOCATE(zwork(ilu,i%NPATCH))
!* soil temperatures
!
IF(i%LTEMP_ARP)THEN
  iwork=i%NTEMPLAYER_ARP
ELSEIF(i%CISBA=='DIF')THEN
  iwork=i%NGROUND_LAYER
ELSE
  iwork=2 !Only 2 temperature layer in ISBA-FR
ENDIF
!
IF ( trim(cassim_isba)=="ENKF") THEN
  ALLOCATE(i%XRED_NOISE(ilu,i%NPATCH,nvar))
  i%XRED_NOISE(:,:,:) = 0.
  ALLOCATE(zcofswi(ilu))
  CALL cofswi(i%XCLAY(:,1),zcofswi)
ELSE
  ALLOCATE(i%XRED_NOISE(0,0,0))
  ALLOCATE(zcofswi(0))
ENDIF
!
ALLOCATE(i%XTG(ilu,iwork,i%NPATCH))
i%XTG(:,:,:)=xundef
!
DO jl=1,iwork
  WRITE(ylvl,'(I4)') jl
  yrecfm='TG'//adjustl(ylvl(:len_trim(ylvl)))
  CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
  i%XTG(:,jl,:)=zwork(:,:)
END DO
!
! Perturb value if requested
IF ( trim(cassim_isba)=="EKF" .AND. lprt ) THEN
  !
  DO jl=1,iwork
  ! read in control variable
    IF ( (trim(cvar(nivar))=="TG1" .AND. jl==1) .OR. &
         (trim(cvar(nivar))=="TG2" .AND. jl==2) ) THEN
      WHERE ( i%XTG(:,jl,:)/=xundef )
        i%XTG(:,jl,:) = i%XTG(:,jl,:) + xtprt(nivar)*i%XTG(:,jl,:)
      ENDWHERE
    ENDIF
  END DO
  !
ELSEIF ( trim(cassim_isba)=="ENKF" .AND. nie<nens+1 ) THEN
  !
  CALL make_ens_enkf(iwork,ilu,"TG ",zcofswi,i%XTG,i%XRED_NOISE)
  !
ENDIF
!
!
!* soil liquid and ice water contents
!
ALLOCATE(i%XWG (ilu,i%NGROUND_LAYER,i%NPATCH))
ALLOCATE(i%XWGI(ilu,i%NGROUND_LAYER,i%NPATCH))
!
i%XWG (:,:,:)=xundef
i%XWGI(:,:,:)=xundef
!
DO jl=1,i%NGROUND_LAYER
  WRITE(ylvl,'(I4)') jl
  yrecfm='WG'//adjustl(ylvl(:len_trim(ylvl)))
   CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
   i%XWG(:,jl,:)=zwork(:,:)
END DO
!
! Perturb value if requested
IF ( trim(cassim_isba)=="EKF" .AND. lprt ) THEN
   !
   DO jl=1,i%NGROUND_LAYER
    ! read in control variable
    IF ( (trim(cvar(nivar))=="WG1" .AND. jl==1) .OR. & 
         (trim(cvar(nivar))=="WG2" .AND. jl==2) ) THEN
      WHERE ( i%XWG(:,jl,:)/=xundef )
        i%XWG(:,jl,:) = i%XWG(:,jl,:) + xtprt(nivar)*i%XWG(:,jl,:)
      ENDWHERE
    ENDIF
   END DO
   !
ELSEIF ( trim(cassim_isba)=="ENKF" .AND. nie<nens+1 ) THEN
  !
  CALL make_ens_enkf(iwork,ilu,"WG ",zcofswi,i%XWG,i%XRED_NOISE)
  !
ENDIF
!
IF(i%CISBA=='DIF')THEN
  iwork=i%NGROUND_LAYER
ELSE
  iwork=2 !Only 2 soil ice layer in ISBA-FR
ENDIF
!
DO jl=1,iwork
  WRITE(ylvl,'(I4)') jl
  yrecfm='WGI'//adjustl(ylvl(:len_trim(ylvl)))
  CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
  i%XWGI(:,jl,:)=zwork(:,:)
END DO
!
!* water intercepted on leaves
!
ALLOCATE(i%XWR(ilu,i%NPATCH))
!
yrecfm = 'WR'
 CALL read_surf(&
                 hprogram,yrecfm,i%XWR(:,:),iresp)
!
!* Leaf Area Index
!
IF (i%CPHOTO=='LAI' .OR. i%CPHOTO=='LST' .OR. i%CPHOTO=='NIT' .OR. i%CPHOTO=='NCB') THEN
  yrecfm = 'LAI'
  CALL read_surf(&
                 hprogram,yrecfm,i%XLAI(:,:),iresp)
  IF ( trim(cassim_isba)=="EKF" .AND. lprt ) THEN
    !
    ! read in control variable
    IF ( trim(cvar(nivar))=="LAI" ) THEN
      WHERE ( i%XLAI(:,:)/=xundef ) 
        i%XLAI(:,:) = i%XLAI(:,:) + xtprt(nivar)*i%XLAI(:,:)
      ENDWHERE
    ENDIF
    !
  ELSEIF ( trim(cassim_isba)=="ENKF" .AND. nie<nens+1 ) THEN
    !
    IF (i%NPATCH==12) THEN
      zvlaimin = (/0.3,0.3,0.3,0.3,1.0,1.0,0.3,0.3,0.3,0.3,0.3,0.3/)
    ELSE
      zvlaimin = (/0.3/)
    ENDIF
    !
    ALLOCATE(zlai(ilu,1,i%NPATCH))
    zlai(:,1,:) = i%XLAI(:,:)
    CALL make_ens_enkf(1,ilu,"LAI",zcofswi,zlai,i%XRED_NOISE)
    DO jp = 1,i%NPATCH
      i%XLAI(:,jp) = max(zvlaimin(jp),zlai(:,1,jp))
    ENDDO
    DEALLOCATE(zlai)
    !    
  ENDIF  
END IF
!
!* snow mantel
!
 CALL read_gr_snow(&
                   hprogram,'VEG','     ',ilu,i%NPATCH,i%TSNOW  )
!
yrecfm='VERSION'
 CALL read_surf(&
                 hprogram,yrecfm,iversion,iresp)
!
yrecfm='BUG'
 CALL read_surf(&
                 hprogram,yrecfm,ibugfix,iresp)
!
IF(i%LGLACIER)THEN
  ALLOCATE(i%XICE_STO(ilu,i%NPATCH))
  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=2) THEN
    yrecfm = 'ICE_STO'
    CALL read_surf(&
                 hprogram,yrecfm,i%XICE_STO(:,:),iresp)
  ELSE
    i%XICE_STO(:,:) = 0.0
  ENDIF
ELSE
  ALLOCATE(i%XICE_STO(0,0))
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       3.  MEB Prognostic or Semi-prognostic variables
!            -------------------------------------------
!
isize_lmeb_patch=count(i%LMEB_PATCH(:))
!
IF (isize_lmeb_patch>0) THEN
!
!* water intercepted on litter

 ALLOCATE(i%XWRL(ilu,i%NPATCH))
 yrecfm = 'WRL'
 CALL read_surf(hprogram,yrecfm,i%XWRL(:,:),iresp)

 ALLOCATE(i%XWRLI(ilu,i%NPATCH))
 yrecfm = 'WRLI'
 CALL read_surf(hprogram,yrecfm,i%XWRLI(:,:),iresp)
!
!* snow intercepted on vegetation canopy leaves
!
  ALLOCATE(i%XWRVN(ilu,i%NPATCH))
  yrecfm = 'WRVN'
  CALL read_surf(&
                 hprogram,yrecfm,i%XWRVN(:,:),iresp)
!
!* vegetation canopy temperature
!
  ALLOCATE(i%XTV(ilu,i%NPATCH))
  yrecfm = 'TV'
  CALL read_surf(hprogram,yrecfm,i%XTV(:,:),iresp)
!
!* litter temperature
!
  ALLOCATE(i%XTL(ilu,i%NPATCH))
  yrecfm = 'TL'
  CALL read_surf(hprogram,yrecfm,i%XTL(:,:),iresp)
!
!* vegetation canopy air temperature
!
  ALLOCATE(i%XTC(ilu,i%NPATCH))
  yrecfm = 'TC'
  CALL read_surf(&
                 hprogram,yrecfm,i%XTC(:,:),iresp)
!
!* vegetation canopy air specific humidity
!
  ALLOCATE(i%XQC(ilu,i%NPATCH))
  yrecfm = 'QC'
  CALL read_surf(&
                 hprogram,yrecfm,i%XQC(:,:),iresp)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       4.  Semi-prognostic variables
!            -------------------------
!
ALLOCATE(i%XRESA(ilu,i%NPATCH))
ALLOCATE(i%XLE  (ilu,i%NPATCH))
IF (i%CPHOTO/='NON') THEN
  ALLOCATE(i%XANFM  (ilu,i%NPATCH))
  ALLOCATE(i%XAN    (ilu,i%NPATCH))
  ALLOCATE(i%XANDAY (ilu,i%NPATCH))
END IF
!
IF(i%CPHOTO/='NON') THEN
  ALLOCATE(i%XBIOMASS         (ilu,i%NNBIOMASS,i%NPATCH))
  ALLOCATE(i%XRESP_BIOMASS    (ilu,i%NNBIOMASS,i%NPATCH))
END IF
!
!
!* aerodynamical resistance
!
yrecfm = 'RESA'
i%XRESA(:,:) = 100.
 CALL read_surf(&
                 hprogram,yrecfm,i%XRESA(:,:),iresp)
!
!* patch averaged radiative temperature (K)
!
ALLOCATE(i%XTSRAD_NAT(ilu))
IF (iversion<6) THEN
  i%XTSRAD_NAT(:)=0.
  DO jp=1,i%NPATCH
    i%XTSRAD_NAT(:)=i%XTSRAD_NAT(:)+i%XTG(:,1,jp)
  ENDDO
  i%XTSRAD_NAT(:)=i%XTSRAD_NAT(:)/i%NPATCH
ELSE
  yrecfm='TSRAD_NAT'
  CALL read_surf(&
                 hprogram,yrecfm,i%XTSRAD_NAT(:),iresp)
ENDIF
!
i%XLE(:,:) = xundef
!
!*       5. ISBA-AGS variables
!
IF (i%CPHOTO/='NON') THEN
  yrecfm = 'AN'
  i%XAN(:,:) = 0.
  CALL read_surf(&
                 hprogram,yrecfm,i%XAN(:,:),iresp)
  !
  yrecfm = 'ANDAY'
  i%XANDAY(:,:) = 0.
  CALL read_surf(&
                 hprogram,yrecfm,i%XANDAY(:,:),iresp)
  !
  yrecfm = 'ANFM'
  i%XANFM(:,:) = xanfminit
  CALL read_surf(&
                 hprogram,yrecfm,i%XANFM(:,:),iresp)
  !
  yrecfm = 'LE_AGS'
  i%XLE(:,:) = 0.
  CALL read_surf(&
                 hprogram,yrecfm,i%XLE(:,:),iresp)
END IF
!
IF (i%CPHOTO=='AGS' .OR. i%CPHOTO=='AST') THEN
  !
  i%XBIOMASS(:,:,:) = 0.
  i%XRESP_BIOMASS(:,:,:) = 0.

ELSEIF (i%CPHOTO=='LAI' .OR. i%CPHOTO=='LST') THEN
  !
  i%XBIOMASS(:,1,:) = i%XBSLAI(:,:) * i%XLAI(:,:)
  i%XRESP_BIOMASS(:,:,:) = 0.

ELSEIF (i%CPHOTO=='NIT'.OR.i%CPHOTO=='NCB') THEN
  !
  i%XBIOMASS(:,:,:) = 0.
  DO jnbiomass=1,i%NNBIOMASS
    WRITE(ylvl,'(I1)') jnbiomass
    IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) THEN
      yrecfm='BIOMA'//adjustl(ylvl(:len_trim(ylvl)))
    ELSE
      yrecfm='BIOMASS'//adjustl(ylvl(:len_trim(ylvl)))
    ENDIF
    CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
    IF ( trim(cassim_isba)=="EKF" .AND. lprt ) THEN
      ! read in control variable
      IF ( trim(cvar(nivar)) == "LAI" .AND. trim(cbio)==trim(yrecfm) ) THEN
        WHERE ( zwork(:,:)/=xundef ) 
          zwork(:,:) = zwork(:,:) + xtprt(nivar)*zwork(:,:)
        ENDWHERE
      ENDIF
    ELSEIF ( trim(cassim_isba)=="ENKF" .AND. nie<nens+1 .AND. .NOT.lassim ) THEN
      !
      IF ( trim(cbio)==trim(yrecfm) ) THEN
        DO jvar = 1,nvar
          IF (trim(cvar(jvar)) == "LAI") THEN
            DO ji = 1,ilu
              DO jp = 1,i%NPATCH
                zwork(ji,jp) = zwork(ji,jp) + xaddinfl(jvar)*random_normal()
              ENDDO
            ENDDO
            EXIT
          ENDIF
        ENDDO
      ENDIF
      !      
    ENDIF     
    i%XBIOMASS(:,jnbiomass,:)=zwork
  END DO
!
  iwork=0
  IF(i%CPHOTO=='NCB'.OR.iversion<8)iwork=2
!
  i%XRESP_BIOMASS(:,:,:) = 0.
  DO jnbiomass=2,i%NNBIOMASS-iwork
    WRITE(ylvl,'(I1)') jnbiomass
    IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=3)) THEN
      yrecfm='RESPI'//adjustl(ylvl(:len_trim(ylvl)))
    ELSE
      yrecfm='RESP_BIOM'//adjustl(ylvl(:len_trim(ylvl)))
    ENDIF    
    CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
    IF ( trim(cassim_isba)=="EKF" .AND. lprt ) THEN
      ! read in control variable
      IF ( trim(cvar(nivar)) == "LAI" .AND. trim(cbio)==trim(yrecfm) ) THEN
        WHERE ( zwork(:,:)/=xundef ) 
          zwork(:,:) = zwork(:,:) + xtprt(nivar)*zwork(:,:)
        ENDWHERE
    ELSEIF ( trim(cassim_isba)=="ENKF" .AND. nie<nens+1 .AND. .NOT.lassim ) THEN
      !
      IF ( trim(cbio)==trim(yrecfm) ) THEN
        DO jvar = 1,nvar
          IF (trim(cvar(jvar)) == "LAI") THEN
            DO ji = 1,ilu
              DO jp = 1,i%NPATCH
                zwork(ji,jp) = zwork(ji,jp) + xaddinfl(jvar)*random_normal()
              ENDDO
            ENDDO
            EXIT
          ENDIF
        ENDDO
      ENDIF
      !  
      ENDIF
    ENDIF      
    i%XRESP_BIOMASS(:,jnbiomass,:)=zwork
  END DO
  !
ENDIF
!
DEALLOCATE(zcofswi)
!
!*       6. Soil carbon
!
!
IF (i%CRESPSL=='CNT') THEN
  !
  ALLOCATE(i%XLITTER          (ilu,i%NNLITTER,i%NNLITTLEVS,i%NPATCH))
  ALLOCATE(i%XSOILCARB        (ilu,i%NNSOILCARB,i%NPATCH))
  ALLOCATE(i%XLIGNIN_STRUC    (ilu,i%NNLITTLEVS,i%NPATCH))
  !
  i%XLITTER(:,:,:,:) = 0.
  DO jnlitter=1,i%NNLITTER
    DO jnlittlevs=1,i%NNLITTLEVS
      WRITE(ylvl,'(I1,A1,I1)') jnlitter,'_',jnlittlevs
      yrecfm='LITTER'//adjustl(ylvl(:len_trim(ylvl)))
      CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
      i%XLITTER(:,jnlitter,jnlittlevs,:)=zwork
    END DO
  END DO

  i%XSOILCARB(:,:,:) = 0.
  DO jnsoilcarb=1,i%NNSOILCARB
    WRITE(ylvl,'(I4)') jnsoilcarb
    yrecfm='SOILCARB'//adjustl(ylvl(:len_trim(ylvl)))
    CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
    i%XSOILCARB(:,jnsoilcarb,:)=zwork
  END DO
!
  i%XLIGNIN_STRUC(:,:,:) = 0.
  DO jnlittlevs=1,i%NNLITTLEVS
    WRITE(ylvl,'(I4)') jnlittlevs
    yrecfm='LIGNIN_STR'//adjustl(ylvl(:len_trim(ylvl)))
    CALL read_surf(&
                 hprogram,yrecfm,zwork(:,:),iresp)
    i%XLIGNIN_STRUC(:,jnlittlevs,:)=zwork
  END DO
!
ENDIF

IF ( lassim ) THEN
  IF ( trim(cassim_isba) == "OI" ) THEN
    IF ( i%NPATCH /= 1 ) CALL abor1_sfx('Reading of diagnostical values for'&
                       & //'assimilation at the moment only works for one patch for OI')          
    ! Diagnostic fields for assimilation
    IF ( .NOT. ALLOCATED(xat2m_isba)) ALLOCATE(xat2m_isba(ilu,1))
    xat2m_isba=xundef
    yrecfm='T2M'
    CALL io_buff(yrecfm,'R',gknown)
    CALL read_surf(&
                 hprogram,yrecfm,xat2m_isba(:,1),iresp)

    IF ( .NOT. ALLOCATED(xahu2m_isba)) ALLOCATE(xahu2m_isba(ilu,1))
    xahu2m_isba=xundef
    yrecfm='HU2M'
    CALL io_buff(yrecfm,'R',gknown)
    CALL read_surf(&
                 hprogram,yrecfm,xahu2m_isba(:,1),iresp)

    IF ( .NOT. ALLOCATED(xazon10m_isba)) ALLOCATE(xazon10m_isba(ilu,1))
    xazon10m_isba=xundef
    yrecfm='ZON10M'
    CALL io_buff(yrecfm,'R',gknown)
    CALL read_surf(&
                 hprogram,yrecfm,xazon10m_isba(:,1),iresp)

    IF ( .NOT. ALLOCATED(xamer10m_isba)) ALLOCATE(xamer10m_isba(ilu,1))
    xamer10m_isba=xundef
    yrecfm='MER10M'
    CALL io_buff(yrecfm,'R',gknown)
    CALL read_surf(&
                 hprogram,yrecfm,xamer10m_isba(:,1),iresp)
  ELSEIF ( nific/=nvar+2 ) THEN
    ! Diagnostic fields for EKF assimilation ("observations")
    DO iobs = 1,nobstype
     SELECT CASE (trim(cobs(iobs)))
       CASE("T2M")
         IF ( .NOT. ALLOCATED(xat2m_isba)) ALLOCATE(xat2m_isba(ilu,1))
         xat2m_isba=xundef
         yrecfm='T2M'
         CALL io_buff(yrecfm,'R',gknown)
         CALL read_surf(&
                 hprogram,yrecfm,xat2m_isba(:,1),iresp)
       CASE("HU2M")
         IF ( .NOT. ALLOCATED(xahu2m_isba)) ALLOCATE(xahu2m_isba(ilu,1))
         xahu2m_isba=xundef
         yrecfm='HU2M'
         CALL io_buff(yrecfm,'R',gknown)
         CALL read_surf(&
                 hprogram,yrecfm,xahu2m_isba(:,1),iresp)
       CASE("WG1")
         ! This is already read above
       CASE("LAI")
         ! This is already read above   
       CASE("SWE")
         ! This is handled independently 
       CASE default
         CALL abor1_sfx("Mapping of "//trim(cobs(iobs))//" is not defined in READ_ISBA_n!")
     END SELECT
    ENDDO
  ENDIF
ENDIF
!
DEALLOCATE(zwork)
!
IF (lhook) CALL dr_hook('READ_ISBA_N',1,zhook_handle)
!
 CONTAINS
!
SUBROUTINE make_ens_enkf(KWORK,KLU,HREC,PCOFSWI,PVAR,PRED_NOISE)
!
USE modd_assim, ONLY : lens_gen, xaddtimecorr, xaddinfl, xassim_winh
!
USE modi_add_noise
USE mode_random
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: kwork
INTEGER, INTENT(IN) :: klu
 CHARACTER(LEN=3), INTENT(IN) :: hrec
REAL, DIMENSION(:), INTENT(IN) :: pcofswi
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: pvar
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: pred_noise
!
 CHARACTER(LEN=12) :: yrecfm         ! Name of the article to be read
 CHARACTER(LEN=4) :: ylvl
 CHARACTER(LEN=3) :: yvar
REAL :: zwhite_noise, zvar0
INTEGER :: jl, ji, jp, ivar
LOGICAL :: gpass
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('READ_ISBA_N:MAKE_ENS_ENKF',0,zhook_handle)
!
!
DO jl=1,kwork
  !
  IF (kwork>1) THEN
    WRITE(ylvl,'(I4)') jl
    yrecfm = trim(hrec)//adjustl(ylvl(:len_trim(ylvl)))
  ELSE
    yrecfm = trim(hrec)
  ENDIF
  !
  ivar = 0
  DO jvar = 1,nvar
    gpass = ( trim(cvar(jvar))==trim(yrecfm) )
    IF (gpass) THEN
      ivar = jvar
      EXIT
    ENDIF
  ENDDO
  !
  IF ( gpass ) THEN
    !
    IF (xaddinfl(ivar)>0.) THEN
      !
      IF (lassim) THEN
        !
        WRITE(yvar,'(I3)') ivar
        yrecfm='RED_NOISE'//adjustl(yvar(:len_trim(yvar)))
        CALL read_surf(hprogram,yrecfm,pred_noise(:,:,ivar),iresp)
        !
      ELSEIF (.NOT.lens_gen .AND. xaddtimecorr(ivar)>0. ) THEN
        !
        WRITE(yvar,'(I3)') ivar
        yrecfm='RED_NOISE'//adjustl(yvar(:len_trim(yvar)))
        CALL read_surf(hprogram,yrecfm,pred_noise(:,:,ivar),iresp)
        !
        DO ji = 1,klu
          DO jp = 1,i%NPATCH
            zwhite_noise = xaddinfl(ivar)*pcofswi(ji)*random_normal()
            CALL add_noise(xaddtimecorr(ivar),xassim_winh,zwhite_noise,pred_noise(ji,jp,ivar))
         ENDDO
         ENDDO
        !
        zcoef = xassim_winh/24.
        !
      ELSE
        !
        DO ji = 1,ilu
          DO jp = 1,i%NPATCH 
            pred_noise(ji,jp,ivar) = xaddinfl(ivar)*pcofswi(ji)*random_normal()
          ENDDO
        ENDDO
        !
        zcoef = 1. 
        !
      ENDIF
      !
      IF (.NOT.lassim) THEN
        !
        DO ji = 1,ilu
          DO jp = 1,i%NPATCH
            IF ( pvar(ji,jl,jp)/=xundef ) THEN
              !
              zvar0 = pvar(ji,jl,jp)
              !
              pvar(ji,jl,jp) = pvar(ji,jl,jp) + zcoef * pred_noise(ji,jp,ivar)
              !
              IF (pvar(ji,jl,jp) < 0.) THEN
                IF (lens_gen) THEN
                  pvar(ji,jl,jp) = abs(pvar(ji,jl,jp))
                ELSE
                  pvar(ji,jl,jp) = zvar0
                ENDIF
              ENDIF
            ENDIF
          ENDDO
        ENDDO
        !
      ENDIF
      !
    ENDIF
    !
  ENDIF
  !
ENDDO
!
IF (lhook) CALL dr_hook('READ_ISBA_N:MAKE_ENS_ENKF',1,zhook_handle)
!
END SUBROUTINE make_ens_enkf
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_isba_n