SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
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, &
7  ki,ksw,pzenith,pdir_alb, &
8  psca_alb,pemis,ptsrad,ptsurf )
9 ! ##############################################################
10 !
11 !!**** *UPDATE_ESM_SEAFLUX_n* - routine to update SEAFLUX radiative and physical properties in
12 !! Earth System Model after the call to OASIS coupler in order
13 !! to close the energy budget between radiative scheme and surfex
14 !!
15 !! PURPOSE
16 !! -------
17 !!
18 !!** METHOD
19 !! ------
20 !!
21 !! EXTERNAL
22 !! --------
23 !!
24 !!
25 !! IMPLICIT ARGUMENTS
26 !! ------------------
27 !!
28 !! REFERENCE
29 !! ---------
30 !!
31 !!
32 !! AUTHOR
33 !! ------
34 !! B. Decharme
35 !!
36 !! MODIFICATIONS
37 !! -------------
38 !! Original 09/2009
39 !! B. Decharme 06/2013 new coupling variables
40 !-------------------------------------------------------------------------------
41 !
42 !* 0. DECLARATIONS
43 ! ------------
44 !
45 !
46 USE modd_seaflux_n, ONLY : seaflux_t
47 !
48 USE modd_csts, ONLY : xtts
49 !
50 USE modi_update_rad_sea
51 !
52 !
53 USE yomhook ,ONLY : lhook, dr_hook
54 USE parkind1 ,ONLY : jprb
55 !
56 IMPLICIT NONE
57 !
58 !* 0.1 Declarations of arguments
59 ! -------------------------
60 !
61 !
62 TYPE(seaflux_t), INTENT(INOUT) :: s
63 !
64 INTEGER, INTENT(IN) :: ki ! number of points
65 INTEGER, INTENT(IN) :: ksw ! number of short-wave spectral bands
66 !
67 REAL, DIMENSION(KI), INTENT(IN) :: pzenith ! solar zenithal angle
68 !
69 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: pdir_alb ! direct albedo for each band
70 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: psca_alb ! diffuse albedo for each band
71 REAL, DIMENSION(KI), INTENT(OUT) :: pemis ! emissivity
72 REAL, DIMENSION(KI), INTENT(OUT) :: ptsrad ! radiative temperature
73 REAL, DIMENSION(KI), INTENT(OUT) :: ptsurf ! surface effective temperature (K)
74 !
75 !
76 !* 0.2 Declarations of local variables
77 ! -------------------------------
78 !
79 REAL(KIND=JPRB) :: zhook_handle
80 !
81 !-------------------------------------------------------------------------------
82 !
83 !
84 !* Albedo and emissivity on open sea and sea ice
85 ! ---------------------------------------------
86 !
87 IF (lhook) CALL dr_hook('UPDATE_ESM_SEAFLUX_N',0,zhook_handle)
88 !
89  CALL update_rad_sea(s%CSEA_ALB,s%XSST,pzenith,xtts,s%XEMIS,s%XDIR_ALB,&
90  s%XSCA_ALB,pdir_alb,psca_alb,pemis,ptsrad )
91 !
92 ptsurf(:) = s%XSST(:)
93 !
94 IF (lhook) CALL dr_hook('UPDATE_ESM_SEAFLUX_N',1,zhook_handle)
95 !
96 !-------------------------------------------------------------------------------
97 !
98 END SUBROUTINE update_esm_seaflux_n
subroutine update_rad_sea(HALB, PSST, PZENITH, PTT, PEMIS, PDIR_ALB, PSCA_ALB, PDIR_ALB_ATMOS, PSCA_ALB_ATMOS, PEMIS_ATMOS, PTRAD, OHANDLE_SIC, PTICE, PSIC, PICE_ALB, PU, PV)
subroutine update_esm_seaflux_n(S, KI, KSW, PZENITH, PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, PTSURF)