SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
read_pgd_teb_gardenn.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_pgd_teb_garden_n (CHT, DTCO, DTGD, GBGD, U, TGDO, TGDP, TG, TOP, &
7  hprogram,kversion,kbugfix)
8 ! #########################################
9 !
10 !!**** *READ_PGD_TEB_GARDEN_n* - routine to initialise ISBA physiographic variables
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 !! P. Le Moigne 12/2004 : add type of photosynthesis
37 !! B. Decharme 2008 : add XWDRAIN
38 !-------------------------------------------------------------------------------
39 !
40 !* 0. DECLARATIONS
41 ! ------------
42 !
43 !
44 !
45 !
46 !
47 USE modd_ch_teb_n, ONLY : ch_teb_t
51 USE modd_surf_atm_n, ONLY : surf_atm_t
54 USE modd_teb_grid_n, ONLY : teb_grid_t
56 !
57 USE modd_surf_par, ONLY : xundef
58 USE modd_isba_par, ONLY : xoptimgrid
59 !
60 USE modi_read_pgd_teb_garden_par_n
62 !
63 USE yomhook ,ONLY : lhook, dr_hook
64 USE parkind1 ,ONLY : jprb
65 !
66 USE modi_get_type_dim_n
67 !
68 IMPLICIT NONE
69 !
70 !* 0.1 Declarations of arguments
71 ! -------------------------
72 !
73 !
74 TYPE(ch_teb_t), INTENT(INOUT) :: cht
75 TYPE(data_cover_t), INTENT(INOUT) :: dtco
76 TYPE(data_teb_garden_t), INTENT(INOUT) :: dtgd
77 TYPE(gr_biog_garden_t), INTENT(INOUT) :: gbgd
78 TYPE(surf_atm_t), INTENT(INOUT) :: u
79 TYPE(teb_garden_options_t), INTENT(INOUT) :: tgdo
80 TYPE(teb_garden_pgd_t), INTENT(INOUT) :: tgdp
81 TYPE(teb_grid_t), INTENT(INOUT) :: tg
82 TYPE(teb_options_t), INTENT(INOUT) :: top
83 !
84  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! calling program
85 INTEGER, INTENT(IN) :: kversion ! version of SURFEX of the file being read
86 INTEGER, INTENT(IN) :: kbugfix
87 !
88 !* 0.2 Declarations of local variables
89 ! -------------------------------
90 !
91 INTEGER :: iresp ! Error code after redding
92 !
93  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
94 !
95 INTEGER :: jlayer ! loop counter on layers
96 REAL(KIND=JPRB) :: zhook_handle
97 !
98 !-------------------------------------------------------------------------------
99 !
100 !* 1D physical dimension
101 !
102 IF (lhook) CALL dr_hook('READ_PGD_TEB_GARDEN_N',0,zhook_handle)
103 yrecfm='SIZE_TOWN'
104  CALL get_type_dim_n(dtco, u, &
105  'TOWN ',tg%NDIM)
106 !
107 !
108 !* clay fraction : attention, seul un niveau est present dans le fichier
109 !* on rempli tout les niveaux de XCLAY avec les valeurs du fichiers
110 !
111 ALLOCATE(tgdp%XCLAY(tg%NDIM,tgdo%NGROUND_LAYER))
112 yrecfm='TWN_CLAY'
113 IF (kversion>7 .OR. kversion==7 .AND. kbugfix>=3) yrecfm='GD_CLAY'
114  CALL read_surf(&
115  hprogram,yrecfm,tgdp%XCLAY(:,1),iresp)
116 DO jlayer=2,tgdo%NGROUND_LAYER
117  tgdp%XCLAY(:,jlayer)=tgdp%XCLAY(:,1)
118 END DO
119 !
120 !* sand fraction
121 !
122 ALLOCATE(tgdp%XSAND(tg%NDIM,tgdo%NGROUND_LAYER))
123 yrecfm='TWN_SAND'
124 IF (kversion>7 .OR. kversion==7 .AND. kbugfix>=3) yrecfm='GD_SAND'
125  CALL read_surf(&
126  hprogram,yrecfm,tgdp%XSAND(:,1),iresp)
127 DO jlayer=2,tgdo%NGROUND_LAYER
128  tgdp%XSAND(:,jlayer)=tgdp%XSAND(:,1)
129 END DO
130 !
131 !* orographic runoff coefficient
132 !
133 ALLOCATE(tgdp%XRUNOFFB(tg%NDIM))
134 yrecfm='TWN_RUNOFFB'
135 IF (kversion>7 .OR. kversion==7 .AND. kbugfix>=3) yrecfm='GD_RUNOFFB'
136  CALL read_surf(&
137  hprogram,yrecfm,tgdp%XRUNOFFB,iresp)
138 !
139 !* subgrid drainage coefficient
140 !
141 ALLOCATE(tgdp%XWDRAIN(tg%NDIM))
142 IF (kversion<=3) THEN
143  tgdp%XWDRAIN = 0.
144 ELSE
145  yrecfm='TWN_WDRAIN'
146  IF (kversion>7 .OR. kversion==7 .AND. kbugfix>=3) yrecfm='GD_WDRAIN'
147  CALL read_surf(&
148  hprogram,yrecfm,tgdp%XWDRAIN,iresp)
149 ENDIF
150 !
151 !-------------------------------------------------------------------------------
152 !
153 !* biogenic chemical emissions
154 !
155 IF (cht%LCH_BIO_FLUX) THEN
156  ALLOCATE(gbgd%XISOPOT(tg%NDIM))
157  yrecfm='E_ISOPOT'
158  CALL read_surf(&
159  hprogram,yrecfm,gbgd%XISOPOT,iresp)
160  !
161  ALLOCATE(gbgd%XMONOPOT(tg%NDIM))
162  yrecfm='E_MONOPOT'
163  CALL read_surf(&
164  hprogram,yrecfm,gbgd%XMONOPOT,iresp)
165 ELSE
166  ALLOCATE(gbgd%XISOPOT (0))
167  ALLOCATE(gbgd%XMONOPOT(0))
168 END IF
169 !
170 !-------------------------------------------------------------------------------
171 !
172 !* 4. Physiographic data fields not to be computed by ecoclimap
173 ! ---------------------------------------------------------
174 !
175 IF (kversion>=7) THEN
176  yrecfm='PAR_GARDEN'
177  CALL read_surf(&
178  hprogram,yrecfm,tgdo%LPAR_GARDEN,iresp)
179 ELSEIF (.NOT.top%LECOCLIMAP) THEN
180  tgdo%LPAR_GARDEN = .true.
181 ELSE
182  tgdo%LPAR_GARDEN = .false.
183 ENDIF
184 !
185 IF (tgdo%LPAR_GARDEN) CALL read_pgd_teb_garden_par_n(&
186  dtgd, tgdo, tgdp, tg, &
187  hprogram)
188 IF (lhook) CALL dr_hook('READ_PGD_TEB_GARDEN_N',1,zhook_handle)
189 !
190 !
191 !-------------------------------------------------------------------------------
192 !
193 END SUBROUTINE read_pgd_teb_garden_n
subroutine get_type_dim_n(DTCO, U, HTYPE, KDIM)
subroutine read_pgd_teb_garden_n(CHT, DTCO, DTGD, GBGD, U, TGDO, TGDP, TG, TOP, HPROGRAM, KVERSION, KBUGFIX)