3f839515a174daed5f1a6ff3515f39a206419239
[MNH-git_open_source-lfs.git] / src / SURFEX / read_flaken.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE READ_FLAKE_n(HPROGRAM)
7 !     #########################################
8 !
9 !!****  *READ_FLAKE_n* - reads FLAKE variables
10 !! 
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 !!      V. Masson   *Meteo France*      
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original    01/2003 
36 !-------------------------------------------------------------------------------
37 !
38 !*       0.    DECLARATIONS
39 !              ------------
40 !
41 USE MODD_FLAKE_n,      ONLY : XTS, &
42                                 XT_SNOW, &
43                                 XT_ICE , &
44                                 XT_MNW , &
45                                 XT_WML , &
46                                 XT_BOT , &
47                                 XT_B1  , &
48                                 XCT    , &
49                                 XH_SNOW, &
50                                 XH_ICE , &
51                                 XH_ML  , &
52                                 XH_B1  , &
53                                 XZ0    , &
54                                 XUSTAR  
55
56
57 !
58 USE MODI_READ_SURF
59 !
60 !
61 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
62 USE PARKIND1  ,ONLY : JPRB
63 !
64 USE MODI_GET_TYPE_DIM_n
65 !
66 IMPLICIT NONE
67 !
68 !*       0.1   Declarations of arguments
69 !              -------------------------
70 !
71  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
72 !
73 !
74 !*       0.2   Declarations of local variables
75 !              -------------------------------
76 INTEGER           :: ILU          ! 1D physical dimension
77 !
78 INTEGER           :: IRESP          ! Error code after redding
79 !
80  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
81 REAL(KIND=JPRB) :: ZHOOK_HANDLE
82 !
83 !-------------------------------------------------------------------------------
84 !
85 !* 1D physical dimension
86 !
87 IF (LHOOK) CALL DR_HOOK('READ_FLAKE_N',0,ZHOOK_HANDLE)
88 YRECFM='SIZE_WATER'
89  CALL GET_TYPE_DIM_n('WATER ',ILU)
90 !
91 !*       3.     Prognostic fields:
92 !               -----------------
93 !
94 !* water temperature
95 !
96 ALLOCATE(XTS(ILU))
97 !
98 ALLOCATE(XT_SNOW (ILU))
99 ALLOCATE(XT_ICE  (ILU))
100 ALLOCATE(XT_MNW  (ILU))
101 ALLOCATE(XT_WML  (ILU))
102 ALLOCATE(XT_BOT  (ILU))
103 ALLOCATE(XT_B1   (ILU))
104 ALLOCATE(XCT     (ILU))
105 ALLOCATE(XH_SNOW (ILU))
106 ALLOCATE(XH_ICE  (ILU))
107 ALLOCATE(XH_ML   (ILU))
108 ALLOCATE(XH_B1   (ILU))
109
110 YRECFM='TS_WATER'
111   CALL READ_SURF(HPROGRAM,YRECFM,XTS(:),IRESP)
112 YRECFM='T_SNOW'
113   CALL READ_SURF(HPROGRAM,YRECFM,XT_SNOW(:),IRESP)
114 YRECFM='T_ICE'
115   CALL READ_SURF(HPROGRAM,YRECFM,XT_ICE(:),IRESP)
116 YRECFM='T_MNW'
117   CALL READ_SURF(HPROGRAM,YRECFM,XT_MNW(:),IRESP)
118 YRECFM='T_WML'
119   CALL READ_SURF(HPROGRAM,YRECFM,XT_WML(:),IRESP)
120 YRECFM='T_BOT'
121   CALL READ_SURF(HPROGRAM,YRECFM,XT_BOT(:),IRESP)
122 YRECFM='T_B1'
123   CALL READ_SURF(HPROGRAM,YRECFM,XT_B1(:),IRESP)
124 YRECFM='CT'
125   CALL READ_SURF(HPROGRAM,YRECFM,XCT(:),IRESP)
126 YRECFM='H_SNOW'
127   CALL READ_SURF(HPROGRAM,YRECFM,XH_SNOW(:),IRESP)
128 YRECFM='H_ICE'
129   CALL READ_SURF(HPROGRAM,YRECFM,XH_ICE(:),IRESP)
130 YRECFM='H_ML'
131   CALL READ_SURF(HPROGRAM,YRECFM,XH_ML(:),IRESP)
132 YRECFM='H_B1'
133   CALL READ_SURF(HPROGRAM,YRECFM,XH_B1(:),IRESP)
134 !
135 !-------------------------------------------------------------------------------
136 !
137 !*       4.     Semi-prognostic fields:
138 !               ----------------------
139 !
140 !* roughness length
141 !
142  ALLOCATE(XZ0(ILU))
143  YRECFM='Z0WATER'
144  XZ0(:) = 0.001
145  CALL READ_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP)
146 !
147 !
148 !* friction velocity
149 !
150  ALLOCATE(XUSTAR(ILU))
151  YRECFM='USTAR_WATER'
152  XUSTAR(:) = 0.
153  CALL READ_SURF(HPROGRAM,YRECFM,XUSTAR(:),IRESP)
154 IF (LHOOK) CALL DR_HOOK('READ_FLAKE_N',1,ZHOOK_HANDLE)
155 !
156 !-------------------------------------------------------------------------------
157
158 !
159 END SUBROUTINE READ_FLAKE_n