SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
read_covers_param.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 read_covers_param(KFILE)
7 ! ############################
8 !
9 !!**** *READ_COVERS_PARAM* initializes cover-field correspondance arrays
10 !!
11 !! PURPOSE
12 !! -------
13 !!
14 !! METHOD
15 !! ------
16 !!
17 !!
18 !! EXTERNAL
19 !! --------
20 !!
21 !! IMPLICIT ARGUMENTS
22 !! ------------------
23 !!
24 !! REFERENCE
25 !! ---------
26 !!
27 !! AUTHOR
28 !! ------
29 !!
30 !! S.Faroux Meteo-France
31 !!
32 !! MODIFICATION
33 !! ------------
34 !!
35 !! Original 23/03/11
36 !!
37 !! R. Alkama 05/2012 : read 19 vegtypes rather than 12
38 ! 10/2014 : add status='old' for ecoclimap.bin files E. Martin
39 !----------------------------------------------------------------------------
40 !
41 !* 0. DECLARATION
42 ! -----------
43 
44 USE modd_type_date_surf
45 !
46 USE modd_data_cover, ONLY : xdata_town, xdata_nature, xdata_sea, xdata_water, &
47  xdata_vegtype, xdata_lai, xdata_h_tree, &
48  xdata_root_depth, xdata_ground_depth, xdata_dice, &
49  xdata_lai_all_years, tdata_seed, tdata_reap, &
50  xdata_alb_soil_nir, xdata_alb_soil_vis, &
51  xdata_alb_veg_nir, xdata_alb_veg_vis, &
52  xdata_watsup, xdata_irrig, &
53  xdata_z0_town, xdata_bld_height, xdata_wall_o_hor,&
54  xdata_bld, xdata_garden, &
55  xdata_alb_roof, xdata_alb_road, xdata_alb_wall, &
56  xdata_emis_roof, xdata_emis_road, xdata_emis_wall,&
57  xdata_hc_roof, xdata_hc_road, xdata_hc_wall, &
58  xdata_tc_roof, xdata_tc_road, xdata_tc_wall, &
59  xdata_d_roof, xdata_d_road, xdata_d_wall, &
60  xdata_h_traffic, xdata_le_traffic, &
61  xdata_h_industry, xdata_le_industry, &
62  neco2_start_year, neco2_end_year
63 !
64 USE modd_data_cover_par, ONLY : nvegtype, jpcover, ncover_eco1_end, ncover_eco2_start
65 !
66 USE modi_abor1_sfx
67 !
68 USE yomhook ,ONLY : lhook, dr_hook
69 USE parkind1 ,ONLY : jprb
70 !
71 IMPLICIT NONE
72 !
73 !* 0.1 Declaration of arguments
74 ! ------------------------
75 !
76 INTEGER, INTENT(IN) :: kfile
77 !
78 !* 0.2 Declaration of local variables
79 ! ------------------------------
80 !
81 INTEGER :: ierr_open
82 INTEGER :: inb_cover, inb_an
83 INTEGER :: icover, irec
84 INTEGER :: jcover
85 !
86 !* 0.3 Declaration of namelists
87 ! ------------------------
88 !
89 REAL(KIND=JPRB) :: zhook_handle
90 !-------------------------------------------------------------------------------
91 IF (lhook) CALL dr_hook('READ_COVERS_PARAM',0,zhook_handle)
92 !
93 !opening of the file
94 IF (kfile==1) THEN
95  OPEN(41,file='ecoclimapI_covers_param.bin',form='UNFORMATTED',access='DIRECT', &
96  recl=20*8,status='OLD',iostat=ierr_open)
97  IF (ierr_open /= 0 ) THEN
98  CALL abor1_sfx('ERROR WHILE OPENING ''ecoclimapI_covers_param.bin'' THIS FILE IS NEEDED AND MUST BE'// &
99  ' IN (OR LINKED TO) THE RUN DIRECTORY')
100  ENDIF
101  inb_cover = ncover_eco1_end
102  inb_an = 1
103 ELSEIF (kfile==2) THEN
104  OPEN(41,file='ecoclimapII_eu_covers_param.bin',form='UNFORMATTED',access='DIRECT', &
105  recl=20*8,status='OLD',iostat=ierr_open)
106  IF (ierr_open /= 0 ) THEN
107  CALL abor1_sfx('ERROR WHILE OPENING ''ecoclimapII_eu_covers_param.bin'' THIS FILE IS NEEDED AND MUST BE'// &
108  ' IN (OR LINKED TO) THE RUN DIRECTORY')
109  ENDIF
110  inb_cover = jpcover - ncover_eco2_start + 1
111  inb_an = neco2_end_year - neco2_start_year + 1
112 ENDIF
113 !
114 irec=0
115 DO jcover = 1,inb_cover
116  irec = irec+1
117  READ(41,rec=irec) icover
118  !fractions of tiles
119  irec=irec+1
120  READ(41,rec=irec) xdata_town(icover),xdata_nature(icover),xdata_water(icover),xdata_sea(icover)
121  !natural part
122  IF (xdata_nature(icover).NE.0.) CALL read_nature
123  !urban part
124  IF (xdata_town(icover).NE.0.) THEN
125  !main town parameters
126  irec=irec+1
127  READ(41,rec=irec) xdata_z0_town(icover),xdata_bld_height(icover),xdata_wall_o_hor(icover),&
128  xdata_bld(icover),xdata_garden(icover)
129  !town albedos
130  irec=irec+1
131  READ(41,rec=irec) xdata_alb_roof(icover),xdata_alb_road(icover),xdata_alb_wall(icover)
132  !town emissivities
133  irec=irec+1
134  READ(41,rec=irec) xdata_emis_roof(icover),xdata_emis_road(icover),xdata_emis_wall(icover)
135  !town heat capacity
136  irec=irec+1
137  READ(41,rec=irec) xdata_hc_roof(icover,:)
138  irec=irec+1
139  READ(41,rec=irec) xdata_hc_road(icover,:)
140  irec=irec+1
141  READ(41,rec=irec) xdata_hc_wall(icover,:)
142  !town thermal conductivity
143  irec=irec+1
144  READ(41,rec=irec) xdata_tc_roof(icover,:)
145  irec=irec+1
146  READ(41,rec=irec) xdata_tc_road(icover,:)
147  irec=irec+1
148  READ(41,rec=irec) xdata_tc_wall(icover,:)
149  !town depths
150  irec=irec+1
151  READ(41,rec=irec) xdata_d_roof(icover,:)
152  irec=irec+1
153  READ(41,rec=irec) xdata_d_road(icover,:)
154  irec=irec+1
155  READ(41,rec=irec) xdata_d_wall(icover,:)
156  !traffic and industry fluxes
157  irec=irec+1
158  READ(41,rec=irec) xdata_h_traffic(icover),xdata_le_traffic(icover),xdata_h_industry(icover),xdata_le_industry(icover)
159  IF (xdata_garden(icover).NE.0. .AND. xdata_nature(icover).EQ.0.) CALL read_nature
160  ENDIF
161 ENDDO
162  CLOSE(41)
163 !
164 IF (lhook) CALL dr_hook('READ_COVERS_PARAM',1,zhook_handle)
165 !------------------------------------------------------------------------------
166  CONTAINS
167 !
168 SUBROUTINE read_nature
169 !
170 REAL, DIMENSION(12) :: zinter
171 INTEGER :: jvegtype, jlai
172 REAL(KIND=JPRB) :: zhook_handle
173 !
174 IF (lhook) CALL dr_hook('READ_COVERS_PARAM:READ_NATURE',0,zhook_handle)
175 !
176 !fractions of vegtypes
177 irec=irec+1
178 READ(41,rec=irec) xdata_vegtype(icover,:)
179 !
180 !albedos for the soil
181 IF (kfile<=2 .AND. xdata_nature(icover)/=0.) THEN
182  irec=irec+1
183  READ(41,rec=irec) zinter(:)
184  xdata_alb_soil_nir(icover,1:12,1) = zinter(:)
185  irec=irec+1
186  READ(41,rec=irec) zinter(:)
187  xdata_alb_soil_nir(icover,13:24,1) = zinter(:)
188  irec=irec+1
189  READ(41,rec=irec) zinter(:)
190  xdata_alb_soil_nir(icover,25:36,1) = zinter(:)
191  irec=irec+1
192  READ(41,rec=irec) zinter(:)
193  xdata_alb_soil_vis(icover,1:12,1) = zinter(:)
194  irec=irec+1
195  READ(41,rec=irec) zinter(:)
196  xdata_alb_soil_vis(icover,13:24,1) = zinter(:)
197  irec=irec+1
198  READ(41,rec=irec) zinter(:)
199  xdata_alb_soil_vis(icover,25:36,1) = zinter(:)
200 ENDIF
201 !
202 DO jvegtype=1,nvegtype
203  !not null fraction of vegtype
204  IF (xdata_vegtype(icover,jvegtype).NE.0.) THEN
205  !root and soil depths
206  irec=irec+1
207  READ(41,rec=irec) xdata_root_depth(icover,jvegtype), xdata_ground_depth(icover,jvegtype), xdata_dice(icover,jvegtype)
208  IF (jvegtype.GT.3) THEN
209  !LAI
210  DO jlai=1,inb_an*3
211  irec=irec+1
212  IF (kfile==1) THEN
213  READ(41,rec=irec) zinter(:)
214  xdata_lai(icover,(jlai-1)*12+1:jlai*12,jvegtype) = zinter(:)
215  ELSEIF (kfile==2) THEN
216  READ(41,rec=irec) zinter(:)
217  xdata_lai_all_years(icover,(jlai-1)*12+1:jlai*12,jvegtype) = zinter(:)
218  ENDIF
219  ENDDO
220  !Heights of trees
221  IF ((jvegtype < 7) .OR. (jvegtype > 12 .AND. jvegtype /= 18)) THEN
222  irec=irec+1
223  READ(41,rec=irec) xdata_h_tree(icover,jvegtype)
224  ENDIF
225  !albedos for the vegetation
226  IF (kfile<=2 .AND. xdata_nature(icover)/=0.) THEN
227  irec=irec+1
228  READ(41,rec=irec) zinter(:)
229  xdata_alb_veg_nir(icover,1:12,jvegtype) = zinter(:)
230  irec=irec+1
231  READ(41,rec=irec) zinter(:)
232  xdata_alb_veg_nir(icover,13:24,jvegtype) = zinter(:)
233  irec=irec+1
234  READ(41,rec=irec) zinter(:)
235  xdata_alb_veg_nir(icover,25:36,jvegtype) = zinter(:)
236  irec=irec+1
237  READ(41,rec=irec) zinter(:)
238  xdata_alb_veg_vis(icover,1:12,jvegtype) = zinter(:)
239  irec=irec+1
240  READ(41,rec=irec) zinter(:)
241  xdata_alb_veg_vis(icover,13:24,jvegtype) = zinter(:)
242  irec=irec+1
243  READ(41,rec=irec) zinter(:)
244  xdata_alb_veg_vis(icover,25:36,jvegtype) = zinter(:)
245  ENDIF
246  ELSE
247  !LAI for bare areas
248  IF (kfile==1) THEN
249  xdata_lai(icover,:,jvegtype) = 0.
250  ELSEIF (kfile==2) THEN
251  xdata_lai_all_years(icover,:,jvegtype) = 0.
252  ENDIF
253  xdata_alb_veg_nir(icover,:,jvegtype) = 0.3
254  xdata_alb_veg_vis(icover,:,jvegtype) = 0.1
255  ENDIF
256  !irrigation
257  IF (jvegtype.EQ.8 .AND. kfile.EQ.1 .OR. jvegtype.EQ.9 .AND. kfile.EQ.2) THEN
258  irec=irec+1
259  READ(41,rec=irec) tdata_seed(icover,jvegtype)%TDATE%MONTH, tdata_seed(icover,jvegtype)%TDATE%DAY, &
260  tdata_reap(icover,jvegtype)%TDATE%MONTH, tdata_reap(icover,jvegtype)%TDATE%DAY, &
261  xdata_watsup(icover,jvegtype),xdata_irrig(icover,jvegtype)
262  ENDIF
263  ENDIF
264 ENDDO
265 !
266 IF (lhook) CALL dr_hook('READ_COVERS_PARAM:READ_NATURE',1,zhook_handle)
267 !
268 END SUBROUTINE read_nature
269 !
270 END SUBROUTINE read_covers_param
read_nature
subroutine read_nature
Definition: read_covers_param.F90:168
read_covers_param
subroutine read_covers_param(KFILE)
Definition: read_covers_param.F90:6
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
modd_data_cover
Definition: modd_data_cover.F90:6
modd_type_date_surf
Definition: modd_type_date_surf.F90:6
Generated on Fri May 13 2016 09:31:05 for SURFEX by   doxygen 1.8.5