SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
read_gr_snow.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_gr_snow (&
7  hprogram,hsurftype,hprefix, &
8  klu,kpatch,tpsnow,hdir,kversion,kbugfix)
9 ! ##########################################################
10 !
11 !!**** *READ_GR_SNOW* - routine to read snow surface fields
12 !!
13 !! PURPOSE
14 !! -------
15 ! Initialize snow surface fields.
16 !
17 !!** METHOD
18 !! ------
19 !!
20 !!
21 !!
22 !! EXTERNAL
23 !! --------
24 !!
25 !!
26 !! IMPLICIT ARGUMENTS
27 !! ------------------
28 !!
29 !! REFERENCE
30 !! ---------
31 !!
32 !!
33 !!
34 !! AUTHOR
35 !! ------
36 !! V. Masson * Meteo France *
37 !!
38 !! MODIFICATIONS
39 !! -------------
40 !! Original 20/01/99
41 ! F.solmon 06/00 adaptation for patch
42 ! V.Masson 01/03 new version of ISBA
43 ! B. Decharme 2008 If no WSNOW, WSNOW = XUNDEF
44 !-----------------------------------------------------------------------------
45 !
46 !* 0. DECLARATIONS
47 !
48 !
49 !
50 !
51 USE modd_type_snow
52 !
53 USE modi_read_surf
54 !
55 USE modi_allocate_gr_snow
56 !
57 USE modd_surf_par, ONLY : xundef
58 USE modd_prep_snow, ONLY : lsnow_frac_tot
59 !
60 USE yomhook ,ONLY : lhook, dr_hook
61 USE parkind1 ,ONLY : jprb
62 !
63 IMPLICIT NONE
64 !
65 !* 0.1 declarations of arguments
66 !
67 !
68 !
69  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! calling program
70  CHARACTER (LEN=*), INTENT(IN) :: hsurftype ! generic name used for
71  ! snow characteristics
72  ! storage in file
73  CHARACTER (LEN=3), INTENT(IN) :: hprefix ! generic name for patch
74 ! ! identification
75 INTEGER, INTENT(IN) :: klu ! horizontal size of snow var.
76 INTEGER, INTENT(IN) :: kpatch ! number of tiles
77 TYPE(surf_snow) :: tpsnow ! snow characteristics
78  CHARACTER (LEN=1), INTENT(IN), OPTIONAL :: hdir ! type of reading
79 ! ! HDIR = 'A' : entire field on All processors
80 ! ! HDIR = 'H' : distribution on each processor
81 !
82 INTEGER, INTENT(IN), OPTIONAL :: kversion
83 INTEGER, INTENT(IN), OPTIONAL :: kbugfix
84 !
85 !* 0.2 declarations of local variables
86 !
87 INTEGER :: iresp ! Error code after redding
88  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
89  CHARACTER(LEN=16) :: yrecfm2
90 !
91  CHARACTER (LEN=100) :: yfmt ! format for writing
92 INTEGER :: isurftype_len !
93 LOGICAL :: gsnow ! snow written in the file
94 INTEGER :: jlayer ! loop counter
95 REAL, DIMENSION(:,:),ALLOCATABLE :: zwork ! 2D array to write data in file
96  CHARACTER(LEN=1) :: ydir ! type of reading
97  CHARACTER(LEN=4) :: ynlayer !Format depending on the number of layers
98 INTEGER :: iversion, ibugfix
99 REAL(KIND=JPRB) :: zhook_handle
100 !-------------------------------------------------------------------------------
101 !
102 IF (lhook) CALL dr_hook('READ_GR_SNOW',0,zhook_handle)
103 ydir = 'H'
104 IF (present(hdir)) ydir = hdir
105 !
106 !-------------------------------------------------------------------------------
107 IF(present(kversion))THEN
108  iversion=kversion
109 ELSE
110  CALL read_surf(&
111  hprogram,'VERSION',iversion,iresp)
112 ENDIF
113 IF(present(kbugfix))THEN
114  ibugfix=kbugfix
115 ELSE
116  CALL read_surf(&
117  hprogram,'BUG',ibugfix,iresp)
118 ENDIF
119 !-------------------------------------------------------------------------------
120 !
121 !* 1. Type of snow scheme
122 ! -------------------
123 !
124 isurftype_len=len_trim(hsurftype)
125 IF (iversion <=2 .OR. (iversion==3 .AND. ibugfix<=4)) THEN
126  WRITE(yfmt,'(A5,I1,A4)') '(A5,A',isurftype_len,',A5)'
127  WRITE(yrecfm2,yfmt) 'SNOW_',hsurftype,'_TYPE'
128 ELSE
129  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
130  WRITE(yfmt,'(A5,I1,A4)') '(A3,A',isurftype_len,',A5)'
131  WRITE(yrecfm2,yfmt) 'SN_',hsurftype,'_TYPE'
132  ELSE
133  WRITE(yfmt,'(A5,I1,A4)') '(A3,A',isurftype_len,',A4)'
134  WRITE(yrecfm2,yfmt) 'SN_',hsurftype,'_TYP'
135  yrecfm2=adjustl(hprefix//yrecfm2)
136  ENDIF
137 END IF
138 !
139  CALL read_surf(&
140  hprogram,yrecfm2,tpsnow%SCHEME,iresp)
141 !
142 !* 2. Snow levels
143 ! -----------
144 !
145 !
146 IF (iversion <=2 .OR. (iversion==3 .AND. ibugfix<=4)) THEN
147  WRITE(yfmt,'(A5,I1,A4)') '(A5,A',isurftype_len,',A6)'
148  WRITE(yrecfm2,yfmt) 'SNOW_',hsurftype,'_LAYER'
149 ELSE
150  WRITE(yfmt,'(A5,I1,A4)') '(A3,A',isurftype_len,',A2)'
151  WRITE(yrecfm2,yfmt) 'SN_',hsurftype,'_N'
152  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm2=adjustl(hprefix//yrecfm2)
153 END IF
154 !
155  CALL read_surf(&
156  hprogram,yrecfm2,tpsnow%NLAYER,iresp)
157 !
158 !* 2. Presence of snow fields in the file
159 ! -----------------------------------
160 !
161 IF (iversion >6 .OR. (iversion==6 .AND. ibugfix>=1)) THEN
162  WRITE(yfmt,'(A5,I1,A1)') '(A3,A',isurftype_len,')'
163  WRITE(yrecfm,yfmt) 'SN_',hsurftype
164  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm=adjustl(hprefix//yrecfm)
165  CALL read_surf(&
166  hprogram,yrecfm,gsnow,iresp)
167 ELSE
168  IF (tpsnow%NLAYER==0) THEN
169  gsnow = .false.
170  IF (tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='1-L' .OR. tpsnow%SCHEME=='EBA') tpsnow%NLAYER=1
171  IF (tpsnow%SCHEME=='3-L' .OR. tpsnow%SCHEME=='CRO' ) tpsnow%NLAYER=3
172  ELSE
173  gsnow = .true.
174  END IF
175 END IF
176 !
177 !-------------------------------------------------------------------------------
178 !
179 !* 3. Allocations
180 ! -----------
181 !
182  CALL allocate_gr_snow(tpsnow,klu,kpatch)
183 !
184 IF (.NOT. gsnow) THEN
185  IF (lhook) CALL dr_hook('READ_GR_SNOW',1,zhook_handle)
186  RETURN
187 END IF
188 !-------------------------------------------------------------------------------
189 !
190 !* 4. Additional key
191 ! ---------------
192 !
193 IF (iversion >= 7 .AND. hsurftype=='VEG') CALL read_surf(&
194  hprogram,'LSNOW_FRAC_T',lsnow_frac_tot,iresp)
195 !
196 !-------------------------------------------------------------------------------
197 !
198 !* 5. Snow reservoir
199 ! --------------
200 !
201 ALLOCATE(zwork(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,3)))
202 !
203 DO jlayer = 1,tpsnow%NLAYER
204 !
205  ynlayer='I1.1'
206  IF (jlayer>9) ynlayer='I2.2'
207 !
208  IF (tpsnow%SCHEME=='1-L' .OR. tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='EBA' .OR. tpsnow%SCHEME=='3-L' &
209  .OR. tpsnow%SCHEME=='CRO') THEN
210 !
211  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
212  WRITE(yfmt,'(A5,I1,A6)') '(A6,A',isurftype_len,','//ynlayer//')'
213  WRITE(yrecfm,yfmt) 'WSNOW_',hsurftype,jlayer
214  ELSE
215  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
216  WRITE(yrecfm,yfmt) 'WSN_',hsurftype,jlayer
217  yrecfm=adjustl(hprefix//yrecfm)
218  ENDIF
219  CALL read_surf(&
220  hprogram,yrecfm,zwork,iresp,hdir=ydir)
221  tpsnow%WSNOW(:,jlayer,:)=zwork
222  END IF
223 !
224 !* 6. Snow density
225 ! ------------
226 !
227  IF (tpsnow%SCHEME=='1-L' .OR. tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='EBA' .OR. tpsnow%SCHEME=='3-L' &
228  .OR. tpsnow%SCHEME=='CRO') THEN
229  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
230  WRITE(yfmt,'(A5,I1,A6)') '(A6,A',isurftype_len,','//ynlayer//')'
231  WRITE(yrecfm,yfmt) 'RSNOW_',hsurftype,jlayer
232  ELSE
233  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
234  WRITE(yrecfm,yfmt) 'RSN_',hsurftype,jlayer
235  yrecfm=adjustl(hprefix//yrecfm)
236  ENDIF
237  CALL read_surf(&
238  hprogram,yrecfm,zwork,iresp,hdir=ydir)
239  tpsnow%RHO(:,jlayer,:)=zwork
240  WHERE(tpsnow%WSNOW(:,jlayer,:)==0.0)tpsnow%RHO(:,jlayer,:)=xundef
241  END IF
242 !
243 !* 7. Snow temperature
244 ! ----------------
245 !
246  IF (tpsnow%SCHEME=='1-L') THEN
247  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
248  WRITE(yfmt,'(A5,I1,A6)') '(A6,A',isurftype_len,','//ynlayer//')'
249  WRITE(yrecfm,yfmt) 'TSNOW_',hsurftype,jlayer
250  ELSE
251  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
252  WRITE(yrecfm,yfmt) 'TSN_',hsurftype,jlayer
253  yrecfm=adjustl(hprefix//yrecfm)
254  ENDIF
255  CALL read_surf(&
256  hprogram,yrecfm,zwork,iresp,hdir=ydir)
257  tpsnow%T(:,jlayer,:)=zwork
258  WHERE (tpsnow%WSNOW(:,1,:) == 0.0) tpsnow%T(:,jlayer,:) = xundef
259  END IF
260 !
261 !* 8. Heat content
262 ! ------------
263 !
264  IF (tpsnow%SCHEME=='3-L' .OR. tpsnow%SCHEME=='CRO') THEN
265  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
266  WRITE(yfmt,'(A5,I1,A6)') '(A6,A',isurftype_len,','//ynlayer//')'
267  WRITE(yrecfm,yfmt) 'HSNOW_',hsurftype,jlayer
268  ELSE
269  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
270  WRITE(yrecfm,yfmt) 'HSN_',hsurftype,jlayer
271  yrecfm=adjustl(hprefix//yrecfm)
272  ENDIF
273  CALL read_surf(&
274  hprogram,yrecfm,zwork,iresp,hdir=ydir)
275  tpsnow%HEAT(:,jlayer,:)=zwork
276  WHERE (tpsnow%WSNOW(:,1,:) == 0.0) tpsnow%HEAT(:,jlayer,:) = xundef
277  END IF
278 !
279 !* 9. Snow Gran1
280 ! ------------
281 !
282  IF (tpsnow%SCHEME=='CRO') THEN
283  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
284  WRITE(yfmt,'(A5,I1,A6)') '(A7,A',isurftype_len,','//ynlayer//')'
285  WRITE(yrecfm,yfmt) 'SGRAN1_',hsurftype,jlayer
286  ELSE
287  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
288  WRITE(yrecfm,yfmt) 'SG1_',hsurftype,jlayer
289  yrecfm=adjustl(hprefix//yrecfm)
290  ENDIF
291  CALL read_surf(&
292  hprogram,yrecfm,zwork,iresp,hdir=ydir)
293  tpsnow%GRAN1(:,jlayer,:)=zwork
294  WHERE (tpsnow%WSNOW(:,1,:) == 0.0) tpsnow%GRAN1(:,jlayer,:) = xundef
295  END IF
296 !
297 !* 10. Snow Gran2
298 ! ------------
299 !
300  IF (tpsnow%SCHEME=='CRO') THEN
301  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
302  WRITE(yfmt,'(A5,I1,A6)') '(A7,A',isurftype_len,','//ynlayer//')'
303  WRITE(yrecfm,yfmt) 'SGRAN2_',hsurftype,jlayer
304  ELSE
305  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
306  WRITE(yrecfm,yfmt) 'SG2_',hsurftype,jlayer
307  yrecfm=adjustl(hprefix//yrecfm)
308  ENDIF
309  CALL read_surf(&
310  hprogram,yrecfm,zwork,iresp,hdir=ydir)
311  tpsnow%GRAN2(:,jlayer,:)=zwork
312  WHERE (tpsnow%WSNOW(:,1,:) == 0.0) tpsnow%GRAN2(:,jlayer,:) = xundef
313  END IF
314 !
315 !* 11. Historical parameter
316 ! -------------------
317 !
318  IF (tpsnow%SCHEME=='CRO') THEN
319  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
320  WRITE(yfmt,'(A5,I1,A6)') '(A6,A',isurftype_len,','//ynlayer//')'
321  WRITE(yrecfm,yfmt) 'SHIST_',hsurftype,jlayer
322  ELSE
323  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
324  WRITE(yrecfm,yfmt) 'SHI_',hsurftype,jlayer
325  yrecfm=adjustl(hprefix//yrecfm)
326  ENDIF
327  CALL read_surf(&
328  hprogram,yrecfm,zwork,iresp,hdir=ydir)
329  tpsnow%HIST(:,jlayer,:)=zwork
330  WHERE (tpsnow%WSNOW(:,1,:) == 0.0) tpsnow%HIST(:,jlayer,:) = xundef
331  END IF
332 !
333 !* 12. Age parameter
334 ! -------------------
335 !
336  IF ((tpsnow%SCHEME=='3-L'.AND.iversion>=8) .OR. tpsnow%SCHEME=='CRO') THEN
337  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
338  WRITE(yfmt,'(A5,I1,A6)') '(A5,A',isurftype_len,','//ynlayer//')'
339  WRITE(yrecfm,yfmt) 'SAGE_',hsurftype,jlayer
340  ELSE
341  WRITE(yfmt,'(A5,I1,A6)') '(A4,A',isurftype_len,','//ynlayer//')'
342  WRITE(yrecfm,yfmt) 'SAG_',hsurftype,jlayer
343  yrecfm=adjustl(hprefix//yrecfm)
344  ENDIF
345  CALL read_surf(&
346  hprogram,yrecfm,zwork,iresp,hdir=ydir)
347  tpsnow%AGE(:,jlayer,:)=zwork
348  WHERE (tpsnow%WSNOW(:,1,:) == 0.0) tpsnow%AGE(:,jlayer,:) = xundef
349  ELSEIF(tpsnow%SCHEME=='3-L'.AND.iversion<8)THEN
350  WHERE (tpsnow%WSNOW(:,1,:) >= 0.0)
351  tpsnow%AGE(:,jlayer,:) = 0.0
352  ELSEWHERE
353  tpsnow%AGE(:,jlayer,:) = xundef
354  ENDWHERE
355  END IF
356 !-------------------------------------------------------------------------------
357 !
358 END DO
359 !
360 DEALLOCATE(zwork)
361 !-------------------------------------------------------------------------------
362 !
363 !* 13. Albedo
364 ! ------
365 !
366 IF (tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='EBA' .OR. tpsnow%SCHEME=='1-L' .OR. tpsnow%SCHEME=='3-L' &
367  .OR. tpsnow%SCHEME=='CRO') THEN
368  IF (iversion<7 .OR. iversion==7 .AND. ibugfix<3) THEN
369  WRITE(yfmt,'(A5,I1,A1)') '(A6,A',isurftype_len,')'
370  WRITE(yrecfm,yfmt) 'ASNOW_',hsurftype
371  ELSE
372  WRITE(yfmt,'(A5,I1,A1)') '(A4,A',isurftype_len,')'
373  WRITE(yrecfm,yfmt) 'ASN_',hsurftype
374  yrecfm=adjustl(hprefix//yrecfm)
375  ENDIF
376  CALL read_surf(&
377  hprogram,yrecfm,tpsnow%ALB(:,:),iresp,hdir=ydir)
378  WHERE (tpsnow%WSNOW(:,1,:) == 0.0) tpsnow%ALB(:,:) = xundef
379 END IF
380 IF (lhook) CALL dr_hook('READ_GR_SNOW',1,zhook_handle)
381 !
382 !-------------------------------------------------------------------------------
383 !
384 END SUBROUTINE read_gr_snow
modd_prep_snow
Definition: modd_prep_snow.F90:6
modi_read_surf
Definition: read_surf.F90:6
modd_type_snow
Definition: modd_type_snow.F90:6
allocate_gr_snow
subroutine allocate_gr_snow(TPSNOW, KLU, KPATCH)
Definition: allocate_gr_snow.F90:6
modi_read_surf::read_surf
Definition: read_surf.F90:44
modd_type_snow::surf_snow
Definition: modd_type_snow.F90:42
read_gr_snow
subroutine read_gr_snow(HPROGRAM, HSURFTYPE, HPREFIX, KLU, KPATCH, TPSNOW, HDIR, KVERSION, KBUGFIX)
Definition: read_gr_snow.F90:6
modd_surf_par
Definition: modd_surf_par.F90:6
Generated on Fri May 13 2016 09:31:05 for SURFEX by   doxygen 1.8.5