SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
mode_read_extern.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 MODULE mode_read_extern
7 ! #####################
8 !-------------------------------------------------------------------
9 !
10 USE modd_surf_par, ONLY : nundef, xundef
11 USE modd_data_cover_par, ONLY : jpcover, nvegtype
12 !
13 USE mode_read_surf_cov, ONLY : read_surf_cov
14 !
15 USE modi_read_lecoclimap
16 !
17 USE modi_old_name
18 USE modi_open_aux_io_surf
19 USE modi_close_aux_io_surf
20 USE modi_read_surf
21 USE modi_abor1_sfx
22 !
23 USE yomhook ,ONLY : lhook, dr_hook
24 USE parkind1 ,ONLY : jprb
25 !
26  CONTAINS
27 !
28 !---------------------------------------------------------------------------------------
29 !
30 ! #######################
31  SUBROUTINE read_extern_depth (U, &
32  dtco, i, &
33  hfile,hprogram,kluout,hisba,hnat,hfield,kni,klayer, &
34  kpatch,psoilgrid,pdepth,kversion,kwg_layer )
35 ! #######################
36 !
37 !
38 !
39 !
40 !
41 !
42 !
43 USE modd_surf_atm_n, ONLY : surf_atm_t
44 !
45 USE modd_data_cover_n, ONLY : data_cover_t
46 USE modd_isba_n, ONLY : isba_t
47 !
48 USE modi_read_surf_isba_par_n
49 USE modi_convert_cover_isba
50 USE modi_garden_soil_depth
51 !
52 ! Modifications :
53 ! P.Marguinaud : 11-09-2012 : shorten field name
54 !
55 !
56 IMPLICIT NONE
57 !
58 !* dummy arguments
59 ! ---------------
60 !
61 !
62 !
63 TYPE(surf_atm_t), INTENT(INOUT) :: u
64 !
65 TYPE(data_cover_t), INTENT(INOUT) :: dtco
66 TYPE(isba_t), INTENT(INOUT) :: i
67 !
68  CHARACTER(LEN=28), INTENT(IN) :: hfile ! name of file!
69  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! type of input file
70 INTEGER, INTENT(IN) :: kluout ! logical unit of output listing
71  CHARACTER(LEN=3), INTENT(IN) :: hisba ! type of ISBA soil scheme
72  CHARACTER(LEN=3), INTENT(IN) :: hnat ! type of surface (nature, gardens)
73  CHARACTER(LEN=7), INTENT(IN) :: hfield ! field name
74 INTEGER, INTENT(IN) :: kni ! number of points
75 INTEGER, INTENT(IN) :: klayer ! number of layers
76 INTEGER, INTENT(IN) :: kpatch ! number of patch
77 INTEGER, INTENT(IN) :: kversion ! surface version
78 REAL, DIMENSION(:), INTENT(IN) :: psoilgrid !
79 REAL, DIMENSION(:,:,:), POINTER :: pdepth ! depth of each layer over each patches
80 INTEGER, DIMENSION(:,:), INTENT(OUT):: kwg_layer
81 !
82 !* local variables
83 ! ---------------
84 !
85  CHARACTER(LEN=4 ) :: ylvl
86  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
87  CHARACTER(LEN=16) :: yrecfm2
88  CHARACTER(LEN=100):: ycomment ! Comment string
89 INTEGER :: iresp ! reading return code
90 INTEGER :: jlayer ! loop counter
91 INTEGER :: jpatch ! loop counter
92 INTEGER :: jj
93 INTEGER :: iversion
94 INTEGER :: ibugfix
95 !
96 LOGICAL, DIMENSION(JPCOVER) :: gcover ! flag to read the covers
97 REAL, DIMENSION(:,:), ALLOCATABLE :: zcover ! cover fractions
98 REAL, DIMENSION(:,:), ALLOCATABLE :: zground_depth ! cover fractions
99 REAL, DIMENSION(:,:), ALLOCATABLE :: zwork ! work array
100 INTEGER, DIMENSION(:), ALLOCATABLE :: zsoilgrid
101 REAL, DIMENSION(KNI) :: zhveg ! high vegetation fraction
102 REAL, DIMENSION(KNI) :: zlveg ! low vegetation fraction
103 REAL, DIMENSION(KNI) :: znveg ! no vegetation fraction
104 REAL, DIMENSION(KNI) :: zperm ! permafrost distribution
105  CHARACTER(LEN=4) :: yhveg ! type of high vegetation
106  CHARACTER(LEN=4) :: ylveg ! type of low vegetation
107  CHARACTER(LEN=4) :: ynveg ! type of no vegetation
108 LOGICAL :: gecoclimap ! T if ecoclimap is used
109 LOGICAL :: gpar_garden! T if garden data are used
110 LOGICAL :: gdata_dg
111 LOGICAL :: gdata_ground_depth, gdata_root_depth
112 LOGICAL :: gperm
113 REAL(KIND=JPRB) :: zhook_handle
114 !
115 !
116 !------------------------------------------------------------------------------
117 !
118 IF (lhook) CALL dr_hook('MODE_READ_EXTERN:READ_EXTERN_DEPTH',0,zhook_handle)
119 !
120  CALL open_aux_io_surf(&
121  hfile,hprogram,'FULL ')
122 yrecfm='VERSION'
123  CALL read_surf(&
124  hprogram,yrecfm,iversion,iresp)
125 yrecfm='BUG'
126  CALL read_surf(&
127  hprogram,yrecfm,ibugfix,iresp)
128  CALL close_aux_io_surf(hfile,hprogram)
129 !
130 IF (hnat=='NAT') THEN
131  CALL open_aux_io_surf(&
132  hfile,hprogram,'FULL ')
133  CALL read_lecoclimap(&
134  hprogram,gecoclimap)
135  CALL close_aux_io_surf(hfile,hprogram)
136 ELSE
137  CALL open_aux_io_surf(&
138  hfile,hprogram,'TOWN ')
139  CALL read_surf(&
140  hprogram,'PAR_GARDEN',gpar_garden,iresp)
141  CALL close_aux_io_surf(hfile,hprogram)
142  gecoclimap = .NOT. gpar_garden
143 END IF
144 !
145 !------------------------------------------------------------------------------
146 !
147 !* permafrost distribution for soil depth
148 !
149 gperm =.false.
150 zperm(:)=0.0
151 !
152 IF (hnat=='NAT'.AND.(iversion>7 .OR. (iversion==7 .AND. ibugfix>3)))THEN
153  CALL open_aux_io_surf(&
154  hfile,hprogram,'NATURE')
155  yrecfm='PERMAFROST'
156  CALL read_surf(&
157  hprogram,yrecfm,gperm,iresp)
158  IF(gperm)THEN
159  yrecfm='PERM'
160  CALL read_surf(&
161  hprogram,yrecfm,zperm(:),iresp,hdir='A')
162  ENDIF
163  CALL close_aux_io_surf(hfile,hprogram)
164 ENDIF
165 !
166 ALLOCATE(pdepth(kni,klayer,kpatch))
167 pdepth(:,:,:) = xundef
168 !
169 kwg_layer(:,:) = nundef
170 !
171 IF (gecoclimap) THEN
172  !
173  CALL open_aux_io_surf(&
174  hfile,hprogram,'FULL ')
175  !
176  !* reading of the cover to obtain the depth of inter-layers
177  !
178  CALL old_name(&
179  hprogram,'COVER_LIST ',yrecfm)
180  CALL read_surf(&
181  hprogram,yrecfm,gcover(:),iresp,hdir='-')
182  !
183  ALLOCATE(zcover(kni,count(gcover)))
184  yrecfm='COVER'
185  CALL read_surf_cov(&
186  hprogram,yrecfm,zcover(:,:),gcover(:),iresp,hdir='A')
187  !
188  !* computes soil layers
189  !
190  CALL convert_cover_isba(dtco, i, &
191  hisba,1,zcover,gcover,' ',hnat,psoilgrid=psoilgrid, &
192  pperm=zperm,pdg=pdepth,kwg_layer=kwg_layer )
193  !
194  DEALLOCATE(zcover)
195  !
196  CALL close_aux_io_surf(hfile,hprogram)
197  !
198 ENDIF
199 !
200 IF (hnat=='GRD') THEN
201  CALL open_aux_io_surf(&
202  hfile,hprogram,'TOWN ')
203 ELSE
204  CALL open_aux_io_surf(&
205  hfile,hprogram,'NATURE')
206 ENDIF
207 !
208 !-------------------------------------------------------------------
209 IF (hnat=='NAT' .AND. (iversion>=7 .OR. .NOT.gecoclimap)) THEN
210  !
211  !* directly read soil layers in the file for nature ISBA soil layers
212  !
213  gdata_dg = .true.
214  IF (iversion>=7) THEN
215  yrecfm='L_DG'
216  ycomment=yrecfm
217  CALL read_surf(&
218  hprogram,yrecfm,gdata_dg,iresp,hcomment=ycomment)
219  ENDIF
220  !
221  IF (gdata_dg) THEN
222  !
223  ALLOCATE(zwork(kni,kpatch))
224  DO jlayer=1,klayer
225  IF (jlayer<10) WRITE(yrecfm,fmt='(A4,I1.1)') 'D_DG',jlayer
226  IF (jlayer>=10) WRITE(yrecfm,fmt='(A4,I2.2)') 'D_DG',jlayer
227  CALL read_surf_isba_par_n(dtco, u, i, &
228  hprogram,yrecfm,kluout,kni,zwork,iresp,iversion,hdir='A')
229  DO jpatch=1,kpatch
230  pdepth(:,jlayer,jpatch) = zwork(:,jpatch)
231  END DO
232  END DO
233  DEALLOCATE(zwork)
234  !
235  ENDIF
236  !
237  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=2) THEN
238  !
239  !cas when root_depth and ground_depth were extrapolated in extrapol_field
240  !during pgd step
241  IF (.NOT.gdata_dg .AND. hisba=="3-L") THEN
242  !
243  yrecfm2='L_ROOT_DEPTH'
244  ycomment=yrecfm2
245  CALL read_surf(hprogram,yrecfm2,gdata_root_depth,iresp,hcomment=ycomment)
246  !
247  IF (gdata_root_depth) THEN
248  yrecfm2='D_ROOT_DEPTH'
249  CALL read_surf_isba_par_n(dtco, u, i, &
250  hprogram,yrecfm2,kluout,kni,pdepth(:,2,:),iresp,iversion,hdir='A')
251  ENDIF
252  !
253  ENDIF
254  !
255  yrecfm2='L_GROUND_DEPTH'
256  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm2='L_GROUND_DPT'
257  ycomment=yrecfm2
258  CALL read_surf(&
259  hprogram,yrecfm2,gdata_ground_depth,iresp,hcomment=ycomment)
260  !
261  IF (gdata_ground_depth) THEN
262  !
263  yrecfm2='D_GROUND_DETPH'
264  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm2='D_GROUND_DPT'
265  ALLOCATE(zground_depth(kni,kpatch))
266  CALL read_surf_isba_par_n(dtco, u, i, &
267  hprogram,yrecfm2,kluout,kni,zground_depth(:,:),iresp,iversion,hdir='A')
268  !
269  IF (.NOT.gdata_dg) THEN
270  !
271  IF (hisba=="2-L") THEN
272  !
273  pdepth(:,2,:) = zground_depth(:,:)
274  pdepth(:,1,:) = xundef
275  WHERE (zground_depth(:,:)/=xundef) pdepth(:,1,:) = 0.01
276  !
277  ELSEIF (hisba=="3-L") THEN
278  !
279  pdepth(:,3,:) = zground_depth(:,:)
280  pdepth(:,1,:) = xundef
281  WHERE (zground_depth(:,:)/=xundef) pdepth(:,1,:) = 0.01
282  !
283  ELSEIF (hisba=="DIF") THEN
284  !
285  ALLOCATE(zsoilgrid(klayer))
286  DO jlayer=1,klayer
287  WRITE(ylvl,'(I4)') jlayer
288  yrecfm2='SOILGRID'//adjustl(ylvl(:len_trim(ylvl)))
289  CALL read_surf(hprogram,yrecfm,zsoilgrid(jlayer),iresp)
290  pdepth(:,jlayer,:) = zsoilgrid(jlayer)
291  ENDDO
292  DEALLOCATE(zsoilgrid)
293  !
294  ENDIF
295  ENDIF
296  !
297  DO jpatch=1,kpatch
298  DO jj=1,kni
299  DO jlayer=1,klayer
300  IF ( pdepth(jj,jlayer,jpatch) <= zground_depth(jj,jpatch) .AND. zground_depth(jj,jpatch) < xundef ) &
301  kwg_layer(jj,jpatch) = jlayer
302  ENDDO
303  ENDDO
304  ENDDO
305  DEALLOCATE(zground_depth)
306  !
307  ENDIF
308  !
309  ENDIF
310  !
311 ELSE IF (hnat=='GRD' .AND. .NOT.gecoclimap) THEN
312  !
313  !* computes soil layers from vegetation fractions read in the file
314  !
315  CALL read_surf(&
316  hprogram,'D_TYPE_HVEG',yhveg,iresp)
317  CALL read_surf(&
318  hprogram,'D_TYPE_LVEG',ylveg,iresp)
319  CALL read_surf(&
320  hprogram,'D_TYPE_NVEG',ynveg,iresp)
321  CALL read_surf(&
322  hprogram,'D_FRAC_HVEG',zhveg,iresp,hdir='A')
323  CALL read_surf(&
324  hprogram,'D_FRAC_LVEG',zlveg,iresp,hdir='A')
325  CALL read_surf(&
326  hprogram,'D_FRAC_NVEG',znveg,iresp,hdir='A')
327  ! Ground layers
328  CALL garden_soil_depth(ynveg,ylveg,yhveg,znveg,zlveg,zhveg,pdepth)
329  !
330 END IF
331 !
332  CALL close_aux_io_surf(hfile,hprogram)
333 !-------------------------------------------------------------------
334 !
335 IF (lhook) CALL dr_hook('MODE_READ_EXTERN:READ_EXTERN_DEPTH',1,zhook_handle)
336 !-------------------------------------------------------------------
337 !
338 END SUBROUTINE read_extern_depth
339 !
340 !
341 !-------------------------------------------------------------------
342 !---------------------------------------------------------------------------------------
343 !
344 ! #######################
345  SUBROUTINE read_extern_isba (U, &
346  dtco, i, &
347  hfile,hfiletype,hfilepgd,hfilepgdtype,&
348  kluout,kni,hfield,hname,pfield,pdepth,okey)
349 ! #######################
350 !
351 !
352 !
353 !
354 !
355 !
356 !
357 USE modd_surf_atm_n, ONLY : surf_atm_t
358 !
359 USE modd_data_cover_n, ONLY : data_cover_t
360 USE modd_isba_n, ONLY : isba_t
361 !
362 USE modd_isba_par, ONLY : xoptimgrid
363 !
364 USE mode_soil
365 USE modi_isba_soc_parameters
366 !
367 IMPLICIT NONE
368 !
369 !* dummy arguments
370 ! ---------------
371 !
372 !
373 !
374 TYPE(surf_atm_t), INTENT(INOUT) :: u
375 !
376 TYPE(data_cover_t), INTENT(INOUT) :: dtco
377 TYPE(isba_t), INTENT(INOUT) :: i
378 !
379  CHARACTER(LEN=28), INTENT(IN) :: hfile ! name of file
380  CHARACTER(LEN=6), INTENT(IN) :: hfiletype ! type of input file
381  CHARACTER(LEN=28), INTENT(IN) :: hfilepgd ! name of file
382  CHARACTER(LEN=6), INTENT(IN) :: hfilepgdtype ! type of input file
383 INTEGER, INTENT(IN) :: kluout ! logical unit of output listing
384 INTEGER, INTENT(IN) :: kni ! number of points
385  CHARACTER(LEN=7), INTENT(IN) :: hfield ! field name
386  CHARACTER(LEN=*), INTENT(IN) :: hname ! field name in the file
387 REAL, DIMENSION(:,:,:), POINTER :: pfield ! field to initialize
388 REAL, DIMENSION(:,:,:), POINTER :: pdepth ! depth of each inter-layer
389 LOGICAL, OPTIONAL, INTENT(INOUT) :: okey
390 !
391 !
392 !* local variables
393 ! ---------------
394 !
395  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
396  CHARACTER(LEN=4) :: ylvl
397  CHARACTER(LEN=3) :: yisba ! type of ISBA soil scheme
398  CHARACTER(LEN=3) :: ynat ! type of surface (nature, garden)
399  CHARACTER(LEN=4) :: ypedotf ! type of pedo-transfert function
400 INTEGER :: iresp ! reading return code
401 INTEGER :: ilayer ! number of layers
402 INTEGER :: jlayer ! loop counter
403 INTEGER :: ipatch ! number of patch
404 INTEGER :: jpatch ! loop counter
405 INTEGER :: jvegtype ! loop counter
406 LOGICAL :: gteb ! TEB field
407 INTEGER :: iwork ! work integer
408 INTEGER :: ji
409 !
410 REAL, DIMENSION(:,:), ALLOCATABLE :: zwork ! field read, one level, all patches
411 !
412 REAL, DIMENSION(:,:,:), ALLOCATABLE :: zvar ! profile of physical variable
413 REAL, DIMENSION(:), ALLOCATABLE :: zclay ! clay fraction
414 REAL, DIMENSION(:), ALLOCATABLE :: zsand ! sand fraction
415 REAL, DIMENSION(:), ALLOCATABLE :: zsoilgrid
416 REAL, DIMENSION(:), ALLOCATABLE :: znat ! natural surface fraction
417 !
418 REAL, DIMENSION(:,:), ALLOCATABLE :: zwwilt ! wilting point
419 REAL, DIMENSION(:,:), ALLOCATABLE :: zwfc ! field capacity
420 REAL, DIMENSION(:,:), ALLOCATABLE :: zwsat ! saturation
421 REAL, DIMENSION(:,:), ALLOCATABLE :: zpatch
422 REAL, DIMENSION(:,:), ALLOCATABLE :: zbcoef
423 REAL, DIMENSION(:,:), ALLOCATABLE :: zmpotsat
424 REAL, DIMENSION(:,:), ALLOCATABLE :: zhcapsoil
425 REAL, DIMENSION(:,:), ALLOCATABLE :: zconddry
426 REAL, DIMENSION(:,:), ALLOCATABLE :: zcondsld
427 REAL, DIMENSION(:,:), ALLOCATABLE :: zwd0
428 REAL, DIMENSION(:,:), ALLOCATABLE :: zaniso
429 REAL, DIMENSION(:,:), ALLOCATABLE :: zfracsoc
430 REAL, DIMENSION(:,:,:), ALLOCATABLE :: zcondsat
431 !
432 REAL, DIMENSION(KNI,2) :: zsoc
433 !
434 INTEGER, DIMENSION(:,:), ALLOCATABLE :: iwg_layer
435 !
436 LOGICAL :: gtemp_arp ! Arpege soil temperature profile
437 LOGICAL :: gsoc_data ! Soil organic carbon (data in pgd)
438 LOGICAL :: gsoc ! Soil organic carbon (physical option)
439 !
440 INTEGER :: iversion ! surface version
441 INTEGER :: ibugfix
442 !
443 REAL(KIND=JPRB) :: zhook_handle
444 !-------------------------------------------------------------------------------
445 IF (lhook) CALL dr_hook('MODE_READ_EXTERN:READ_EXTERN_ISBA',0,zhook_handle)
446 WRITE (kluout,*) ' | Reading ',hfield,' in externalized file'
447 !
448 !------------------------------------------------------------------------------
449 ! Init
450 !
451 gteb = (hname(1:3)=='TWN' .OR. hname(1:3)=='GD_' .OR. hname(1:3)=='GR_' &
452  .OR. hname(4:6)=='GD_' .OR. hname(4:6)=='GR_')
453 !
454 gtemp_arp = .false.
455 gsoc = .false.
456 gsoc_data = .false.
457 !
458 !------------------------------------------------------------------------------
459 !
460  CALL open_aux_io_surf(&
461  hfilepgd,hfilepgdtype,'FULL ')
462 yrecfm='VERSION'
463  CALL read_surf(&
464  hfilepgdtype,yrecfm,iversion,iresp)
465 yrecfm='BUG'
466  CALL read_surf(&
467  hfilepgdtype,yrecfm,ibugfix,iresp)
468  CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
469 !
470 IF (gteb) THEN
471  CALL open_aux_io_surf(&
472  hfilepgd,hfilepgdtype,'TOWN ')
473 ELSE
474  CALL open_aux_io_surf(&
475  hfilepgd,hfilepgdtype,'NATURE')
476 ENDIF
477 !
478 !* Read number of soil layers
479 !
480 yrecfm='GROUND_LAYER'
481 IF (gteb) THEN
482  yrecfm='TWN_LAYER'
483  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_LAYER'
484 ENDIF
485  CALL read_surf(&
486  hfilepgdtype,yrecfm,ilayer,iresp)
487 !
488 !* number of tiles
489 !
490 ipatch=1
491 IF (.NOT. gteb) THEN
492  yrecfm='PATCH_NUMBER'
493  CALL read_surf(&
494  hfilepgdtype,yrecfm,ipatch,iresp)
495 END IF
496 !
497 !* soil scheme
498 !
499 yrecfm='ISBA'
500 IF (gteb) THEN
501  yrecfm='TWN_ISBA'
502  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_ISBA'
503 ENDIF
504  CALL read_surf(&
505  hfilepgdtype,yrecfm,yisba,iresp)
506 IF(yisba=='DIF'.AND.present(okey))THEN
507  okey=.false.
508 ENDIF
509 !
510 IF (iversion>=7) THEN
511  !
512  !* Pedo-transfert function
513  !
514  yrecfm='PEDOTF'
515  IF (gteb) THEN
516  yrecfm='TWN_PEDOTF'
517  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_PEDOTF'
518  ENDIF
519  CALL read_surf(&
520  hfilepgdtype,yrecfm,ypedotf,iresp)
521  !
522 ELSE
523  ypedotf = 'CH78'
524 ENDIF
525 !
526 !Only Brook and Corey with Force-Restore scheme
527 IF(yisba/='DIF')THEN
528  ypedotf='CH78'
529 ENDIF
530 !
531 !-------------------------------------------------------------------------------
532 !
533 ! *. Read clay fraction
534 ! ------------------
535 !
536 ALLOCATE(zclay(kni))
537 yrecfm='CLAY'
538 IF (gteb) THEN
539  yrecfm='TWN_CLAY'
540  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_CLAY'
541 ENDIF
542  CALL read_surf(&
543  hfilepgdtype,yrecfm,zclay(:),iresp,hdir='A')
544 !
545 !-------------------------------------------------------------------------------
546 !
547 ! *. Read sand fraction
548 ! ------------------
549 !
550 ALLOCATE(zsand(kni))
551 yrecfm='SAND'
552 IF (gteb) THEN
553  yrecfm='TWN_SAND'
554  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_SAND'
555 ENDIF
556  CALL read_surf(&
557  hfilepgdtype,yrecfm,zsand(:),iresp,hdir='A')
558 !
559 !-------------------------------------------------------------------------------
560 !
561 !
562 ! *. Soil organic carbon profile
563 ! ---------------------------
564 !
565 IF ( (.NOT.gteb).AND.(iversion>7.OR.(iversion==7.AND.ibugfix>3)) &
566  .AND.(yisba=='DIF').AND.(hfield=='WG '.OR.hfield=='WGI ') ) THEN
567  yrecfm='SOCP'
568  CALL read_surf(&
569  hfilepgdtype,yrecfm,gsoc_data,iresp)
570  IF(gsoc_data)THEN
571  yrecfm='SOC_TOP'
572  CALL read_surf(&
573  hfilepgdtype,yrecfm,zsoc(:,1),iresp,hdir='A')
574  yrecfm='SOC_SUB'
575  CALL read_surf(&
576  hfilepgdtype,yrecfm,zsoc(:,2),iresp,hdir='A')
577  WHERE(zsoc(:,:)==xundef)zsoc(:,:)=0.0
578  ENDIF
579 ENDIF
580 !
581 !-------------------------------------------------------------------------------
582 !
583 ! *. Read soil grid
584 ! --------------
585 !
586 !* Reference grid for DIF
587 !
588 IF(yisba=='DIF') THEN
589  ALLOCATE(zsoilgrid(ilayer))
590  zsoilgrid=xundef
591  IF (iversion>=8) THEN
592  DO jlayer=1,ilayer
593  WRITE(ylvl,'(I4)') jlayer
594  yrecfm='SOILGRID'//adjustl(ylvl(:len_trim(ylvl)))
595  IF (gteb) THEN
596  yrecfm='GD_SGRID'//adjustl(ylvl(:len_trim(ylvl)))
597  ENDIF
598  CALL read_surf(&
599  hfilepgdtype,yrecfm,zsoilgrid(jlayer),iresp)
600  ENDDO
601  ELSEIF (iversion==7 .AND. ibugfix>=2) THEN
602  yrecfm='SOILGRID'
603  IF (gteb) THEN
604  yrecfm='TWN_SOILGRID'
605  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_SOILGRID'
606  ENDIF
607  CALL read_surf(&
608  hfilepgdtype,yrecfm,zsoilgrid,iresp,hdir='-')
609  ELSE
610  zsoilgrid(1:ilayer) = xoptimgrid(1:ilayer)
611  ENDIF
612 ELSE
613  ALLOCATE(zsoilgrid(0))
614 ENDIF
615 !
616 ALLOCATE(iwg_layer(kni,ipatch))
617 iwg_layer(:,:) = nundef
618 !
619 ! *. Read fraction of nature
620 ! --------------
621 !
622 ALLOCATE(znat(kni))
623 IF (iversion>=7) THEN
624  IF (gteb) THEN
625  CALL read_surf(hfilepgdtype,'FRAC_TOWN',znat,iresp,hdir='A')
626  ELSE
627  CALL read_surf(hfilepgdtype,'FRAC_NATURE',znat,iresp,hdir='A')
628  ENDIF
629 ELSE
630  znat=1.0
631 ENDIF
632 !
633  CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
634 !
635 IF (.NOT.gteb .AND. hfield=='TG ' .AND. (yisba=='2-L' .OR. yisba=='3-L') ) THEN
636  IF (iversion>7) THEN
637  yrecfm='TEMPARP'
638  CALL open_aux_io_surf(&
639  hfile,hfiletype,'NATURE')
640  CALL read_surf(&
641  hfilepgdtype,yrecfm,gtemp_arp,iresp)
642  IF(gtemp_arp)THEN
643  yrecfm = 'NTEMPLARP'
644  CALL read_surf(&
645  hfilepgdtype,yrecfm,ilayer,iresp)
646  ENDIF
647  CALL close_aux_io_surf(hfile,hfiletype)
648  ENDIF
649 ENDIF
650 !
651 IF ((hfield=='TG ') .AND. (yisba=='2-L' .OR. yisba=='3-L')) THEN
652  ALLOCATE(pdepth(kni,ilayer,nvegtype))
653  DO jvegtype=1,nvegtype
654  pdepth(:,1,jvegtype) = 0.01
655  pdepth(:,2,jvegtype) = 0.40
656  IF (ilayer==3) pdepth(:,3,jvegtype) = 5.00
657 ! GTEMP_ARP case
658  IF (gtemp_arp) THEN
659  pdepth(:,3,jvegtype) = 1.0
660  DO jlayer=4,ilayer
661  pdepth(:,jlayer,jvegtype) = pdepth(:,jlayer-1,jvegtype)+1.
662  ENDDO
663  ENDIF
664  END DO
665 ELSE
666  ynat='NAT'
667  IF (gteb) ynat='GRD'
668  CALL read_extern_depth(u, &
669  dtco, i, &
670  hfilepgd,hfilepgdtype,kluout,yisba,ynat,hfield,kni, &
671  ilayer,ipatch,zsoilgrid,pdepth,iversion,iwg_layer)
672 END IF
673 !
674 DEALLOCATE(zsoilgrid)
675 !
676 !
677 !* Allocate soil variable profile
678 ! ------------------------------
679 !
680 !
681 ALLOCATE(zvar(kni,ilayer,ipatch))
682 ALLOCATE(zwork(kni,ipatch))
683 zwork(:,: ) = xundef
684 zvar(:,:,:) = 0.0
685 !
686 ! *. Read soil variable profile
687 ! --------------------------
688 !
689 IF (gteb) THEN
690  CALL open_aux_io_surf(&
691  hfile,hfiletype,'TOWN ')
692 ELSE
693  CALL open_aux_io_surf(&
694  hfile,hfiletype,'NATURE')
695 ENDIF
696 !
697 iwork=ilayer
698 IF(yisba=='2-L'.OR.yisba=='3-L') THEN
699  SELECT CASE(hfield)
700  CASE('TG ')
701  IF(gtemp_arp)THEN
702  iwork=ilayer
703  ELSE
704  iwork=2
705  ENDIF
706  CASE('WGI ')
707  iwork=2
708  END SELECT
709 ENDIF
710 !
711 DO jlayer=1,iwork
712  WRITE(ylvl,'(I4)') jlayer
713  yrecfm=trim(hname)//adjustl(ylvl(:len_trim(ylvl)))
714  CALL read_surf(&
715  hfiletype,yrecfm,zwork(:,:),iresp,hdir='A')
716  DO jpatch=1,ipatch
717  WHERE (znat(:)==0.) zwork(:,jpatch) = xundef
718  zvar(:,jlayer,jpatch)=zwork(:,jpatch)
719  END DO
720 END DO
721 !
722 DEALLOCATE (znat)
723 !
724 IF(yisba=='3-L') THEN
725  SELECT CASE(hfield)
726  CASE('TG ')
727  IF(.NOT.gtemp_arp)zvar(:,3,:)=zvar(:,2,:)
728  CASE('WGI ')
729  zvar(:,3,:)=zvar(:,2,:)
730  END SELECT
731 ENDIF
732 !
733  CALL close_aux_io_surf(hfile,hfiletype)
734 !
735 DEALLOCATE(zwork)
736 !
737 !
738 ! *. Compute relative humidity from units kg/m^2 (SWI)
739 ! ------------------------------------------------
740 !
741 ALLOCATE(pfield(kni,ilayer,ipatch))
742 !
743 pfield(:,:,:) = zvar(:,:,:)
744 !
745 IF (hfield=='WG ' .OR. hfield=='WGI ') THEN
746  !
747  ! Compute ISBA model constants
748  !
749  ALLOCATE (zwfc(kni,ilayer))
750  ALLOCATE (zwwilt(kni,ilayer))
751  ALLOCATE (zwsat(kni,ilayer))
752  !
753  zwsat(:,1) = wsat_func(zclay(:),zsand(:),ypedotf)
754  zwwilt(:,1) = wwilt_func(zclay(:),zsand(:),ypedotf)
755  IF(yisba=='DIF')THEN
756  zwfc(:,1) = w33_func(zclay(:),zsand(:),ypedotf)
757  ELSE
758  zwfc(:,1) = wfc_func(zclay(:),zsand(:),ypedotf)
759  ENDIF
760  DO jlayer=2,ilayer
761  zwsat(:,jlayer) = zwsat(:,1)
762  zwfc(:,jlayer) = zwfc(:,1)
763  zwwilt(:,jlayer) = zwwilt(:,1)
764  ENDDO
765  !
766  DEALLOCATE (zsand)
767  DEALLOCATE (zclay)
768  !
769  IF(gsoc_data)THEN
770  !
771  ALLOCATE(zpatch(kni,ipatch))
772  !
773  CALL open_aux_io_surf(&
774  hfile,hfiletype,'NATURE')
775  yrecfm='SOC'
776  CALL read_surf(&
777  hfiletype,yrecfm,gsoc,iresp)
778  yrecfm='PATCH'
779  CALL read_surf(&
780  hfiletype,yrecfm,zpatch(:,:),iresp,hdir='A')
781  WHERE(zpatch(:,:)==xundef)zpatch(:,:)=0.0
782  CALL close_aux_io_surf(hfile,hfiletype)
783  !
784  IF(gsoc)THEN
785  ALLOCATE(zbcoef(kni,ilayer))
786  ALLOCATE(zmpotsat(kni,ilayer))
787  ALLOCATE(zhcapsoil(kni,ilayer))
788  ALLOCATE(zconddry(kni,ilayer))
789  ALLOCATE(zcondsld(kni,ilayer))
790  ALLOCATE(zwd0(kni,ilayer))
791  ALLOCATE(zaniso(kni,ilayer))
792  ALLOCATE(zfracsoc(kni,ilayer))
793  ALLOCATE(zcondsat(kni,ilayer,ipatch))
794  zbcoef(:,:)=0.0
795  zmpotsat(:,:)=0.0
796  zhcapsoil(:,:)=0.0
797  zconddry(:,:)=xundef
798  zcondsld(:,:)=xundef
799  zwd0(:,:)=0.0
800  zaniso(:,:)=0.0
801  zfracsoc(:,:)=0.0
802  zcondsat(:,:,:)=0.0
803  CALL isba_soc_parameters('NONE' ,zpatch,pdepth,zsoc,zbcoef,zmpotsat,&
804  zcondsat,zwsat,zhcapsoil,zconddry,zcondsld,&
805  zwfc,zwwilt,zwd0,zaniso,zfracsoc )
806  DEALLOCATE(zbcoef)
807  DEALLOCATE(zmpotsat)
808  DEALLOCATE(zcondsat)
809  DEALLOCATE(zhcapsoil)
810  DEALLOCATE(zconddry)
811  DEALLOCATE(zcondsld)
812  DEALLOCATE(zwd0)
813  DEALLOCATE(zaniso)
814  DEALLOCATE(zfracsoc)
815  ENDIF
816  !
817  DEALLOCATE(zpatch)
818  !
819  ENDIF
820  !
821  pfield(:,:,:) = xundef
822  !
823  IF(yisba=='DIF')THEN
824  !
825  ! extrapolation of deep layers
826  DO jpatch=1,ipatch
827  DO ji=1,kni
828  iwork=iwg_layer(ji,jpatch)
829  IF(iwork<ilayer)THEN
830  DO jlayer=iwork+1,ilayer
831  zvar(ji,jlayer,jpatch)=zvar(ji,iwork,jpatch)
832  ENDDO
833  ENDIF
834  ENDDO
835  ENDDO
836  ENDIF
837  !
838  IF (hfield=='WG ') THEN
839  DO jpatch=1,ipatch
840  DO jlayer=1,ilayer
841  DO ji=1,kni
842  IF(zvar(ji,jlayer,jpatch)/=xundef)THEN
843  zvar(ji,jlayer,jpatch) = max(min(zvar(ji,jlayer,jpatch),zwsat(ji,jlayer)),0.)
844  !
845  pfield(ji,jlayer,jpatch) = (zvar(ji,jlayer,jpatch) - zwwilt(ji,jlayer)) / (zwfc(ji,jlayer) - zwwilt(ji,jlayer))
846  ENDIF
847  END DO
848  END DO
849  END DO
850  ELSE IF (hfield=='WGI ') THEN
851  DO jpatch=1,ipatch
852  DO jlayer=1,ilayer
853  WHERE(zvar(:,jlayer,jpatch)/=xundef)
854  pfield(:,jlayer,jpatch) = zvar(:,jlayer,jpatch) / zwsat(:,jlayer)
855  END WHERE
856  END DO
857  END DO
858  END IF
859 !
860  DEALLOCATE (zwsat)
861  DEALLOCATE (zwwilt)
862  DEALLOCATE (zwfc)
863 !
864 END IF
865 !
866 DEALLOCATE(zvar)
867 DEALLOCATE(iwg_layer)
868 !-------------------------------------------------------------------------------
869 !
870 IF (lhook) CALL dr_hook('MODE_READ_EXTERN:READ_EXTERN_ISBA',1,zhook_handle)
871 !
872 !------------------------------------------------------------------------------
873 !
874 END SUBROUTINE read_extern_isba
875 !
876 !------------------------------------------------------------------------------
877 !
878 END MODULE mode_read_extern
modd_isba_par
Definition: modd_isba_par.F90:6
isba_soc_parameters
subroutine isba_soc_parameters(HRUNOFF, PPATCH, PDG, PSOC, PBCOEF, PMPOTSAT, PCONDSAT, PWSAT, PHCAPSOIL, PCONDDRY, PCONDSLD, PWFC, PWWILT, PWD0, PANISO, PFRACSOC)
Definition: isba_soc_parameters.F90:6
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
modd_isba_n
Definition: modd_isban.F90:6
modi_read_surf
Definition: read_surf.F90:6
mode_read_surf_cov::read_surf_cov
subroutine, public read_surf_cov(HPROGRAM, HREC, PFIELD, OFLAG, KRESP, HCOMMENT, HDIR)
Definition: mode_read_surf_cov.F90:15
modd_data_cover_n
Definition: modd_data_covern.F90:6
mode_read_extern
Definition: mode_read_extern.F90:6
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
modi_read_surf::read_surf
Definition: read_surf.F90:44
close_aux_io_surf
subroutine close_aux_io_surf(HFILE, HFILETYPE)
Definition: close_aux_io_surf.F90:6
mode_soil
Definition: mode_soil.F90:6
read_surf_isba_par_n
subroutine read_surf_isba_par_n(DTCO, U, I, HPROGRAM, HREC, KLUOUT, KSIZE, PFIELD, KRESP, KVERSION, HCOMMENT, HDIR)
Definition: read_surf_isba_parn.F90:6
mode_soil::wsat_func
Definition: mode_soil.F90:51
mode_soil::w33_func
Definition: mode_soil.F90:63
open_aux_io_surf
subroutine open_aux_io_surf(HFILE, HFILETYPE, HMASK)
Definition: open_aux_io_surf.F90:6
mode_read_extern::read_extern_isba
subroutine read_extern_isba(U, DTCO, I, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, KLUOUT, KNI, HFIELD, HNAME, PFIELD, PDEPTH, OKEY)
Definition: mode_read_extern.F90:345
mode_read_extern::read_extern_depth
subroutine read_extern_depth(U, DTCO, I, HFILE, HPROGRAM, KLUOUT, HISBA, HNAT, HFIELD, KNI, KLAYER, KPATCH, PSOILGRID, PDEPTH, KVERSION, KWG_LAYER)
Definition: mode_read_extern.F90:31
convert_cover_isba
subroutine convert_cover_isba(DTCO, I, HISBA, KDECADE, PCOVER, OCOVER, HPHOTO, HSFTYPE, PVEG, PLAI, PRSMIN, PGAMMA, PWRMAX_CF, PRGL, PCV, PSOILGRID, PPERM, PDG, KWG_LAYER, PDROOT, PDG2, PD_ICE, PZ0, PZ0_O_Z0H, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, PEMIS_ECO, PVEGTYPE, PROOTFRAC, PGMES, PBSLAI, PLAIMIN, PSEFOLD, PGC, PDMAX, PF2I, OSTRESS, PH_TREE, PRE25, PCE_NITRO, PCF_NITRO, PCNA_NITRO, TPSEED, TPREAP, PWATSUP, PIRRIG, PGNDLITTER, PLAIGV, PRSMINGV, PGAMMAGV, PWRMAX_CFGV, PRGLGV, PROOTFRACGV, PZ0LITTER, PH_VEG)
Definition: convert_cover_isba.F90:6
mode_read_surf_cov
Definition: mode_read_surf_cov.F90:6
mode_soil::wfc_func
Definition: mode_soil.F90:59
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
mode_soil::wwilt_func
Definition: mode_soil.F90:55
old_name
subroutine old_name(HPROGRAM, HRECIN, HRECOUT)
Definition: old_name.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
read_lecoclimap
subroutine read_lecoclimap(HPROGRAM, OECOCLIMAP)
Definition: read_lecoclimap.F90:6
Generated on Fri May 13 2016 09:31:04 for SURFEX by   doxygen 1.8.5