coupling_surf_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 coupling_surf_topd (DE, DEC, DC, DMI, G, IO, S, K, NK, NP, NPE, UG, U, HPROGRAM, KI)
!###################################################################
!
!!****  *COUPLING_SURF_TOPD*  
!!
!!    PURPOSE
!!    -------
!!   
!!    Driver for the coupling between SURFEX and TOPODYN
!!      
!!    REFERENCE
!!    ---------
!!    *COUPLING_SURF_TRIP from B. Decharme
!!      
!!    AUTHOR
!!    ------
!!      B. Vincendon    
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/06/11 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
!
USE modd_diag_n, ONLY : diag_t
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
USE modd_sfx_grid_n, ONLY : grid_t
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_s_t, isba_k_t, isba_nk_t, isba_np_t, isba_npe_t
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modi_get_luout
USE modi_coupl_topd
USE modi_rout_data_isba
USE modi_budget_coupl_rout
USE modi_write_discharge_file
USE modi_write_budget_coupl_rout
USE modi_prep_restart_coupl_topd
!
USE modd_topodyn,       ONLY : xqtot, nnb_topd_step, xqb_run, xqb_dr
USE modd_coupling_topd, ONLY : lcoupl_topd, lbudget_topd, nnb_topd, ltopd_step, ntopd_step, &
                                 nyear,nmonth,nday,nh,nm
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(diag_t), INTENT(INOUT) :: DC
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DE
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEC
TYPE(diag_misc_isba_t), INTENT(INOUT) :: DMI
TYPE(grid_t), INTENT(INOUT) :: G
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_s_t), INTENT(INOUT) :: S
TYPE(isba_k_t), INTENT(INOUT) :: K
TYPE(isba_nk_t), INTENT(INOUT) :: NK
TYPE(isba_np_t), INTENT(INOUT) :: NP
TYPE(isba_npe_t), INTENt(INOUT) :: NPE
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
!
 CHARACTER(LEN=6), INTENT(IN)         :: HPROGRAM ! program calling surf. schemes
INTEGER,          INTENT(IN)         :: KI       ! Surfex grid dimension
                                                 ! in a forcing iteration
!
!*      0.2    declarations of local variables
!
 CHARACTER(LEN=3)              :: YSTEP    ! time stepsurf_tmp/off
INTEGER                       :: ILUOUT   ! unit of output listing file
INTEGER                       :: JJ       ! loop control
!
REAL, DIMENSION(KI)           :: ZDG_FULL
REAL, DIMENSION(KI)           :: ZWG2_FULL,ZWG3_FULL,ZDG2_FULL,ZDG3_FULL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('COUPLING_SURF_TOPD',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
IF ( .NOT.lcoupl_topd ) THEN
  IF (lhook) CALL dr_hook('COUPLING_SURF_TOPD',1,zhook_handle)
  RETURN
ENDIF
  !
IF ( ltopd_step ) THEN
  !
  ! * 1. Calling coupling or routing
  !
  IF (ntopd_step<10) THEN
    WRITE(ystep,'(I1)') ntopd_step
  ELSEIF (ntopd_step < 100) THEN
    WRITE(ystep,'(I2)') ntopd_step
  ELSE
    WRITE(ystep,'(I3)') ntopd_step
  ENDIF
  !
  write(iluout,*) 'pas de temps coupl ',ystep
  !
  IF (io%CRUNOFF=='TOPD') THEN
    CALL coupl_topd(dec, dc, dmi, g%XMESH_SIZE, io, s, k, nk, np, npe, &
                    ug, u, hprogram, ystep, ki, ntopd_step)
  ELSE
    CALL rout_data_isba(dec, dc, dmi, g%XMESH_SIZE, io, np, npe,  &
                        ug, u, hprogram, ki, ntopd_step)
  ENDIF
  !
  IF (lbudget_topd) CALL budget_coupl_rout(de, dec, dc, dmi, io, np, npe, u, ki, ntopd_step)
  !
endif! (LCOUPL_TOPD.AND......
!
IF (lhook) CALL dr_hook('COUPLING_SURF_TOPD',1,zhook_handle)
!-------------------------------------------------------------------------------
END SUBROUTINE coupling_surf_topd