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 (DGL, OREAD_BUDGETC, &
                                  hprogram,hinit,                            &
                                   ki,ksv,ksw,                                &
                                   hsv,pco2,prhoa,                            &
                                   pzenith,pazim,psw_bands,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_ideal_n, ONLY : diag_ideal_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_ideal
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_ideal_t), INTENT(INOUT) :: dgl
!
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),  INTENT(IN)  :: pco2      ! CO2 concentration (kg/m3)
REAL,             DIMENSION(KI),  INTENT(IN)  :: prhoa     ! air density
REAL,             DIMENSION(KI),  INTENT(IN)  :: pzenith   ! solar zenithal angle
REAL,             DIMENSION(KI),  INTENT(IN)  :: pazim     ! solar azimuthal angle (rad from N, clock)
REAL,             DIMENSION(KSW), INTENT(IN)  :: psw_bands ! middle wavelength of each band
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(dgl%N2M,dgl%LSURF_BUDGET,dgl%L2M_MIN_ZS,dgl%LRAD_BUDGET,dgl%LCOEF,dgl%LSURF_VARS,&
                         dgl%LSURF_BUDGETC,dgl%LRESET_BUDGETC,dgl%XDIAG_TSTEP           )  

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

!$OMP SINGLE
  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))
!$OMP END SINGLE
!
  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_ideal(dgl%N2M,dgl%LSURF_BUDGET,dgl%L2M_MIN_ZS,dgl%LRAD_BUDGET,dgl%LCOEF,dgl%LSURF_VARS,&
                          iluout,dgl%LSURF_BUDGETC)  
  ENDIF
!
!----------------------------------------------------------------------------------
!
!*       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(dgl, 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