flag_diag_update.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 flag_diag_update (FM, IM, SM, TM, WM, DGO, U, SV, &
                             OFRAC, ODIAG_GRID, K2M, OSURF_BUDGET, ORAD_BUDGET, OCOEF,  &
                             OSURF_VARS, KBEQ, KDSTEQ, ODIAG_OCEAN, ODIAG_MISC_SEAICE,  &
                             OWATER_PROFILE, OSURF_EVAP_BUDGET, OFLOOD,  OPGD_ISBA,     &
                             OCH_NO_FLUX_ISBA, OSURF_MISC_BUDGET_ISBA, OPGD_TEB,        &
                             OSURF_MISC_BUDGET_TEB    )
!     ############################################################
!
!!****  *FLAG_DIAG_UPDATE* - routine to modify selection of output fields
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      P. Le Moigne   *Meteo France*   
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    02/2008 
!
!       B.Decharme  10/2009 flag to desactivate writing of pgd 
!!      Modified    04/2013, P. Le Moigne: FLake chemistry
!!      Modified    01/2014, S. Senesi   : introduce sea-ice model
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surfex_n, ONLY : flake_model_t, isba_model_t, seaflux_model_t, &
                          teb_model_t, watflux_model_t
USE modd_diag_n, ONLY : diag_options_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_sv_n, ONLY : sv_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
TYPE(flake_model_t), INTENT(INOUT) :: FM
TYPE(isba_model_t), INTENT(INOUT) :: IM
TYPE(seaflux_model_t), INTENT(INOUT) :: SM
TYPE(teb_model_t), INTENT(INOUT) :: TM
TYPE(watflux_model_t), INTENT(INOUT) :: WM
!
TYPE(diag_options_t), INTENT(INOUT) :: DGO
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(sv_t), INTENT(INOUT) :: SV
!
LOGICAL, INTENT(IN) :: OFRAC
LOGICAL, INTENT(IN) :: ODIAG_GRID
INTEGER, INTENT(IN) :: K2M
LOGICAL, INTENT(IN) :: OSURF_BUDGET
LOGICAL, INTENT(IN) :: ORAD_BUDGET
LOGICAL, INTENT(IN) :: OCOEF
LOGICAL, INTENT(IN) :: OSURF_VARS
!
INTEGER, INTENT(IN) :: KBEQ
INTEGER, INTENT(IN) :: KDSTEQ
!
LOGICAL, INTENT(IN) :: ODIAG_OCEAN
LOGICAL, INTENT(IN) :: ODIAG_MISC_SEAICE
LOGICAL, INTENT(IN) :: OWATER_PROFILE
LOGICAL, INTENT(IN) :: OSURF_EVAP_BUDGET
LOGICAL, INTENT(IN) :: OFLOOD
LOGICAL, INTENT(IN) :: OSURF_MISC_BUDGET_ISBA
LOGICAL, INTENT(IN) :: OCH_NO_FLUX_ISBA
LOGICAL, INTENT(IN) :: OPGD_ISBA
LOGICAL, INTENT(IN) :: OSURF_MISC_BUDGET_TEB
LOGICAL, INTENT(IN) :: OPGD_TEB
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE',0,zhook_handle)
!
dgo%LFRAC = ofrac
dgo%LDIAG_GRID = odiag_grid
dgo%N2M = k2m
dgo%LSURF_BUDGET = osurf_budget
dgo%LRAD_BUDGET = orad_budget
dgo%LCOEF = ocoef
dgo%LSURF_VARS = osurf_vars
!
sv%NBEQ = kbeq
!
dgo%LSURF_BUDGETC = .false.
IF (.NOT.dgo%LRESET_BUDGETC) dgo%LSURF_BUDGETC = .true.
!
IF (u%CSEA   =='SEAFLX') CALL flag_sea_update(kbeq, odiag_ocean, odiag_misc_seaice, &
                                              dgo%LSURF_BUDGETC, dgo%LRAD_BUDGET, k2m)
IF (u%CWATER =='FLAKE ') CALL flag_flake_update(kbeq, owater_profile, dgo%LSURF_BUDGETC, dgo%LRAD_BUDGET, k2m)
IF (u%CWATER =='WATFLX') CALL flag_water_update(kbeq, dgo%LSURF_BUDGETC, dgo%LRAD_BUDGET, k2m)
IF (u%CNATURE=='ISBA  ') CALL flag_isba_update(kbeq, kdsteq, osurf_evap_budget, oflood, &
                                    opgd_isba, och_no_flux_isba, osurf_misc_budget_isba,&
                                    dgo%LSURF_BUDGETC, dgo%LRAD_BUDGET, k2m)
