init_topd.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 init_topd(HPROGRAM)
!     #######################
!
!!****  *INIT_TOPD*  
!!
!!    PURPOSE
!!    -------
!     This routine aims at initialising the variables 
!     needed of running Topmodel.
!              
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    
!!    
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!      
!!    AUTHOR 
!!    ------
!!
!!      K. Chancibault  * LTHE / Meteo-France *
!!      B. Vincendon    * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   11/2006
!!      Modification 04/2007 : Supression of 2 arguments KSTEP,PSTEP 
!!                             that are now module arguments from MODD_TOPDDYN_n
!!                             NNB_TOPD_STEP,XTOPD_STEP
!!      Modification 11/2011 : Exfiltration option removed (B. Vincendon)
!!      Modification 03/2014 : common init_topd routine  called in init_topd_pgd
!!                             and init_topd_ol (B. Vincendon)
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_coupling_topd, ONLY : nnb_stp_restart
USE modd_topodyn,       ONLY : ccat, nncat, nnb_topd_step, xtopd_step,&
                               xdxt, nnxc, nnyc,&
                               xnul, xx0, xy0, nnpt,&
                               nx_step_rout, xspeedr,&
                               xspeedh, nnmc, nmesht, npmax,&
                               nline,  xdmaxt,&
                               xtopd, xdriv, xdhil, xtime_topd,&
                               xdgrd, xspeedg, xtime_topd_drain,&
                               xqtot, xtanb, xslop, xdarea,&
                               xlambda, xconn, xqb_dr, xqb_run
!
USE modd_topd_par, ONLY : ndim
USE modd_surf_par,       ONLY : xundef, nundef
!
USE modi_get_luout
USE modi_read_topd_header_dtm
USE modi_read_topd_file
USE modi_read_topd_header_connex
USE modi_read_connex_file
USE modi_read_slope_file
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
 CHARACTER(LEN=*), INTENT(IN) :: hprogram    !
!
!*      0.2    declarations of local variables
!
!
 CHARACTER(LEN=50), DIMENSION(NNCAT) :: yfiletop ! topographic file names
 CHARACTER(LEN=50), DIMENSION(NNCAT) :: yfilecon ! topographic file names
 CHARACTER(LEN=50), DIMENSION(NNCAT) :: yfileslo
 CHARACTER(LEN=50), DIMENSION(NNCAT) :: yfiledh
 CHARACTER(LEN=50), DIMENSION(NNCAT) :: yfiledr
INTEGER                   :: jj,jcat ! loop control 
INTEGER                   :: iluout                 ! Unit of the files
!
REAL, DIMENSION(:),ALLOCATABLE    :: ztopd_read !Topgraphic variable read
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('INIT_TOPD',0,zhook_handle)
!
!*       1    Initialization:
!               ---------------
!
 CALL get_luout(hprogram,iluout)
!
WRITE(iluout,*) 'INITIALISATION INIT_TOPD'
!
!
DO jcat=1,nncat
  yfiletop(jcat)=trim(ccat(jcat))//'_FilledDTM.map'
  yfilecon(jcat)=trim(ccat(jcat))//'_connections.vec'
  yfileslo(jcat)=trim(ccat(jcat))//'_slope.vec'
  yfiledr(jcat)=trim(ccat(jcat))//'_RiverDist.map'
  yfiledh(jcat)=trim(ccat(jcat))//'_HillDist.map'
ENDDO

ALLOCATE(nnmc(nncat))
nnmc(:)=0
ALLOCATE(nnxc(nncat))
nnxc(:)=0
ALLOCATE(nnyc(nncat))
nnyc(:)=0
ALLOCATE(xx0(nncat))
xx0(:)=0.0
ALLOCATE(xy0(nncat))
xy0(:)=0.0
ALLOCATE(nnpt(nncat))
nnpt(:)=0
ALLOCATE(xnul(nncat))
ALLOCATE(xdxt(nncat))
!
!
!*       2      Topographic files
!               -----------------------------
DO jcat=1,nncat
  CALL read_topd_header_dtm(hprogram,yfiletop(jcat),'FORMATTED',&
                            xx0(jcat),xy0(jcat),nnxc(jcat),nnyc(jcat),&
                            xnul(jcat),xdxt(jcat))
