SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
prep_flake_unif.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 prep_flake_unif(KLUOUT,HSURF,PFIELD)
7 ! #################################################################################
8 !
9 !!**** *PREP_FLAKE_UNIF* - prepares FLAKE field from prescribed values
10 !!
11 !! PURPOSE
12 !! -------
13 !
14 !!** METHOD
15 !! ------
16 !!
17 !! REFERENCE
18 !! ---------
19 !!
20 !!
21 !! AUTHOR
22 !! ------
23 !! S. Malardel
24 !!
25 !! MODIFICATIONS
26 !! -------------
27 !! Original 01/2004
28 !! 09/2010 E. Kourzeneva: Renamed the lake surface temperature
29 !! from the namelist
30 !!------------------------------------------------------------------
31 !
32 !
33 USE modd_prep, ONLY : cinterp_type
34 USE modd_prep_flake, ONLY : xts_unif, &
35  xunif_t_snow , &
36  xunif_t_ice , &
37  xunif_t_mnw , &
38  xunif_t_wml , &
39  xunif_t_bot , &
40  xunif_t_b1 , &
41  xunif_ct , &
42  xunif_h_snow , &
43  xunif_h_ice , &
44  xunif_h_ml , &
45  xunif_h_b1
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 INTEGER, INTENT(IN) :: kluout ! output listing logical unit
56  CHARACTER(LEN=7), INTENT(IN) :: hsurf ! type of field
57 REAL, POINTER, DIMENSION(:,:) :: pfield ! field to interpolate horizontally
58 REAL(KIND=JPRB) :: zhook_handle
59 !
60 !* 0.2 declarations of local variables
61 !
62 !
63 !-------------------------------------------------------------------------------------
64 !
65 IF (lhook) CALL dr_hook('PREP_FLAKE_UNIF',0,zhook_handle)
66 SELECT CASE(hsurf)
67 !
68 !* 3.0 Orography
69 !
70  CASE('ZS ')
71  ALLOCATE(pfield(1,1))
72  pfield = 0.
73 !
74 !* 3.1 FLake variables
75 !
76  CASE('TS ')
77  ALLOCATE(pfield(1,1))
78  pfield = xts_unif
79 !
80  CASE('T_SNOW ')
81  ALLOCATE(pfield(1,1))
82  pfield = xunif_t_snow
83 !
84  CASE('T_ICE ')
85  ALLOCATE(pfield(1,1))
86  pfield = xunif_t_ice
87 !
88  CASE('T_MNW ')
89  ALLOCATE(pfield(1,1))
90  pfield = xunif_t_mnw
91 !
92  CASE('T_WML ')
93  ALLOCATE(pfield(1,1))
94  pfield = xunif_t_wml
95 !
96  CASE('T_BOT ')
97  ALLOCATE(pfield(1,1))
98  pfield = xunif_t_bot
99 !
100  CASE('T_B1 ')
101  ALLOCATE(pfield(1,1))
102  pfield = xunif_t_b1
103 !
104  CASE('CT ')
105  ALLOCATE(pfield(1,1))
106  pfield = xunif_ct
107 !
108  CASE('H_SNOW ')
109  ALLOCATE(pfield(1,1))
110  pfield = xunif_h_snow
111 !
112  CASE('H_ICE ')
113  ALLOCATE(pfield(1,1))
114  pfield = xunif_h_ice
115 !
116  CASE('H_ML ')
117  ALLOCATE(pfield(1,1))
118  pfield = xunif_h_ml
119 !
120  CASE('H_B1 ')
121  ALLOCATE(pfield(1,1))
122  pfield = xunif_h_b1
123 !
124 !
125 END SELECT
126 !
127 !* 4. Interpolation method
128 ! --------------------
129 !
130  cinterp_type='UNIF '
131 IF (lhook) CALL dr_hook('PREP_FLAKE_UNIF',1,zhook_handle)
132 !
133 !
134 !-------------------------------------------------------------------------------------
135 END SUBROUTINE prep_flake_unif
subroutine prep_flake_unif(KLUOUT, HSURF, PFIELD)