SURFEX v8.1
General documentation of Surfex
update_esm_seafluxn.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! ###################################################################
6  SUBROUTINE update_esm_seaflux_n (S, KI,KSW,PZENITH,PDIR_ALB, &
7  PSCA_ALB,PEMIS,PTSRAD,PTSURF )
8 ! ##############################################################
9 !
10 !!**** *UPDATE_ESM_SEAFLUX_n* - routine to update SEAFLUX radiative and physical properties in
11 !! Earth System Model after the call to OASIS coupler in order
12 !! to close the energy budget between radiative scheme and surfex
13 !!
14 !! PURPOSE
15 !! -------
16 !!
17 !!** METHOD
18 !! ------
19 !!
20 !! EXTERNAL
21 !! --------
22 !!
23 !!
24 !! IMPLICIT ARGUMENTS
25 !! ------------------
26 !!
27 !! REFERENCE
28 !! ---------
29 !!
30 !!
31 !! AUTHOR
32 !! ------
33 !! B. Decharme
34 !!
35 !! MODIFICATIONS
36 !! -------------
37 !! Original 09/2009
38 !! B. Decharme 06/2013 new coupling variables
39 !-------------------------------------------------------------------------------
40 !
41 !* 0. DECLARATIONS
42 ! ------------
43 !
44 !
45 USE modd_seaflux_n, ONLY : seaflux_t
46 !
47 USE modd_csts, ONLY : xtts
48 !
49 USE modi_update_rad_sea
50 !
51 !
52 USE yomhook ,ONLY : lhook, dr_hook
53 USE parkind1 ,ONLY : jprb
54 !
55 IMPLICIT NONE
56 !
57 !* 0.1 Declarations of arguments
58 ! -------------------------
59 !
60 !
61 TYPE(seaflux_t), INTENT(INOUT) :: S
62 !
63 INTEGER, INTENT(IN) :: KI ! number of points
64 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
65 !
66 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle
67 !
68 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band
69 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band
70 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity
71 REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature
72 REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K)
73 !
74 !
75 !* 0.2 Declarations of local variables
76 ! -------------------------------
77 !
78 REAL(KIND=JPRB) :: ZHOOK_HANDLE
79 !
80 !-------------------------------------------------------------------------------
81 !
82 !
83 !* Albedo and emissivity on open sea and sea ice
84 ! ---------------------------------------------
85 !
86 IF (lhook) CALL dr_hook('UPDATE_ESM_SEAFLUX_N',0,zhook_handle)
87 !
88  CALL update_rad_sea(s,pzenith,xtts,pdir_alb,psca_alb,pemis,ptsrad )
89 !
90 ptsurf(:) = s%XSST(:)
91 !
92 IF (lhook) CALL dr_hook('UPDATE_ESM_SEAFLUX_N',1,zhook_handle)
93 !
94 !-------------------------------------------------------------------------------
95 !
96 END SUBROUTINE update_esm_seaflux_n
real, save xtts
Definition: modd_csts.F90:68
integer, parameter jprb
Definition: parkind1.F90:32
subroutine update_rad_sea(S, PZENITH, PTT, PDIR_ALB_ATMOS, PSCA_ALB_ATMOS, PEMIS_ATMOS, PTRAD, PU, PV)
subroutine update_esm_seaflux_n(S, KI, KSW, PZENITH, PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, PTSURF)
logical lhook
Definition: yomhook.F90:15