ENDDO
!
nnpt(:) = nnxc(:) * nnyc(:)
!
npmax = maxval(nnpt(:))
!
!
ALLOCATE(nline(nncat,npmax))
nline(:,:)=0
ALLOCATE(xtopd(nncat,npmax))
xtopd(:,:)=0.0
ALLOCATE(ztopd_read(npmax))
DO jcat = 1,nncat
  !
  CALL read_topd_file(hprogram,yfiletop(jcat),'FORMATTED',nnpt(jcat),ztopd_read)
  DO jj = 1,nnpt(jcat)
    xtopd(jcat,jj) = ztopd_read(jj) ! XTOPD can only be >=0
  ENDDO
  !
ENDDO
! for XTOPD, we do not have to use NLINE, all the pixels of the rectancle around
! the catchment are read.
!

!*      3       Connection files
!               ----------------
!
DO jcat=1,nncat
  CALL read_topd_header_connex(hprogram,yfilecon(jcat),'FORMATTED',nnmc(jcat))
ENDDO
!
nmesht=maxval(nnmc(:))
!
ALLOCATE(xconn(nncat,nmesht,ndim))
xconn(:,:,:)=0.0
!
DO jcat=1,nncat
  CALL read_connex_file(hprogram,yfilecon(jcat),'FORMATTED',nnmc(jcat),xconn(jcat,:,:),nline(jcat,:))
ENDDO

!
!*       4      Slope files
!               -----------
  ALLOCATE(xtanb(nncat,nmesht))
  ALLOCATE(xslop(nncat,nmesht))
  ALLOCATE(xdarea(nncat,nmesht))
  ALLOCATE(xlambda(nncat,nmesht))
  !
  DO jcat=1,nncat
    CALL read_slope_file(hprogram,yfileslo(jcat),'FORMATTED',nnmc(jcat),&
                       xtanb(jcat,:),xslop(jcat,:),xdarea(jcat,:),xlambda(jcat,:))
  ENDDO
  !
ALLOCATE(xdriv(nncat,npmax))
xdriv(:,:)=0.0
ALLOCATE(xdhil(nncat,npmax))
xdhil(:,:)=0.0
ALLOCATE(xdgrd(nncat,npmax))
xdgrd(:,:)=0.0
ALLOCATE(xqtot(nncat,nnb_topd_step))
xqtot(:,:)=0.0
!
!*     5          River Distance file
  !               -------------------
  !
  DO jcat=1,nncat
    CALL  read_topd_file(hprogram,yfiledr(jcat),'FORMATTED',nnpt(jcat),ztopd_read)
    DO jj=1,npmax
      IF ( nline(jcat,jj)/=0. .AND. nline(jcat,jj)/=xundef ) &
       xdriv(jcat,nline(jcat,jj)) = ztopd_read(jj)
    ENDDO
  ENDDO
  ! for XDRIV, we must use NLINE, online pixels inside de the catchment are read.
  !
  !*      6       Hillslope Distance file
  !  -----------------------
  !
  DO jcat=1,nncat
    CALL  read_topd_file(hprogram,yfiledh(jcat),'FORMATTED',nnpt(jcat),ztopd_read)
    DO jj=1,npmax
      IF ( nline(jcat,jj)/=0. .AND. nline(jcat,jj)/=xundef ) &
        xdhil(jcat,nline(jcat,jj)) = ztopd_read(jj)
    ENDDO
  ENDDO
  !
  ! for XDHIL, we must use NLINE, online pixels inside de the catchment are read.
  xdgrd(:,:) = xdhil(:,:)

IF (lhook) CALL dr_hook('INIT_TOPD',1,zhook_handle)
!
END SUBROUTINE init_topd