3c3675b20979db62641a5ae6f782ad860381a4da
[MNH-git_open_source-lfs.git] / src / SURFEX / read_gr_snow.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_GR_SNOW(HPROGRAM,HSURFTYPE,HPREFIX,     &
7                               KLU,KPATCH,TPSNOW,HDIR)  
8 !     ##########################################################
9 !
10 !!****  *READ_GR_SNOW* - routine to read snow surface fields
11 !!
12 !!    PURPOSE
13 !!    -------
14 !       Initialize snow surface fields.
15 !
16 !!**  METHOD
17 !!    ------
18 !!    
19 !!    
20 !!
21 !!    EXTERNAL
22 !!    --------
23 !!      
24 !!       
25 !!    IMPLICIT ARGUMENTS
26 !!    ------------------ 
27 !!
28 !!    REFERENCE
29 !!    ---------
30 !!      
31 !!      
32 !!
33 !!    AUTHOR
34 !!    ------
35 !!      V. Masson       * Meteo France *
36 !!
37 !!    MODIFICATIONS
38 !!    -------------
39 !!      Original       20/01/99
40 !       F.solmon       06/00 adaptation for patch
41 !       V.Masson       01/03 new version of ISBA
42 !       B. Decharme    2008  If no WSNOW, WSNOW = XUNDEF
43 !!      M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
44 !-----------------------------------------------------------------------------
45 !
46 !*       0.    DECLARATIONS
47 !
48 USE MODD_TYPE_SNOW
49 !
50 USE MODI_READ_SURF
51 USE MODI_READ_SURF_FIELD2D
52 USE MODI_READ_SURF_FIELD3D
53 !
54 USE MODI_ALLOCATE_GR_SNOW
55 !
56 USE MODD_SURF_PAR, ONLY : XUNDEF
57 USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT
58 !
59 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
60 USE PARKIND1  ,ONLY : JPRB
61 !
62 IMPLICIT NONE
63 !
64 !*       0.1   declarations of arguments
65 !
66  CHARACTER(LEN=6),   INTENT(IN)           :: HPROGRAM  ! calling program
67  CHARACTER (LEN=*),  INTENT(IN)           :: HSURFTYPE ! generic name used for
68                                                       ! snow characteristics
69                                                       ! storage in file
70  CHARACTER (LEN=3),  INTENT(IN)           :: HPREFIX   ! generic name for patch
71 !                                                     ! identification                      
72 INTEGER,            INTENT(IN)           :: KLU       ! horizontal size of snow var.
73 INTEGER,            INTENT(IN)           :: KPATCH    ! number of tiles
74 TYPE(SURF_SNOW)                          :: TPSNOW    ! snow characteristics
75  CHARACTER (LEN=1),  INTENT(IN), OPTIONAL :: HDIR      ! type of reading
76 !                                                     ! HDIR = 'A' : entire field on All processors
77 !                                                     ! HDIR = 'H' : distribution on each processor
78 !
79 !*       0.2   declarations of local variables
80 !
81 INTEGER             :: IRESP               ! Error code after redding
82  CHARACTER(LEN=12)   :: YRECFM              ! Name of the article to be read
83  CHARACTER(LEN=16)   :: YRECFM2 
84 !
85  CHARACTER (LEN=100) :: YFMT                ! format for writing
86 INTEGER             :: ISURFTYPE_LEN       ! 
87 LOGICAL             :: GSNOW               ! snow written in the file
88 INTEGER             :: JLAYER              ! loop counter
89 CHARACTER(LEN=4)    :: YPATCH              ! number of the patch
90 REAL, DIMENSION(:,:),ALLOCATABLE  :: ZWORK ! 2D array to write data in file
91  CHARACTER(LEN=1)    :: YDIR                ! type of reading
92  CHARACTER(LEN=4)    :: YNLAYER     !Format depending on the number of layers
93 INTEGER             :: IVERSION, IBUGFIX
94 REAL(KIND=JPRB) :: ZHOOK_HANDLE
95 !-------------------------------------------------------------------------------
96 !
97 IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',0,ZHOOK_HANDLE)
98 YDIR = 'H'
99 IF (PRESENT(HDIR)) YDIR = HDIR
100 !
101 !-------------------------------------------------------------------------------
102  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
103  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
104 !-------------------------------------------------------------------------------
105 !
106 !*       1.    Type of snow scheme
107 !              -------------------
108 !
109 ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)
110 IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
111   WRITE(YFMT,'(A5,I1,A4)')     '(A5,A',ISURFTYPE_LEN,',A5)'
112   WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_TYPE'
113 ELSE
114   IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
115     WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A5)'
116     WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYPE'
117   ELSE
118     WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A4)'
119     WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYP'
120     YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
121   ENDIF
122 END IF
123 !
124  CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%SCHEME,IRESP)
125 !
126 !*       2.    Snow levels
127 !              -----------
128 !
129 !
130 IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
131   WRITE(YFMT,'(A5,I1,A4)')     '(A5,A',ISURFTYPE_LEN,',A6)'
132   WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_LAYER'
133 ELSE
134   WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A2)'
135   WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_N'
136   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
137 END IF
138 !
139  CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%NLAYER,IRESP)
140 !
141 !*       2.    Presence of snow fields in the file
142 !              -----------------------------------
143 !
144 IF (IVERSION >6 .OR. (IVERSION==6 .AND. IBUGFIX>=1)) THEN
145   WRITE(YFMT,'(A5,I1,A1)')     '(A3,A',ISURFTYPE_LEN,')'
146   WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE
147   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM=ADJUSTL(HPREFIX//YRECFM)
148   CALL READ_SURF(HPROGRAM,YRECFM,GSNOW,IRESP)
149 ELSE
150   IF (TPSNOW%NLAYER==0) THEN
151     GSNOW = .FALSE.
152     IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='EBA') TPSNOW%NLAYER=1
153     IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO'                          ) TPSNOW%NLAYER=3
154   ELSE
155     GSNOW = .TRUE.
156   END IF
157 END IF
158 !
159 !-------------------------------------------------------------------------------
160 !
161 !*       3.    Allocations
162 !              -----------
163 !
164  CALL ALLOCATE_GR_SNOW(TPSNOW,KLU,KPATCH)
165 !
166 IF (.NOT. GSNOW) THEN
167   IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
168   RETURN
169 END IF
170 !-------------------------------------------------------------------------------
171 !
172 !*       4.    Additional key
173 !              ---------------
174 !
175 IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG') CALL READ_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP)
176 !
177 !-------------------------------------------------------------------------------
178 !
179 !*       5.    Snow reservoir
180 !              --------------
181 !
182 ALLOCATE(ZWORK(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,3)))
183 !
184   IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
185      .OR. TPSNOW%SCHEME=='CRO') THEN  
186 !
187     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
188       YRECFM='WSNOW_'//HSURFTYPE
189     ELSE
190       YRECFM=ADJUSTL(HPREFIX//'WSN_'//HSURFTYPE)
191     ENDIF
192     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%WSNOW,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
193   END IF
194 !
195 !*       6.    Snow density
196 !              ------------
197 !
198   IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
199      .OR. TPSNOW%SCHEME=='CRO') THEN  
200     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
201       YRECFM='RSNOW_'//HSURFTYPE
202     ELSE
203       YRECFM=ADJUSTL(HPREFIX//'RSN_'//HSURFTYPE)
204     ENDIF
205     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%RHO,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
206     WHERE(TPSNOW%WSNOW(:,1:TPSNOW%NLAYER,:)==0.0)TPSNOW%RHO(:,1:TPSNOW%NLAYER,:)=XUNDEF
207   END IF
208 !
209 !*       7.    Snow temperature
210 !              ----------------
211 !
212   IF (TPSNOW%SCHEME=='1-L') THEN
213     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
214       YRECFM='TSNOW_'//HSURFTYPE
215     ELSE
216       YRECFM=ADJUSTL(HPREFIX//'TSN_'//HSURFTYPE)
217     ENDIF
218     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%T,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
219     DO JLAYER = 1,TPSNOW%NLAYER
220       WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%T(:,JLAYER,:) = XUNDEF
221     ENDDO
222   END IF
223 !
224 !*       8.    Heat content
225 !              ------------
226 !
227   IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
228     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
229       YRECFM='HSNOW_'//HSURFTYPE
230     ELSE
231       YRECFM=ADJUSTL(HPREFIX//'HSN_'//HSURFTYPE)
232     ENDIF
233     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HEAT,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
234     DO JLAYER = 1,TPSNOW%NLAYER
235       WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HEAT(:,JLAYER,:) = XUNDEF
236     ENDDO
237   END IF
238 !
239 !*       9.    Snow Gran1
240 !              ------------
241 !
242   IF (TPSNOW%SCHEME=='CRO') THEN
243     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
244       YRECFM='SGRAN1_'//HSURFTYPE
245     ELSE
246       YRECFM=ADJUSTL(HPREFIX//'SG1_'//HSURFTYPE)
247     ENDIF
248     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN1,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
249     DO JLAYER = 1,TPSNOW%NLAYER
250       WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN1(:,JLAYER,:) = XUNDEF
251     ENDDO
252   END IF
253 !
254 !*       10.    Snow Gran2
255 !              ------------
256 !
257   IF (TPSNOW%SCHEME=='CRO') THEN
258     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
259       YRECFM='SGRAN2_'//HSURFTYPE
260     ELSE
261       YRECFM=ADJUSTL(HPREFIX//'SG2_'//HSURFTYPE)
262     ENDIF
263     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN2,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
264     DO JLAYER = 1,TPSNOW%NLAYER
265       WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN2(:,JLAYER,:) = XUNDEF
266     ENDDO
267   END IF
268 !
269 !*       11.    Historical parameter
270 !              -------------------
271 !
272   IF (TPSNOW%SCHEME=='CRO') THEN
273     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
274       YRECFM='SHIST_'//HSURFTYPE
275     ELSE
276       YRECFM=ADJUSTL(HPREFIX//'SHI_'//HSURFTYPE)
277     ENDIF
278     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HIST,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
279     DO JLAYER = 1,TPSNOW%NLAYER
280       WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HIST(:,JLAYER,:) = XUNDEF
281     ENDDO
282   END IF
283 !
284 !*       12.    Age parameter
285 !              -------------------
286 !
287   IF (TPSNOW%SCHEME=='CRO') THEN
288     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
289       YRECFM='SAGE_'//HSURFTYPE
290     ELSE
291       YRECFM=ADJUSTL(HPREFIX//'SAG_'//HSURFTYPE)
292     ENDIF
293     CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%AGE,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
294     DO JLAYER = 1,TPSNOW%NLAYER
295       WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%AGE(:,JLAYER,:) = XUNDEF
296     ENDDO
297   END IF
298 !-------------------------------------------------------------------------------
299 !
300 !
301 DEALLOCATE(ZWORK)
302 !-------------------------------------------------------------------------------
303 !
304 !*       13.    Albedo
305 !              ------
306 !
307 IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
308     .OR. TPSNOW%SCHEME=='CRO') THEN  
309
310   IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
311     YRECFM='ASNOW_'//HSURFTYPE
312   ELSE
313     YRECFM=ADJUSTL(HPREFIX//'ASN_'//HSURFTYPE)
314   ENDIF
315   CALL READ_SURF_FIELD2D(HPROGRAM,TPSNOW%ALB,YRECFM,HDIR=YDIR)
316   WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%ALB(:,:) = XUNDEF
317 END IF
318 IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
319 !
320 !-------------------------------------------------------------------------------
321 !
322 END SUBROUTINE READ_GR_SNOW