1!-------------------------------------------------------------------------------
2
3! This file is part of Code_Saturne, a general-purpose CFD tool.
4!
5! Copyright (C) 1998-2021 EDF S.A.
6!
7! This program is free software; you can redistribute it and/or modify it under
8! the terms of the GNU General Public License as published by the Free Software
9! Foundation; either version 2 of the License, or (at your option) any later
10! version.
11!
12! This program is distributed in the hope that it will be useful, but WITHOUT
13! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
15! details.
16!
17! You should have received a copy of the GNU General Public License along with
18! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
19! Street, Fifth Floor, Boston, MA 02110-1301, USA.
20
21!-------------------------------------------------------------------------------
22!> \file solcat.f90
23!> \brief Atmo. - Ground level parameters computed from a "Land use" file
24
25!> \brief ! *   definition des types de sol et des constantes associees
26!>   par defaut, on travaille avec un fichier d'occupation du sol
27!>   fourni par l'ign.
28!>
29!>-   le sol est classe soit en 7 categories :
30!>    1) eau
31!>    2) foret
32!>    3) divers
33!>    4) sol mineral nu
34!>    5) bati diffus
35!>    6) bati mixte
36!>    7) bati dense
37!>-   soit en 5 categories :
38!>    1) eau
39!>    2) foret
40!>    3) divers
41!>    4) sol mineral nu
42!>    5) bati
43!>
44!>   l'utilisateur peut modifier :
45!>     - les valeurs des constantes prises par defaut
46!>        (par exemple la rugosite de la foret)
47!>     - les types de sol a utiliser
48!>        (dans le cas de donnees ne provenant pas de l'ign)
49
50!-------------------------------------------------------------------------------
51! Arguments
52!______________________________________________________________________________.
53!  mode           name          role
54!______________________________________________________________________________!
55!> \param[out]   ierreu   code error
56!-------------------------------------------------------------------------------
57subroutine solcat ( ierreu )
58
59!==============================================================================
60! Module files
61!============================================================================
62
63use paramx
64use entsor
65use atsoil
66
67implicit none
68
69!==============================================================================
70! Arguments
71!==============================================================================
72
73integer ierreu
74
75!==============================================================================
76! Local variables
77!==============================================================================
78
79integer eau,foret,divers,minral,diffus,mixte,dense,bati
80integer n
81double precision codinv
82integer inityp
83character(len=50) :: raison
84character(len=10) :: inicat
85
86! initialisation
87
88inicat = 'xxxxxxxx'
89inityp = -9
90codinv = -999.d0
91
92do n = 1, nbrsol
93  tab_sol(n)%rugdyn = codinv
94  tab_sol(n)%rugthe = codinv
95  tab_sol(n)%albedo = codinv
96  tab_sol(n)%emissi = codinv
97  tab_sol(n)%csol   = codinv
98  tab_sol(n)%vegeta = codinv
99  tab_sol(n)%c1w    = codinv
100  tab_sol(n)%c2w    = codinv
101  tab_sol(n)%r1     = codinv
102  tab_sol(n)%r2     = codinv
103enddo
104
105do n = 1, nbrsol
106  tab_sol(n)%nomcat = inicat
107enddo
108
109! note: si vous utilisez d'autres categories de sol (comme prairie),
110!       rajoutez les a la liste deja existante au lieu de supprimer
111!       celles que vous n'utilisez pas ou encore pire d'utiliser un nom
112!       de categorie pour les coefficients d'une autre
113
114eau    = inityp
115foret  = inityp
116divers = inityp
117minral = inityp
118diffus = inityp
119mixte  = inityp
120dense  = inityp
121bati   = inityp
122
123! cas d'un fichier base sur donnees ign en 7 categories
124
125if (nbrsol.eq.7) then
126
127  ! definition des types de sol utilises et de l'ordre de rangement qui
128  ! doit etre le meme que celui du fichier d'occupation du sol utilise
129  ! dans lecsol
130
131  eau    = 1
132  foret  = 2
133  divers = 3
134  minral = 4
135  diffus = 5
136  mixte  = 6
137  dense  = 7
138
139  ! cas d'un fichier base sur donnees ign en 5 categories
140
141elseif (nbrsol.eq.5) then
142  eau    = 1
143  foret  = 2
144  divers = 3
145  minral = 4
146  bati   = 5
147endif
148
149! nom des categories de sol
150
151if(eau    .ne. inityp)tab_sol(eau)%nomcat    = ' eau    '
152if(foret  .ne. inityp)tab_sol(foret)%nomcat  = 'foret   '
153if(divers .ne. inityp)tab_sol(divers)%nomcat = 'divers  '
154if(minral .ne. inityp)tab_sol(minral)%nomcat = 'mineral '
155if(diffus .ne. inityp)tab_sol(diffus)%nomcat = 'bt diffu'
156if(mixte  .ne. inityp)tab_sol(mixte )%nomcat = 'bt mixte'
157if(dense  .ne. inityp)tab_sol(dense )%nomcat = 'bt dense'
158if(bati   .ne. inityp)tab_sol(bati  )%nomcat = 'bati    '
159
160! valeurs standard des parametres
161
162if(eau    .ne. inityp)tab_sol(eau)%rugdyn    = 0.0005d0
163if(foret  .ne. inityp)tab_sol(foret)%rugdyn  = 0.800d0
164if(divers .ne. inityp)tab_sol(divers)%rugdyn = 0.100d0
165if(minral .ne. inityp)tab_sol(minral)%rugdyn = 0.0012d0
166if(diffus .ne. inityp)tab_sol(diffus)%rugdyn = 0.250d0
167if(mixte  .ne. inityp)tab_sol(mixte )%rugdyn = 0.600d0
168if(dense  .ne. inityp)tab_sol(dense )%rugdyn = 1.000d0
169if(bati   .ne. inityp)tab_sol(bati  )%rugdyn = 0.600d0
170
171if(eau    .ne. inityp)tab_sol(eau)%rugthe    = tab_sol(eau)%rugdyn
172if(foret  .ne. inityp)tab_sol(foret)%rugthe  = tab_sol(foret)%rugdyn*exp(-2.d0)
173if(divers .ne. inityp)tab_sol(divers)%rugthe = tab_sol(divers)%rugdyn*exp(-2.d0)
174if(minral .ne. inityp)tab_sol(minral)%rugthe = tab_sol(minral)%rugdyn*exp(-2.d0)
175if(diffus .ne. inityp)tab_sol(diffus)%rugthe = tab_sol(diffus)%rugdyn*exp(-2.d0)
176if(mixte  .ne. inityp)tab_sol(mixte )%rugthe = tab_sol(mixte )%rugdyn*exp(-2.d0)
177if(dense  .ne. inityp)tab_sol(dense )%rugthe = tab_sol(dense )%rugdyn*exp(-2.d0)
178if(bati   .ne. inityp)tab_sol(bati  )%rugthe = tab_sol(bati  )%rugdyn*exp(-2.d0)
179
180if(eau    .ne. inityp)tab_sol(eau)%albedo    = 0.08d0
181if(foret  .ne. inityp)tab_sol(foret)%albedo  = 0.16d0
182if(divers .ne. inityp)tab_sol(divers)%albedo = 0.20d0
183if(minral .ne. inityp)tab_sol(minral)%albedo = 0.25d0
184if(diffus .ne. inityp)tab_sol(diffus)%albedo = 0.18d0
185if(mixte  .ne. inityp)tab_sol(mixte )%albedo = 0.18d0
186if(dense  .ne. inityp)tab_sol(dense )%albedo = 0.18d0
187if(bati   .ne. inityp)tab_sol(bati  )%albedo = 0.18d0
188
189if(eau    .ne. inityp)tab_sol(eau)%emissi    = 0.980d0
190if(foret  .ne. inityp)tab_sol(foret)%emissi  = 0.950d0
191if(divers .ne. inityp)tab_sol(divers)%emissi = 0.940d0
192if(minral .ne. inityp)tab_sol(minral)%emissi = 0.965d0
193if(diffus .ne. inityp)tab_sol(diffus)%emissi = 0.880d0
194if(mixte  .ne. inityp)tab_sol(mixte )%emissi = 0.880d0
195if(dense  .ne. inityp)tab_sol(dense )%emissi = 0.880d0
196if(bati   .ne. inityp)tab_sol(bati  )%emissi = 0.880d0
197
198if(eau    .ne. inityp)tab_sol(eau)%vegeta    = 0.00d0
199if(foret  .ne. inityp)tab_sol(foret)%vegeta  = 1.00d0
200if(divers .ne. inityp)tab_sol(divers)%vegeta = 1.00d0
201if(minral .ne. inityp)tab_sol(minral)%vegeta = 0.00d0
202if(diffus .ne. inityp)tab_sol(diffus)%vegeta = 0.50d0
203if(mixte  .ne. inityp)tab_sol(mixte )%vegeta = 0.25d0
204if(dense  .ne. inityp)tab_sol(dense )%vegeta = 0.00d0
205if(bati   .ne. inityp)tab_sol(bati  )%vegeta = 0.25d0
206
207if(eau    .ne. inityp)tab_sol(eau)%csol    =  7.6d-06
208if(foret  .ne. inityp)tab_sol(foret)%csol  = 11.0d-06
209if(divers .ne. inityp)tab_sol(divers)%csol = 11.0d-06
210if(minral .ne. inityp)tab_sol(minral)%csol =  5.0d-06
211if(dense  .ne. inityp)tab_sol(dense )%csol =  3.9d-06
212if(diffus .ne. inityp)                                                     &
213     tab_sol(diffus)%csol = tab_sol(foret)%csol*tab_sol(diffus)%vegeta +   &
214     tab_sol(dense)%csol*(1.d0-tab_sol(diffus)%vegeta)
215if(mixte  .ne. inityp)                                                     &
216     tab_sol(mixte )%csol =  tab_sol(foret )%csol*tab_sol(mixte )%vegeta + &
217     tab_sol(dense )%csol*(1.d0-tab_sol(mixte )%vegeta)
218if(bati  .ne. inityp)                                                      &
219     tab_sol(bati  )%csol =  tab_sol(foret )%csol*tab_sol(bati  )%vegeta + &
220     3.9d-06*(1.d0-tab_sol(bati  )%vegeta)
221if(eau    .ne. inityp)tab_sol(eau)%c1w    = 100.0d0
222if(foret  .ne. inityp)tab_sol(foret)%c1w  = 18.d0*tab_sol(foret)%vegeta + 2.d0
223if(divers .ne. inityp)tab_sol(divers)%c1w = 18.d0*tab_sol(divers)%vegeta + 2.d0
224if(minral .ne. inityp)tab_sol(minral)%c1w = 18.d0*tab_sol(minral)%vegeta + 2.d0
225if(diffus .ne. inityp)tab_sol(diffus)%c1w = 18.d0*tab_sol(diffus)%vegeta + 2.d0
226if(mixte  .ne. inityp)tab_sol(mixte )%c1w = 18.d0*tab_sol(mixte )%vegeta + 2.d0
227if(dense  .ne. inityp)tab_sol(dense )%c1w = 18.d0*tab_sol(dense )%vegeta + 2.d0
228if(bati   .ne. inityp)tab_sol(bati  )%c1w = 18.d0*tab_sol(bati  )%vegeta + 2.d0
229
230if(eau    .ne. inityp)tab_sol(eau)%c2w    = 1.00d0
231if(foret  .ne. inityp)tab_sol(foret)%c2w  = 0.20d0
232if(divers .ne. inityp)tab_sol(divers)%c2w = 0.20d0
233if(minral .ne. inityp)tab_sol(minral)%c2w = 0.20d0
234if(diffus .ne. inityp)tab_sol(diffus)%c2w = 0.20d0
235if(mixte  .ne. inityp)tab_sol(mixte )%c2w = 0.20d0
236if(dense  .ne. inityp)tab_sol(dense )%c2w = 0.20d0
237if(bati   .ne. inityp)tab_sol(bati  )%c2w = 0.20d0
238
239if(eau    .ne. inityp)tab_sol(eau)%r1    = 0.d0
240if(foret  .ne. inityp)tab_sol(foret)%r1  = 0.d0
241if(divers .ne. inityp)tab_sol(divers)%r1 = 0.d0
242if(minral .ne. inityp)tab_sol(minral)%r1 = 0.d0
243if(dense  .ne. inityp)tab_sol(dense )%r1 = 30.d0
244if(diffus .ne. inityp)tab_sol(diffus)%r1 = 10.d0
245if(mixte  .ne. inityp)tab_sol(mixte )%r1 = 15.d0
246if(bati   .ne. inityp)tab_sol(bati  )%r1 = 15.d0
247
248if(eau    .ne. inityp)tab_sol(eau)%r2    = 0.d0
249if(foret  .ne. inityp)tab_sol(foret)%r2  = 0.d0
250if(divers .ne. inityp)tab_sol(divers)%r2 = 0.d0
251if(minral .ne. inityp)tab_sol(minral)%r2 = 0.d0
252if(dense  .ne. inityp)tab_sol(dense )%r2 = 2.0d0
253if(diffus .ne. inityp)tab_sol(diffus)%r2 = 2.0d0/3.d0
254if(mixte  .ne. inityp)tab_sol(mixte )%r2 = 1.d0
255if(bati   .ne. inityp)tab_sol(bati  )%r2 = 1.0d0
256
257! impression de controle
258
259write(nfecra,2000)
260write(nfecra,2001)(tab_sol(n)%nomcat,'*',n=1,nbrsol)
261write(nfecra,2002)(tab_sol(n)%rugdyn,'*',n=1,nbrsol)
262write(nfecra,2003)(tab_sol(n)%rugthe,'*',n=1,nbrsol)
263write(nfecra,2004)(tab_sol(n)%albedo,'*',n=1,nbrsol)
264write(nfecra,2005)(tab_sol(n)%emissi,'*',n=1,nbrsol)
265write(nfecra,2006)(1.d+06*tab_sol(n)%csol  ,'*',n=1,nbrsol)
266write(nfecra,2007)(tab_sol(n)%vegeta,'*',n=1,nbrsol)
267write(nfecra,2008)(tab_sol(n)%c1w   ,'*',n=1,nbrsol)
268write(nfecra,2009)(tab_sol(n)%c2w   ,'*',n=1,nbrsol)
269write(nfecra,2010)(tab_sol(n)%r1    ,'*',n=1,nbrsol)
270write(nfecra,2011)(tab_sol(n)%r2    ,'*',n=1,nbrsol)
271write(nfecra,2012)
272
273! controle
274
275ierreu = nbrsol
276raison = ' coefficients incorrectement tabules '
277do n = 1, nbrsol, 1
278  if(tab_sol(n)%rugdyn.ne.codinv   .and. tab_sol(n)%rugthe.ne.codinv .and.         &
279       tab_sol(n)%albedo.ne.codinv .and. tab_sol(n)%emissi.ne.codinv .and.         &
280       tab_sol(n)%c1w.ne.codinv    .and. tab_sol(n)%c2w.ne.codinv    .and.         &
281       tab_sol(n)%csol.ne.codinv   .and. tab_sol(n)%r1.ne.codinv     .and.         &
282       tab_sol(n)%r2.ne.codinv) ierreu = ierreu - 1
283enddo
284
285! impression eventuelle d'un message d'erreur
286
287if(ierreu.ne.0) then
288  write(nfecra,9999)ierreu
289  write(nfecra,9990)raison
290endif
291
292!--------
293! formats
294!--------
295
2969999 format(//,5x,'%% erreur solcat: erreur numero ',i2)
2979990 format( 22x,a50)
298
2992000 format(//,8x,' ** ======================================== **',   &
300             /,8x,' ** Interface Sol Atmosphere (ISA)           **',   &
301             /,8x,' ** Valeurs des coefficients tabules         **',   &
302             /,8x,' ** ======================================== **',/)
3032001 format(   ' *            *',7(a8  ,a1))
3042002 format(   ' *z0 dynamique*',7(f8.4,a1))
3052003 format(   ' *z0 thermique*',7(f8.4,a1))
3062004 format(   ' *albedo      *',7(f8.4,a1))
3072005 format(   ' *emissivite  *',7(f8.4,a1))
3082006 format(   ' *csol (x1e+6)*',7(f8.4,a1))
3092007 format(   ' *vegetation  *',7(f8.4,a1))
3102008 format(   ' *c1w         *',7(f8.4,a1))
3112009 format(   ' *c2w         *',7(f8.4,a1))
3122010 format(   ' *r1          *',7(f8.4,a1))
3132011 format(   ' *r2          *',7(f8.4,a1))
3142012 format( /,8x,' ** ======================================== **',//)
315
316!===============================================================================
317! 8. SORTIE
318!===============================================================================
319
320return
321end subroutine solcat
322