source: LMDZ4/trunk/libf/phylmd/surf_land_bucket_mod.F90 @ 963

Last change on this file since 963 was 888, checked in by Laurent Fairhead, 17 years ago

Modifications sur l'albedo JG
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.9 KB
RevLine 
[781]1!
2! $Header$
3!
4MODULE surf_land_bucket_mod
5!
6! Surface land bucket module
7!
8! This module is used when no external land model is choosen.
9!
10  USE fonte_neige_mod
11  USE calcul_fluxs_mod
12  USE dimphy
13  USE mod_grid_phy_lmdz
14  USE mod_phys_lmdz_para
15 
16  IMPLICIT NONE
17
18CONTAINS
19
20  SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
21       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
[888]22       spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
23       u1_lay, v1_lay, rugoro, swnet, lwnet, &
24       snow, qsol, agesno, tsoil, &
25       qsurf, z0_new, alb1_new, alb2_new, evap, &
26       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
[781]27
28!****************************************************************************************
29! Bucket calculations for surface.
30!
[793]31    INCLUDE "clesphys.h"
32    INCLUDE "indicesol.h"
[781]33    INCLUDE "dimsoil.h"
[793]34    INCLUDE "YOMCST.h"
[781]35
36! Input variables 
37!****************************************************************************************
38    INTEGER, INTENT(IN)                     :: itime, jour, knon
39    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
40    LOGICAL, INTENT(IN)                     :: debut
41    REAL, INTENT(IN)                        :: dtime
42    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
43    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
44    REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
45    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
46    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
47    REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
48    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
[888]49    REAL, DIMENSION(klon), INTENT(IN)       :: pref
[781]50    REAL, DIMENSION(klon), INTENT(IN)       :: u1_lay, v1_lay
51    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
[888]52    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
[781]53
54! In/Output variables
55!****************************************************************************************
56    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
57    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
58    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
59
60! Output variables
61!****************************************************************************************
62    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
63    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
[888]64    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
[781]65    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
[888]66    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[781]67    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
68
69! Local variables
70!****************************************************************************************
71    REAL, DIMENSION(klon) :: soilcap, soilflux
72    REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
[888]73    REAL, DIMENSION(klon) :: alb_neig, alb_lim
[781]74    REAL, DIMENSION(klon) :: zfra
[888]75    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
[781]76    INTEGER               :: i
77!
78!****************************************************************************************
79
80
81!
[888]82!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
[781]83!
84    CALL interfsur_lim(itime, dtime, jour, &
85         knon, knindex, debut,  &
[888]86         alb_lim, z0_new)
[781]87   
88!
89!* Calcultaion of fluxes
90!
[888]91
92! calculate total absorbed radiance at surface
93       radsol(:) = 0.0
94       radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
95
[781]96! calculate constants
97    CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
98       
99! calculate temperature, heat capacity and conduction flux in soil
100    IF (soil_model) THEN
101       CALL soil(dtime, is_ter, knon, snow, tsurf, tsoil, soilcap, soilflux)
102       DO i=1, knon
103          cal(i) = RCPD / soilcap(i)
104          radsol(i) = radsol(i)  + soilflux(i)
105       END DO
106    ELSE
107       cal(:) = RCPD * capsol(:)
108    ENDIF
109   
110    CALL calcul_fluxs(knon, is_ter, dtime, &
[888]111         tsurf, p1lay, cal, beta, tq_cdrag, pref, &
[781]112         precip_rain, precip_snow, snow, qsurf,  &
113         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
114         petAcoef, peqAcoef, petBcoef, peqBcoef, &
115         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
116   
117!
118!* Calculate snow height, run_off, age of snow
119!     
120    CALL fonte_neige( knon, is_ter, knindex, dtime, &
121         tsurf, precip_rain, precip_snow, &
122         snow, qsol, tsurf_new, evap)
123!
124!* Calculate the age of snow
125!
126    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
127   
128    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
129   
130    DO i=1, knon
131       zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
[888]132       alb_lim(i)  = alb_neig(i) *zfra(i) + alb_lim(i)*(1.0-zfra(i))
[781]133    END DO
134
135!
[888]136!* Return albedo :
137!    alb1_new and alb2_new are here given the same values
138!
139    alb1_new(:) = 0.0
140    alb2_new(:) = 0.0
141    alb1_new(1:knon) = alb_lim(1:knon)
142    alb2_new(1:knon) = alb_lim(1:knon)
143       
144!
[781]145!* Calculate the rugosity
146!
147    z0_new = SQRT(z0_new**2+rugoro**2)
148       
149!
150!* End
151!
152  END SUBROUTINE surf_land_bucket
153!
154!****************************************************************************************
155!
156  SUBROUTINE interfsur_lim(itime, dtime, jour, &
157       knon, knindex, debut, &
158       lmt_alb_p, lmt_rug_p)
159   
160! Cette routine sert d'interface entre le modele atmospherique et un fichier
161! de conditions aux limites
162!
163! L. Fairhead 02/2000
164!
165! input:
166!   itime        numero du pas de temps courant
167!   dtime        pas de temps de la physique (en s)
168!   jour         jour a lire dans l'annee
169!   knon         nombre de points dans le domaine a traiter
170!   knindex      index des points de la surface a traiter
171!   debut        logical: 1er appel a la physique (initialisation)
172!
173! output:
174!   lmt_alb_p      Albedo lu
175!   lmt_rug_p      longueur de rugosite lue
176
177    INCLUDE "netcdf.inc"
178
179! Input variables
180!****************************************************************************************
181    INTEGER, INTENT(IN)                      :: itime
182    REAL   , INTENT(IN)                      :: dtime
183    INTEGER, INTENT(IN)                      :: jour
184    INTEGER, INTENT(IN)                      :: knon
185    INTEGER, DIMENSION(klon_loc), INTENT(IN) :: knindex
186    LOGICAL, INTENT(IN)                      :: debut
187
188! Output variables
189!****************************************************************************************
190    REAL, INTENT(out), DIMENSION(klon_loc)   :: lmt_alb_p
191    REAL, INTENT(out), DIMENSION(klon_loc)   :: lmt_rug_p
192
193! Local variables with attribute SAVE
194!****************************************************************************************
195    INTEGER,SAVE   :: lmt_pas     ! frequence de lecture des conditions limites
196                                  ! (en pas de physique)
197    !$OMP THREADPRIVATE(lmt_pas)
198    LOGICAL,SAVE   :: deja_lu_sur ! pour indiquer que le jour a lire a deja
199                                  ! lu pour une surface precedente
200    !$OMP THREADPRIVATE(deja_lu_sur)
201    INTEGER,SAVE                           :: jour_lu_sur
202    !$OMP THREADPRIVATE(jour_lu_sur)
203    CHARACTER (len = 20),SAVE              :: fich ='limit.nc'
204    !$OMP THREADPRIVATE(fich)
205    LOGICAL,SAVE                           :: check = .FALSE.
206    !$OMP THREADPRIVATE(check)
207! Champs lus dans le fichier de CL
208    REAL, ALLOCATABLE , SAVE, DIMENSION(:) :: alb_lu_p, rug_lu_p
209    !$OMP THREADPRIVATE(alb_lu_p, rug_lu_p)
210
211! quelques variables pour netcdf
212    INTEGER ,SAVE                          :: nid, nvarid
213    !$OMP THREADPRIVATE(nid, nvarid)
214    INTEGER, DIMENSION(2),SAVE             :: start, epais
215    !$OMP THREADPRIVATE(start, epais)
216
217! Other local variables
218!****************************************************************************************
219    INTEGER                                :: ii, ierr
220    CHARACTER (len = 20)                   :: modname = 'interfsur_lim'
221    CHARACTER (len = 80)                   :: abort_message
222    REAL, DIMENSION(klon_glo)              :: alb_lu
223    REAL, DIMENSION(klon_glo)              :: rug_lu
224
225!
226! End delaration
227!****************************************************************************************
228
229    IF (debut) THEN
230       lmt_pas = NINT(86400./dtime * 1.0) ! pour une lecture une fois par jour
231       jour_lu_sur = jour - 1
232       ALLOCATE(alb_lu_p(klon_loc))
233       ALLOCATE(rug_lu_p(klon_loc))
234    ENDIF
235   
236    IF ((jour - jour_lu_sur) /= 0) deja_lu_sur = .FALSE.
237 
238    IF (check) WRITE(*,*) modname,':: jour_lu_sur, deja_lu_sur', jour_lu_sur, deja_lu_sur
239    IF (check) WRITE(*,*) modname,':: itime, lmt_pas', itime, lmt_pas
240    IF (check) CALL flush(6)
241
242!   
243! Tester d'abord si c'est le moment de lire le fichier
244!
245    IF (MOD(itime-1, lmt_pas) == 0 .AND. .NOT. deja_lu_sur) THEN
246
247!
248! Ouverture et lecture du fichier
249!
250!$OMP MASTER
251       IF (is_mpi_root) THEN
252          fich = TRIM(fich)
253          IF (check) WRITE(*,*)modname,' ouverture fichier ',fich
254          IF (check) CALL flush(6)
255          ierr = NF_OPEN (fich, NF_NOWRITE,nid)
256          IF (ierr.NE.NF_NOERR) THEN
257             abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
258             CALL abort_gcm(modname,abort_message,1)
259          ENDIF
260!
261! La tranche de donnees a lire:
262          start(1) = 1
263          start(2) = jour
264          epais(1) = klon_glo
265          epais(2) = 1
266!
267! Lecture albedo
268          ierr = NF_INQ_VARID(nid, 'ALB', nvarid)
269          IF (ierr /= NF_NOERR) THEN
270             abort_message = 'Le champ <ALB> est absent'
271             CALL abort_gcm(modname,abort_message,1)
272          ENDIF
273#ifdef NC_DOUBLE
274          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, alb_lu)
275#else
276          ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, alb_lu)
277#endif
278          IF (ierr /= NF_NOERR) THEN
279             abort_message = 'Lecture echouee pour <ALB>'
280             CALL abort_gcm(modname,abort_message,1)
281          ENDIF
282!
283! Lecture rugosite!
284          ierr = NF_INQ_VARID(nid, 'RUG', nvarid)
285          IF (ierr /= NF_NOERR) THEN
286             abort_message = 'Le champ <RUG> est absent'
287             CALL abort_gcm(modname,abort_message,1)
288          ENDIF
289#ifdef NC_DOUBLE
290          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, rug_lu)
291#else
292          ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, rug_lu)
293#endif
294          IF (ierr /= NF_NOERR) THEN
295             abort_message = 'Lecture echouee pour <RUG>'
296             CALL abort_gcm(modname,abort_message,1)
297          ENDIF
298
299!
300! Fin de lecture
301          ierr = NF_CLOSE(nid)
302
303       ENDIF ! is_mpi_root
304!$OMP END MASTER
305
306       CALL Scatter(alb_lu,alb_lu_p)
307       CALL Scatter(rug_lu,rug_lu_p)
308
309       deja_lu_sur = .TRUE.
310       jour_lu_sur = jour       
311
312    ENDIF
313 
314!
315! Recopie des variables dans les champs de sortie
316!
317    lmt_alb_p(:) = 999999.
318    lmt_rug_p(:) = 999999.
319    DO ii = 1, knon
320       lmt_alb_p(ii) = alb_lu_p(knindex(ii))
321       lmt_rug_p(ii) = rug_lu_p(knindex(ii))
322    ENDDO
323   
324
325  END SUBROUTINE interfsur_lim
326!
327!****************************************************************************************
328!
329END MODULE surf_land_bucket_mod
Note: See TracBrowser for help on using the repository browser.