init_ideal_flux.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_ideal_flux (DGO, D, DC, OREAD_BUDGETC, &
                                  HPROGRAM,HINIT,KI,KSV,KSW,     &
                                  HSV,PDIR_ALB,PSCA_ALB,        &
                                  PEMIS,PTSRAD,PTSURF, HTEST    )  
!     ############################################################
!
!!****  *INIT_IDEAL_FLUX * - Prescription of the surface fluxes for the temperature, 
!!    vapor, horizontal components of the wind and the scalar variables.   
!!
!!    PURPOSE
!!    -------
!       Give prescribed values of the surface fluxes for the potential 
!     temperature, the vapor, the horizontal components of the wind and the 
!     scalar variables. These fluxes are unsteady when a diurnal cycle 
!     is taken into account.
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!      J. Cuxart and J. Stein       * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/01/95 
!!      V. Masson      02/03  split the routine in two (initialization here, and run)
!!      R. Honnert     07/10  allows reading of data in namelist
!!      B. Decharme  04/2013 new coupling variables
!!      P. Le Moigne  03/2015 add diagnostics IDEAL case
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_diag_n, ONLY : diag_t, diag_options_t
!
USE modd_ideal_flux, ONLY : xsfts, xalb, xemis
USE modn_ideal_flux
USE modd_read_namelist, ONLY : lnam_read

USE modi_diag_ideal_init_n
USE modi_read_ideal_conf_n
USE modi_read_default_ideal_n
USE modi_prep_ctrl
USE modi_default_diag_ideal
USE modi_abor1_sfx
USE modi_get_luout
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   declarations of arguments
! 
!
TYPE(diag_options_t), INTENT(INOUT) :: DGO
TYPE(diag_t), INTENT(INOUT) :: D
TYPE(diag_t), INTENT(INOUT) :: DC
!
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
!
 CHARACTER(LEN=6),                 INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
 CHARACTER(LEN=3),                 INTENT(IN)  :: HINIT     ! choice of fields to initialize
INTEGER,                          INTENT(IN)  :: KI        ! number of points
INTEGER,                          INTENT(IN)  :: KSV       ! number of scalars
INTEGER,                          INTENT(IN)  :: KSW       ! number of short-wave spectral bands
 CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN)  :: HSV       ! name of all scalar variables
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB  ! direct albedo for each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB  ! diffuse albedo for each band
REAL,             DIMENSION(KI),  INTENT(OUT) :: PEMIS     ! emissivity
REAL,             DIMENSION(KI),  INTENT(OUT) :: PTSRAD    ! radiative temperature
REAL,             DIMENSION(KI),  INTENT(OUT) :: PTSURF    ! surface effective temperature         (K)
!
 CHARACTER(LEN=2),                 INTENT(IN)  :: HTEST       ! must be equal to 'OK'
!
!*       0.2   declarations of local variables
!
INTEGER           :: ISV    ! number of scalar variables
INTEGER           :: ILUOUT ! unit of output listing fie
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!         Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_IDEAL_FLUX',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!----------------------------------------------------------------------------------
IF (htest/='OK') THEN
  CALL abor1_sfx('INIT_IDEAL_FLUX: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
!----------------------------------------------------------------------------------
IF (lnam_read) THEN
 !
 !*       0.1    defaults
 !               --------
 !
 CALL default_diag_ideal(dgo%N2M, dgo%LSURF_BUDGET, dgo%L2M_MIN_ZS, dgo%LRAD_BUDGET,&
                         dgo%LCOEF, dgo%LSURF_VARS, dgo%LSURF_BUDGETC, &
                         dgo%LRESET_BUDGETC,dgo%XDIAG_TSTEP           )  

ENDIF
!----------------------------------------------------------------------------------
!
!*       0.2    configuration
!               -------------
!
 CALL read_default_ideal_n(dgo, hprogram)
 CALL read_ideal_conf_n(dgo, hprogram)
!
IF (.NOT.ALLOCATED(xtimef_f)) THEN

  ALLOCATE(xtimef_f(nforcf+1))
  ALLOCATE(xsfth_f(nforcf+1))
  ALLOCATE(xsftq_f(nforcf+1))
  ALLOCATE(xsfco2_f(nforcf+1))
  IF (custartype=='USTAR') ALLOCATE(xustar_f(nforcf+1))
!
  ALLOCATE(xtimet_t(nforct+1))
  ALLOCATE(xtsrad_t(nforct+1))
!
  xtimef_f(1:nforcf) = xtimef(1:nforcf)
  xsfth_f(1:nforcf) = xsfth(1:nforcf)
  xsftq_f(1:nforcf) = xsftq(1:nforcf)
  xsfco2_f(1:nforcf) = xsfco2(1:nforcf)
  IF (custartype=='USTAR') xustar_f(1:nforcf) = xustar(1:nforcf)
!
  xtimet_t(1:nforct) = xtimet(1:nforct)
  xtsrad_t(1:nforct) = xtsrad(1:nforct)
!
  xtimef_f(nforcf+1) = xtimef_f(nforcf)+1
  xsfth_f(nforcf+1) = xsfth_f(nforcf)
  xsftq_f(nforcf+1) = xsftq_f(nforcf)
  xsfco2_f(nforcf+1) = xsfco2_f(nforcf)
  IF (custartype=='USTAR') xustar_f(nforcf+1) = xustar_f(nforcf)
!
  xtimet_t(nforct+1) = xtimet(nforct)+1
  xtsrad_t(nforct+1) = xtsrad(nforct)
!
!----------------------------------------------------------------------------------
!
!*       0.3    control
!               -------
!
  IF (hinit=='PRE') THEN
    CALL prep_ctrl(dgo,iluout)  
  ENDIF
!
!----------------------------------------------------------------------------------
!i
!*       3.    HOURLY surface scalar mixing ratio fluxes (NFORCF+1 values per scalar from 00UTC to 24UTC)
!              -----------------------------------------
!
  isv = SIZE(hsv)
!
  IF(.NOT. ALLOCATED (xsfts) )ALLOCATE(xsfts(nforcf+1,isv))
!
!* unit: kg/m2/s
!
  xsfts = 0.
!
 CALL diag_ideal_init_n(dgo, d, dc, hprogram, oread_budgetc, ki, ksw)
!
ENDIF
!-------------------------------------------------------------------------------
!
!*       8.    Radiative outputs
!              -----------------
!
ptsrad   = xtsrad_t(1)
!
pdir_alb = xalb
psca_alb = xalb
pemis    = xemis
!
ptsurf   = ptsrad
!
!-------------------------------------------------------------------------------
!
!*       9.    Fluxes as diagnostics
!              ---------------------
!
IF (lhook) CALL dr_hook('INIT_IDEAL_FLUX',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE init_ideal_flux