read_assim_conf.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_assim_conf(HPROGRAM)
!     #######################################################
!
!!****  *READ_ASSIM_CONF* - routine to read the configuration for assimilation
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      T. Aspelien met.no
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    04/2012 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE mode_pos_surf, ONLY : posnam
USE modn_assim,    ONLY : nam_nacveg,nam_assim,lassim,cassim,&
                          nam_io_varassim,nam_obs,nam_var,nam_ens
USE modd_assim,    ONLY : nvar,nobstype,xtprt,xtprt_m,xsigma,&
                          xsigma_m,cvar,cvar_m,cobs,nnco,&
                          nvarmax,nncv,lassim,cassim_isba,lprt,&
                          nobsmax,xerrobs_m,xerrobs, &
                          xqcobs_m,xqcobs,&
                          xinfl_m,xinfl,xaddinfl_m,xaddinfl, &
                          xaddtimecorr_m, xaddtimecorr, nie, &
                          cfile_format_obs
USE yomhook,       ONLY : lhook,dr_hook
USE parkind1,      ONLY : jprb

USE modi_get_luout
USE modi_open_namelist
USE modi_test_nam_var_surf  
USE modi_close_namelist
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! program calling

!
!*       0.2   Declarations of local variables
!              -------------------------------
!
!
LOGICAL           :: gfound         ! Return code when searching namelist
INTEGER           :: iluout         ! logical unit of output file
INTEGER           :: inam           ! logical unit of namelist file
INTEGER           :: i,j
REAL(KIND=JPRB)   :: zhook_handle
!-------------------------------------------------------------------------------
!
!* get output listing file logical unit
!
IF (lhook) CALL dr_hook('READ_ASSIM_CONF',0,zhook_handle)
 CALL get_luout(hprogram,iluout)

!* open namelist file
 CALL open_namelist(hprogram,inam)

!* reading of namelist
 CALL posnam(inam,'NAM_ASSIM',      gfound,iluout)
IF (gfound) READ(unit=inam,nml=nam_assim)
 CALL posnam(inam,'NAM_NACVEG',     gfound,iluout)
IF (gfound) READ(unit=inam,nml=nam_nacveg)
 CALL posnam(inam,'NAM_IO_VARASSIM',gfound,iluout)
IF (gfound) READ(unit=inam,nml=nam_io_varassim)
 CALL posnam(inam,'NAM_OBS',        gfound,iluout)
IF (gfound) READ(unit=inam,nml=nam_obs)
 CALL posnam(inam,'NAM_VAR',        gfound,iluout)
IF (gfound) READ(unit=inam,nml=nam_var)
 CALL posnam(inam,'NAM_ENS',        gfound,iluout)
IF (gfound) READ(unit=inam,nml=nam_ens)
!
 CALL test_nam_var_surf(iluout,'CASSIM',cassim,'PLUS ','2DVAR','AVERA')
 CALL test_nam_var_surf(iluout,'CASSIM_ISBA',cassim_isba,'OI   ','EKF  ','ENKF ')
!
!* close namelist file
 CALL close_namelist(hprogram,inam)

! Set EKF setup based on namelist input
IF ( ( cassim_isba == "EKF" .AND. ( lassim.OR.lprt ) ) .OR. &
     ( cassim_isba == "ENKF" .AND. ( lassim.OR.nie/=0 ) ) ) THEN
  !
  IF (.NOT.ALLOCATED(xtprt))   ALLOCATE (xtprt(nvar))
  IF (.NOT.ALLOCATED(xsigma))  ALLOCATE (xsigma(nvar))
  IF (.NOT.ALLOCATED(cvar))    ALLOCATE (cvar(nvar))
  !
  IF (sum(nncv) /= nvar) THEN
    WRITE(*,*) 'INCONSISTENCY in set-up of CONTROL VARIABLES',sum(nncv),nvar
    CALL abor1_sfx('INCONSISTENCY in set-up of CONTROL VARIABLES')
  ENDIF
  !
  j = 1
  DO i = 1,nvarmax
    IF (nncv(i) == 1 .AND. j <= nvar ) THEN
      xtprt(j) = xtprt_m(i)
      xsigma(j) = xsigma_m(i)
      cvar(j) = cvar_m(i)
      j = j + 1
    ENDIF
  ENDDO
ENDIF

IF ( ( cassim_isba == "EKF" .AND. ( lassim.OR.lprt ) ) .OR. &
     ( cassim_isba == "ENKF" .AND. ( lassim.OR.nie/=0 ) ) .OR. (trim(cfile_format_obs) == "ASCII") ) THEN

  IF (sum(nnco) /= nobstype) THEN
    WRITE(*,*) 'INCONSISTENCY in set-up of OBSERVATIONS',sum(nnco),nobstype
    CALL abor1_sfx('INCONSISTENCY in set-up ofOBSERVATIONS')
  ENDIF
  !
  IF (.NOT.ALLOCATED(cobs)) ALLOCATE (cobs(nobstype))
  cobs(:) = ''
  IF (.NOT.ALLOCATED(xerrobs)) ALLOCATE (xerrobs(nobstype))
  IF (.NOT.ALLOCATED(xqcobs))  ALLOCATE (xqcobs(nobstype))
  j = 1
  DO i = 1,nobsmax
    IF (nnco(i) == 1 .AND. j <= nobstype ) THEN
      SELECT CASE (i)
        CASE (1)   
          cobs(j) = 'T2M'
        CASE (2)
          cobs(j) = 'HU2M'
        CASE (3)
          cobs(j) = 'WG1'
        CASE (4) 
          cobs(j) = 'LAI'
        CASE (5)
          cobs(j) = 'SWE'
       END SELECT
       xerrobs(j) = xerrobs_m(i)
       xqcobs(j) = xqcobs_m(i)
       j = j + 1
    ENDIF
  ENDDO
ENDIF
 
IF ( cassim_isba == "ENKF" .AND. ( lassim.OR.nie/=0 ) ) THEN
  !
  IF (.NOT.ALLOCATED(xinfl)) ALLOCATE (xinfl(nvar))
  IF (.NOT.ALLOCATED(xaddinfl)) ALLOCATE (xaddinfl(nvar))
  IF (.NOT.ALLOCATED(xaddtimecorr)) ALLOCATE (xaddtimecorr(nvar))
  !
  j = 1
  DO i = 1,nvarmax
    IF (nncv(i) == 1 .AND. j <= nvar ) THEN
      xinfl(j) = xinfl_m(i)
      xaddinfl(j) = xaddinfl_m(i)
      xaddtimecorr(j) = xaddtimecorr_m(i)
      j = j + 1
    ENDIF
  ENDDO
  !
ENDIF

IF (lhook) CALL dr_hook('READ_ASSIM_CONF',1,zhook_handle)
END SUBROUTINE read_assim_conf