SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
get_sso_stdevn.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 get_sso_stdev_n (USS, &
7  hprogram,ki,psso_stdev)
8 ! ########################################
9 !
10 !!**** *GET_SSO_STDEV_n* - routine to get some surface fields
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !!** METHOD
16 !! ------
17 !!
18 !! EXTERNAL
19 !! --------
20 !!
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !! REFERENCE
26 !! ---------
27 !!
28 !!
29 !! AUTHOR
30 !! ------
31 !! S. Riette *Meteo France*
32 !!
33 !! MODIFICATIONS
34 !! -------------
35 !! Original 06/2010
36 !-------------------------------------------------------------------------------
37 !
38 !* 0. DECLARATIONS
39 ! ------------
40 !
41 !
43 !
44 USE modi_get_luout
45 USE modi_abor1_sfx
46 !
47 !
48 USE yomhook ,ONLY : lhook, dr_hook
49 USE parkind1 ,ONLY : jprb
50 !
51 IMPLICIT NONE
52 !
53 !* 0.1 Declarations of arguments
54 ! -------------------------
55 !
56 !
57 TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
58 !
59  CHARACTER(LEN=6), INTENT(IN) :: hprogram
60 INTEGER, INTENT(IN) :: ki ! horizontal dim. of cover
61 REAL, DIMENSION(KI), INTENT(OUT) :: psso_stdev ! S.S.O. standard deviation (m)
62 !
63 !
64 !* 0.2 Declarations of local variables
65 ! -------------------------------
66 !
67 INTEGER :: iluout
68 REAL(KIND=JPRB) :: zhook_handle
69 !
70 !-------------------------------------------------------------------------------
71 IF (lhook) CALL dr_hook('GET_SSO_STDEV_N',0,zhook_handle)
72  CALL get_luout(hprogram,iluout)
73 !-------------------------------------------------------------------------------
74 !
75 IF ( SIZE(psso_stdev) /= SIZE(uss%XSSO_STDEV) ) THEN
76  WRITE(iluout,*) 'try to get SSO_STDEV field from atmospheric model, but size is not correct'
77  WRITE(iluout,*) 'size of field expected by the atmospheric model (PSSO_STDEV) :', SIZE(psso_stdev)
78  WRITE(iluout,*) 'size of field inthe surface (XSSO_STDEV) :', SIZE(uss%XSSO_STDEV)
79  CALL abor1_sfx('GET_SSO_STDEVN: SSO_STDEV SIZE NOT CORRECT')
80 ELSE
81  psso_stdev = uss%XSSO_STDEV
82 END IF
83 IF (lhook) CALL dr_hook('GET_SSO_STDEV_N',1,zhook_handle)
84 !
85 !==============================================================================
86 !
87 END SUBROUTINE get_sso_stdev_n
subroutine get_sso_stdev_n(USS, HPROGRAM, KI, PSSO_STDEV)
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
subroutine get_luout(HPROGRAM, KLUOUT)
Definition: get_luout.F90:6