SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
get_surf_sizen.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_surf_size_n (DTCO, U, &
7  htype,kl)
8 ! #####################################################
9 !
10 !!**** *GET_SURF_SIZE_n* - routine to define the masks between all surface
11 !! points and each of the four surface types
12 !!
13 !! PURPOSE
14 !! -------
15 !!
16 !!** METHOD
17 !! -------
18 !!
19 !! REFERENCE
20 !! ---------
21 !!
22 !!
23 !! AUTHOR
24 !! ------
25 !! V. Masson *Meteo France*
26 !!
27 !! MODIFICATIONS
28 !! -------------
29 !! Original 01/2004
30 !-------------------------------------------------------------------------------
31 !
32 !* 0. DECLARATIONS
33 ! ------------
34 !
35 !
36 !
37 !
39 USE modd_surf_atm_n, ONLY : surf_atm_t
40 !
41 USE modi_convert_cover_frac
42 !
43 !
44 USE yomhook ,ONLY : lhook, dr_hook
45 USE parkind1 ,ONLY : jprb
46 !
47 IMPLICIT NONE
48 !
49 !* 0.1 Declarations of arguments
50 ! -------------------------
51 !
52 !
53 TYPE(data_cover_t), INTENT(INOUT) :: dtco
54 TYPE(surf_atm_t), INTENT(INOUT) :: u
55 !
56  CHARACTER(LEN=*), INTENT(IN) :: htype ! Type of surface
57 INTEGER, INTENT(OUT) :: kl ! number of points of this surface type
58 !
59 !* 0.2 Declarations of local variables
60 ! -------------------------------
61 !
62 REAL, DIMENSION(:), ALLOCATABLE :: zsea ! sea cover
63 REAL, DIMENSION(:), ALLOCATABLE :: znature! nature cover
64 REAL, DIMENSION(:), ALLOCATABLE :: ztown ! town cover
65 REAL, DIMENSION(:), ALLOCATABLE :: zwater ! water cover
66 !
67 INTEGER :: ilu ! total horizontal size
68 REAL(KIND=JPRB) :: zhook_handle
69 !-------------------------------------------------------------------------------
70 !
71 !* 1. Fractions
72 ! ---------
73 !
74 IF (lhook) CALL dr_hook('GET_SURF_SIZE_N',0,zhook_handle)
75 ilu = SIZE(u%XCOVER,1)
76 !
77 ALLOCATE(zsea(ilu))
78 ALLOCATE(znature(ilu))
79 ALLOCATE(ztown(ilu))
80 ALLOCATE(zwater(ilu))
81 IF (.NOT.ASSOCIATED(u%XSEA)) THEN
82  CALL convert_cover_frac(dtco, &
83  u%XCOVER,u%LCOVER,zsea,znature,ztown,zwater)
84 ELSE
85  zsea = u%XSEA
86  znature = u%XNATURE
87  zwater = u%XWATER
88  ztown = u%XTOWN
89 END IF
90 !
91 SELECT CASE (htype)
92  CASE ('FULL')
93  kl = ilu
94  !
95  CASE ('NATURE')
96  kl = count(znature(:) > 0.)
97  !
98  CASE ('SEA')
99  kl = count(zsea(:) > 0.)
100  !
101  CASE ('TOWN')
102  kl = count(ztown(:) > 0.)
103  !
104  CASE ('WATER')
105  !
106  kl = count(zwater(:) > 0.)
107  !
108  CASE ('LAND')
109  !
110  kl = count(znature(:) + ztown(:) > 0.)
111  !
112 END SELECT
113 !-------------------------------------------------------------------------------
114 DEALLOCATE(zsea )
115 DEALLOCATE(znature)
116 DEALLOCATE(ztown )
117 DEALLOCATE(zwater )
118 IF (lhook) CALL dr_hook('GET_SURF_SIZE_N',1,zhook_handle)
119 !-------------------------------------------------------------------------------
120 !
121 END SUBROUTINE get_surf_size_n
subroutine get_surf_size_n(DTCO, U, HTYPE, KL)
subroutine convert_cover_frac(DTCO, PCOVER, OCOVER, PSEA, PNATURE, PTOWN, PWATER)