init_topd_ol.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_ol(HPROGRAM)
!     #######################
!
!!****  *INIT_TOPD_OL*  
!!
!!    PURPOSE
!!    -------
!     This routine aims at initialising the variables 
!     needed of running Topmodel for OFFLINE step.
!              
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    
!!    
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!      
!!    AUTHOR 
!!    ------
!!
!!      B. Vincendon    * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   03/2014
!-------------------------------------------------------------------------------
!
!*       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_init_topd
USE modi_read_topd_header_dtm
USE modi_read_topd_file
USE modi_read_topd_header_connex
USE modi_read_connex_file
USE modi_open_file
USE modi_close_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
!
!
INTEGER                   :: ji,jj,jcat,jo ! loop control 
INTEGER                   :: iover                  ! Unit of the files
INTEGER                   :: iluout                 ! Unit of the files
INTEGER                   :: ios
!
 CHARACTER(LEN=28) :: yfile
!
REAL   :: ztmp !Temporary variable read
!
REAL :: zdhil  ! distance along slope
REAL :: zdriv  ! distance along rivers
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('INIT_TOPD_OL',0,zhook_handle)
!


!*       1    Initialization:
!               ---------------
!
 CALL get_luout(hprogram,iluout)
!
WRITE(iluout,*) 'INITIALISATION INIT_TOPD_OL'
!
 CALL init_topd('ASCII ')
!
  !*      2       Calculations for routing by geomorpho
  !               -------------------------------------
  !
  ALLOCATE(nx_step_rout(nncat))
  ALLOCATE(xtime_topd(nncat,nmesht))
  ALLOCATE(xtime_topd_drain(nncat,nmesht))
  !
  xtime_topd(:,:) = 0.0
  xtime_topd_drain(:,:) = 0.0
  !
  !
  DO jcat=1,nncat
    !
    IF ( xspeedr(jcat)/=0. .AND. xspeedg(jcat)/=0. ) THEN
      WHERE ( xdhil(jcat,1:nnmc(jcat))/=xundef .AND. xdriv(jcat,1:nnmc(jcat))/=xundef ) &
        xtime_topd(jcat,1:nnmc(jcat)) = xdhil(jcat,1:nnmc(jcat)) / xspeedh(jcat) + &
                                        xdriv(jcat,1:nnmc(jcat)) / xspeedr(jcat)
      WHERE ( xdgrd(jcat,1:nnmc(jcat))/=xundef .AND. xdriv(jcat,1:nnmc(jcat))/=xundef ) &
        xtime_topd_drain(jcat,1:nnmc(jcat)) = xdgrd(jcat,1:nnmc(jcat)) / xspeedg(jcat) + &
                                              xdriv(jcat,1:nnmc(jcat)) / xspeedr(jcat)
    ELSE 
      WRITE(iluout,*) 'You have to choose some values for routing velocities'
    ENDIF
    !
    IF (xtopd_step/=0.) &
      nx_step_rout(jcat) = int(maxval(xtime_topd(jcat,1:nnmc(jcat))) / xtopd_step) + 1
    !
  ENDDO
  !
  IF ( nnb_stp_restart==0 ) nnb_stp_restart = max(nnb_topd_step,maxval(nx_step_rout(:)))
  !
  !
  ALLOCATE(xqb_dr(nncat,nnb_topd_step))
  xqb_dr(:,:)=0.0
  ALLOCATE(xqb_run(nncat,nnb_topd_step))
  xqb_run(:,:)=0.0
  !

!
IF (lhook) CALL dr_hook('INIT_TOPD_OL',1,zhook_handle)
!
END SUBROUTINE init_topd_ol