IF (u%CTOWN  =='TEB   ') CALL flag_teb_update(kbeq, opgd_teb, osurf_misc_budget_teb, dgo%LRAD_BUDGET, k2m)
!
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE',1,zhook_handle)
!-------------------------------------------------------------------------------
CONTAINS
!
SUBROUTINE flag_sea_update(KBEQ, ODIAG_OCEAN, ODIAG_MISC_SEAICE, OSURF_BUDGETC, ORAD_BUDGET, K2M)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KBEQ
LOGICAL, INTENT(IN) :: ODIAG_OCEAN
LOGICAL, INTENT(IN) :: ODIAG_MISC_SEAICE
LOGICAL, INTENT(IN) :: OSURF_BUDGETC
LOGICAL, INTENT(IN) :: ORAD_BUDGET
INTEGER, INTENT(IN) :: K2M
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_SEA_UPDATE',0,zhook_handle)
sm%CHS%SVS%NBEQ = kbeq
sm%SD%GO%LDIAG_OCEAN = odiag_ocean
sm%SD%DMI%LDIAG_MISC_SEAICE = odiag_misc_seaice
sm%SD%O%LSURF_BUDGETC = osurf_budgetc
sm%SD%O%LRAD_BUDGET = orad_budget
sm%SD%O%N2M = k2m
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_SEA_UPDATE',1,zhook_handle)
!
END SUBROUTINE flag_sea_update
!
SUBROUTINE flag_water_update(KBEQ, OSURF_BUDGETC, ORAD_BUDGET, K2M)
!
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KBEQ
LOGICAL, INTENT(IN) :: OSURF_BUDGETC
LOGICAL, INTENT(IN) :: ORAD_BUDGET
INTEGER, INTENT(IN) :: K2M
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_WATER_UPDATE',0,zhook_handle)
wm%CHW%SVW%NBEQ = kbeq
wm%DWO%LSURF_BUDGETC = osurf_budgetc
wm%DWO%LRAD_BUDGET = orad_budget
wm%DWO%N2M = k2m
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_WATER_UPDATE',1,zhook_handle)
!
END SUBROUTINE flag_water_update
!
SUBROUTINE flag_flake_update(KBEQ, OWATER_PROFILE, OSURF_BUDGETC, ORAD_BUDGET, K2M)
!
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KBEQ
LOGICAL, INTENT(IN) :: OWATER_PROFILE
LOGICAL, INTENT(IN) :: OSURF_BUDGETC
LOGICAL, INTENT(IN) :: ORAD_BUDGET
INTEGER, INTENT(IN) :: K2M
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_FLAKE_UPDATE',0,zhook_handle)
fm%CHF%SVF%NBEQ = kbeq
fm%DMF%LWATER_PROFILE = owater_profile
fm%DFO%LSURF_BUDGETC = osurf_budgetc
fm%DFO%LRAD_BUDGET = orad_budget
fm%DFO%N2M = k2m
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_FLAKE_UPDATE',1,zhook_handle)
!
END SUBROUTINE flag_flake_update
!
!
SUBROUTINE flag_isba_update(KBEQ, KDSTEQ, OSURF_EVAP_BUDGET, OFLOOD, &
                            OPGD, OCH_NO_FLUX, OSURF_MISC_BUDGET, &
                            OSURF_BUDGETC, ORAD_BUDGET, K2M)
!
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KBEQ
INTEGER, INTENT(IN) :: KDSTEQ
LOGICAL, INTENT(IN) :: OSURF_EVAP_BUDGET
LOGICAL, INTENT(IN) :: OFLOOD
LOGICAL, INTENT(IN) :: OPGD
LOGICAL, INTENT(IN) :: OCH_NO_FLUX
LOGICAL, INTENT(IN) :: OSURF_MISC_BUDGET
LOGICAL, INTENT(IN) :: OSURF_BUDGETC
LOGICAL, INTENT(IN) :: ORAD_BUDGET
INTEGER, INTENT(IN) :: K2M
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_ISBA_UPDATE',0,zhook_handle)
im%CHI%SVI%NBEQ = kbeq
im%CHI%SVI%NDSTEQ = kdsteq
im%ID%DE%LSURF_EVAP_BUDGET = osurf_evap_budget
im%O%LFLOOD = oflood
im%ID%O%LPGD = opgd
im%CHI%LCH_NO_FLUX = och_no_flux
im%ID%DM%LSURF_MISC_BUDGET = osurf_misc_budget
im%ID%O%LSURF_BUDGETC = osurf_budgetc
im%ID%O%LPATCH_BUDGET = osurf_budgetc
im%ID%O%LRAD_BUDGET = orad_budget
im%ID%O%N2M = k2m
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_ISBA_UPDATE',1,zhook_handle)
!
END SUBROUTINE flag_isba_update
!
SUBROUTINE flag_teb_update(KBEQ, OPGD, OSURF_MISC_BUDGET, ORAD_BUDGET, K2M)
!
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KBEQ
LOGICAL, INTENT(IN) :: OPGD
LOGICAL, INTENT(IN) :: OSURF_MISC_BUDGET
LOGICAL, INTENT(IN) :: ORAD_BUDGET
INTEGER, INTENT(IN) :: K2M
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_TEB_UPDATE',0,zhook_handle)
tm%CHT%SVT%NBEQ = kbeq
tm%TD%O%LPGD = opgd
tm%TD%MTO%LSURF_MISC_BUDGET = osurf_misc_budget
tm%TD%O%LRAD_BUDGET = orad_budget
tm%TD%O%N2M = k2m
IF (lhook) CALL dr_hook('FLAG_DIAG_UPDATE:FLAG_TEB_UPDATE',1,zhook_handle)
!
END SUBROUTINE flag_teb_update
!
END SUBROUTINE flag_diag_update