/[lmdze]/trunk/Sources/phylmd/Interface_surf/interfsurf_hq.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Interface_surf/interfsurf_hq.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 71 by guez, Thu Jul 26 14:37:37 2012 UTC revision 72 by guez, Tue Jul 23 13:00:07 2013 UTC
# Line 4  module interfsurf_hq_m Line 4  module interfsurf_hq_m
4    
5  contains  contains
6    
7    SUBROUTINE interfsurf_hq(itime, dtime, date0, jour, rmu0, klon, iim, jjm, &    SUBROUTINE interfsurf_hq(itime, dtime, jour, rmu0, klon, iim, jjm, &
8         nisurf, knon, knindex, pctsrf, rlon, rlat, cufi, cvfi, debut, lafin, &         nisurf, knon, knindex, pctsrf, rlat, debut, &
9         ok_veget, soil_model, nsoilmx, tsoil, qsol, zlev, u1_lay, v1_lay, &         ok_veget, soil_model, nsoilmx, tsoil, qsol, u1_lay, v1_lay, &
10         temp_air, spechum, epot_air, ccanopy, tq_cdrag, petAcoef, peqAcoef, &         temp_air, spechum, tq_cdrag, petAcoef, peqAcoef, &
11         petBcoef, peqBcoef, precip_rain, precip_snow, sollw, sollwdown, swnet, &         petBcoef, peqBcoef, precip_rain, precip_snow, &
12         swdown, fder, taux, tauy, windsp, rugos, rugoro, albedo, snow, qsurf, &         fder, rugos, rugoro, snow, qsurf, &
13         tsurf, p1lay, ps, radsol, ocean, npas, nexca, zmasq, evap, fluxsens, &         tsurf, p1lay, ps, radsol, ocean, evap, fluxsens, &
14         fluxlat, dflux_l, dflux_s, tsol_rad, tsurf_new, alb_new, alblw, &         fluxlat, dflux_l, dflux_s, tsurf_new, alb_new, alblw, &
15         emis_new, z0_new, pctsrf_new, agesno, fqcalving, ffonte, &         z0_new, pctsrf_new, agesno, fqcalving, ffonte, &
16         run_off_lic_0, flux_o, flux_g, tslab, seaice)         run_off_lic_0, flux_o, flux_g, tslab, seaice)
17    
18      ! Cette routine sert d'aiguillage entre l'atmosphère et la surface      ! Cette routine sert d'aiguillage entre l'atmosphère et la surface
19      ! en général (sols continentaux, océans, glaces) pour les flux de      ! en général (sols continentaux, océans, glaces) pour les flux de
20      ! chaleur et d'humidité.      ! chaleur et d'humidité. En pratique l'interface se fait entre la
21      ! En pratique l'interface se fait entre la couche limite du modèle      ! couche limite du modèle atmosphérique ("clmain.F") et les
22      ! atmosphérique ("clmain.F") et les routines de surface      ! routines de surface ("sechiba", "oasis"...).
23      ! ("sechiba", "oasis"...).  
24        ! Laurent Fairhead 02/2000
25      ! L.Fairhead 02/2000  
26        USE abort_gcm_m, ONLY: abort_gcm
27      use abort_gcm_m, only: abort_gcm      USE albsno_m, ONLY: albsno
28      use gath_cpl, only: gath2cpl      USE calcul_fluxs_m, ONLY: calcul_fluxs
29      use indicesol      USE fonte_neige_m, ONLY: fonte_neige
30      use SUPHEC_M      USE gath_cpl, ONLY: gath2cpl
31      use albsno_m, only: albsno      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
32      use interface_surf      USE interface_surf, ONLY: coastalflow, riverflow, run_off, &
33      use interfsur_lim_m, only: interfsur_lim           run_off_lic, conf_interface, tmp_rcoa, tmp_rlic, tmp_rriv
34      use calcul_fluxs_m, only: calcul_fluxs      USE interfoce_lim_m, ONLY: interfoce_lim
35      use fonte_neige_m, only: fonte_neige      USE interfoce_slab_m, ONLY: interfoce_slab
36      use interfoce_lim_m, only: interfoce_lim      USE interfsur_lim_m, ONLY: interfsur_lim
37      use interfoce_slab_m, only: interfoce_slab      USE suphec_m, ONLY: rcpd, rlstt, rlvtt, rtt
38    
39      ! Parametres d'entree      ! Parametres d'entree
40      ! input:      ! input:
41      ! klon nombre total de points de grille      ! klon nombre total de points de grille
42      ! iim, jjm nbres de pts de grille      ! iim, jjm nbres de pts de grille
43      ! dtime pas de temps de la physique (en s)      ! dtime pas de temps de la physique (en s)
     ! date0 jour initial  
44      ! jour jour dans l'annee en cours,      ! jour jour dans l'annee en cours,
45      ! rmu0 cosinus de l'angle solaire zenithal      ! rmu0 cosinus de l'angle solaire zenithal
     ! nexca pas de temps couplage  
46      ! nisurf index de la surface a traiter (1 = sol continental)      ! nisurf index de la surface a traiter (1 = sol continental)
47      ! knon nombre de points de la surface a traiter      ! knon nombre de points de la surface a traiter
48      ! knindex index des points de la surface a traiter      ! knindex index des points de la surface a traiter
49      ! pctsrf tableau des pourcentages de surface de chaque maille      ! pctsrf tableau des pourcentages de surface de chaque maille
     ! rlon longitudes  
50      ! rlat latitudes      ! rlat latitudes
     ! cufi, cvfi resolution des mailles en x et y (m)  
51      ! debut logical: 1er appel a la physique      ! debut logical: 1er appel a la physique
     ! lafin logical: dernier appel a la physique  
52      ! ok_veget logical: appel ou non au schema de surface continental      ! ok_veget logical: appel ou non au schema de surface continental
53      ! (si false calcul simplifie des fluxs sur les continents)      ! (si false calcul simplifie des fluxs sur les continents)
     ! zlev hauteur de la premiere couche  
54      ! u1_lay vitesse u 1ere couche      ! u1_lay vitesse u 1ere couche
55      ! v1_lay vitesse v 1ere couche      ! v1_lay vitesse v 1ere couche
56      ! temp_air temperature de l'air 1ere couche      ! temp_air temperature de l'air 1ere couche
57      ! spechum humidite specifique 1ere couche      ! spechum humidite specifique 1ere couche
     ! epot_air temp potentielle de l'air  
     ! ccanopy concentration CO2 canopee  
58      ! tq_cdrag cdrag      ! tq_cdrag cdrag
59      ! petAcoef coeff. A de la resolution de la CL pour t      ! petAcoef coeff. A de la resolution de la CL pour t
60      ! peqAcoef coeff. A de la resolution de la CL pour q      ! peqAcoef coeff. A de la resolution de la CL pour q
# Line 70  contains Line 62  contains
62      ! peqBcoef coeff. B de la resolution de la CL pour q      ! peqBcoef coeff. B de la resolution de la CL pour q
63      ! precip_rain precipitation liquide      ! precip_rain precipitation liquide
64      ! precip_snow precipitation solide      ! precip_snow precipitation solide
     ! sollw flux IR net a la surface  
     ! sollwdown flux IR descendant a la surface  
     ! swnet flux solaire net  
     ! swdown flux solaire entrant a la surface  
     ! albedo albedo de la surface  
65      ! tsurf temperature de surface      ! tsurf temperature de surface
66      ! tslab temperature slab ocean      ! tslab temperature slab ocean
67      ! pctsrf_slab pourcentages (0-1) des sous-surfaces dans le slab      ! pctsrf_slab pourcentages (0-1) des sous-surfaces dans le slab
# Line 84  contains Line 71  contains
71      ! radsol rayonnement net aus sol (LW + SW)      ! radsol rayonnement net aus sol (LW + SW)
72      ! ocean type d'ocean utilise ("force" ou "slab" mais pas "couple")      ! ocean type d'ocean utilise ("force" ou "slab" mais pas "couple")
73      ! fder derivee des flux (pour le couplage)      ! fder derivee des flux (pour le couplage)
     ! taux, tauy tension de vents  
     ! windsp module du vent a 10m  
74      ! rugos rugosite      ! rugos rugosite
     ! zmasq masque terre/ocean  
75      ! rugoro rugosite orographique      ! rugoro rugosite orographique
76      ! run_off_lic_0 runoff glacier du pas de temps precedent      ! run_off_lic_0 runoff glacier du pas de temps precedent
77      integer, intent(IN) :: itime ! numero du pas de temps      integer, intent(IN):: itime ! numero du pas de temps
78      integer, intent(IN) :: iim, jjm      integer, intent(IN):: iim, jjm
79      integer, intent(IN) :: klon      integer, intent(IN):: klon
80      real, intent(IN) :: dtime      real, intent(IN):: dtime
81      real, intent(IN) :: date0      integer, intent(IN):: jour
82      integer, intent(IN) :: jour      real, intent(IN):: rmu0(klon)
83      real, intent(IN) :: rmu0(klon)      integer, intent(IN):: nisurf
84      integer, intent(IN) :: nisurf      integer, intent(IN):: knon
85      integer, intent(IN) :: knon      integer, dimension(klon), intent(in):: knindex
     integer, dimension(klon), intent(in) :: knindex  
86      real, intent(IN):: pctsrf(klon, nbsrf)      real, intent(IN):: pctsrf(klon, nbsrf)
87      logical, intent(IN) :: debut, lafin, ok_veget      logical, intent(IN):: debut, ok_veget
88      real, dimension(klon), intent(IN) :: rlon, rlat      real, dimension(klon), intent(IN):: rlat
89      real, dimension(klon), intent(IN) :: cufi, cvfi      real, dimension(klon), intent(INOUT):: tq_cdrag
90      real, dimension(klon), intent(INOUT) :: tq_cdrag      real, dimension(klon), intent(IN):: u1_lay, v1_lay
91      real, dimension(klon), intent(IN) :: zlev      real, dimension(klon), intent(IN):: temp_air, spechum
92      real, dimension(klon), intent(IN) :: u1_lay, v1_lay      real, dimension(klon), intent(IN):: petAcoef, peqAcoef
93      real, dimension(klon), intent(IN) :: temp_air, spechum      real, dimension(klon), intent(IN):: petBcoef, peqBcoef
94      real, dimension(klon), intent(IN) :: epot_air, ccanopy      real, dimension(klon), intent(IN):: precip_rain, precip_snow
95      real, dimension(klon), intent(IN) :: petAcoef, peqAcoef      real, dimension(klon), intent(IN):: ps
96      real, dimension(klon), intent(IN) :: petBcoef, peqBcoef      real, dimension(klon), intent(IN):: tsurf, p1lay
     real, dimension(klon), intent(IN) :: precip_rain, precip_snow  
     real, dimension(klon), intent(IN) :: sollw, sollwdown, swnet, swdown  
     real, dimension(klon), intent(IN) :: ps, albedo  
     real, dimension(klon), intent(IN) :: tsurf, p1lay  
97      !IM: "slab" ocean      !IM: "slab" ocean
98      real, dimension(klon), intent(INOUT) :: tslab      real, dimension(klon), intent(INOUT):: tslab
99      real, allocatable, dimension(:), save :: tmp_tslab      real, allocatable, dimension(:), save:: tmp_tslab
100      real, dimension(klon), intent(OUT) :: flux_o, flux_g      real, dimension(klon), intent(OUT):: flux_o, flux_g
101      real, dimension(klon), intent(INOUT) :: seaice ! glace de mer (kg/m2)      real, dimension(klon), intent(INOUT):: seaice ! glace de mer (kg/m2)
102      REAL, DIMENSION(klon), INTENT(INOUT) :: radsol, fder      REAL, DIMENSION(klon), INTENT(INOUT):: radsol, fder
103      real, dimension(klon), intent(IN) :: zmasq      real, dimension(klon), intent(IN):: rugos, rugoro
     real, dimension(klon), intent(IN) :: taux, tauy, rugos, rugoro  
     real, dimension(klon), intent(IN) :: windsp  
104      character(len=*), intent(IN):: ocean      character(len=*), intent(IN):: ocean
105      integer :: npas, nexca ! nombre et pas de temps couplage      real, dimension(klon), intent(INOUT):: evap, snow, qsurf
     real, dimension(klon), intent(INOUT) :: evap, snow, qsurf  
106      !! PB ajout pour soil      !! PB ajout pour soil
107      logical, intent(in):: soil_model      logical, intent(in):: soil_model
108      integer :: nsoilmx      integer:: nsoilmx
109      REAL, DIMENSION(klon, nsoilmx) :: tsoil      REAL, DIMENSION(klon, nsoilmx):: tsoil
110      REAL, dimension(klon), intent(INOUT) :: qsol      REAL, dimension(klon), intent(INOUT):: qsol
111      REAL, dimension(klon) :: soilcap      REAL, dimension(klon):: soilcap
112      REAL, dimension(klon) :: soilflux      REAL, dimension(klon):: soilflux
113    
114      ! Parametres de sortie      ! Parametres de sortie
115      ! output:      ! output:
116      ! evap evaporation totale      ! evap evaporation totale
117      ! fluxsens flux de chaleur sensible      ! fluxsens flux de chaleur sensible
118      ! fluxlat flux de chaleur latente      ! fluxlat flux de chaleur latente
     ! tsol_rad  
119      ! tsurf_new temperature au sol      ! tsurf_new temperature au sol
120      ! alb_new albedo      ! alb_new albedo
     ! emis_new emissivite  
121      ! z0_new surface roughness      ! z0_new surface roughness
122      ! pctsrf_new nouvelle repartition des surfaces      ! pctsrf_new nouvelle repartition des surfaces
123      real, dimension(klon), intent(OUT):: fluxsens, fluxlat      real, dimension(klon), intent(OUT):: fluxsens, fluxlat
124      real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new      real, dimension(klon), intent(OUT):: tsurf_new, alb_new
125      real, dimension(klon), intent(OUT):: alblw      real, dimension(klon), intent(OUT):: alblw
126      real, dimension(klon), intent(OUT):: emis_new, z0_new      real, dimension(klon), intent(OUT):: z0_new
127      real, dimension(klon), intent(OUT):: dflux_l, dflux_s      real, dimension(klon), intent(OUT):: dflux_l, dflux_s
128      real, dimension(klon, nbsrf), intent(OUT) :: pctsrf_new      real, dimension(klon, nbsrf), intent(OUT):: pctsrf_new
129      real, dimension(klon), intent(INOUT):: agesno      real, dimension(klon), intent(INOUT):: agesno
130      real, dimension(klon), intent(INOUT):: run_off_lic_0      real, dimension(klon), intent(INOUT):: run_off_lic_0
131    
# Line 163  contains Line 137  contains
137      !jld a rajouter real, dimension(klon), intent(INOUT):: fqcalving      !jld a rajouter real, dimension(klon), intent(INOUT):: fqcalving
138      real, dimension(klon), intent(INOUT):: fqcalving      real, dimension(klon), intent(INOUT):: fqcalving
139      !IM: "slab" ocean - Local      !IM: "slab" ocean - Local
140      real, parameter :: t_grnd=271.35      real, parameter:: t_grnd=271.35
141      real, dimension(klon) :: zx_sl      real, dimension(klon):: zx_sl
142      integer i      integer i
143      real, allocatable, dimension(:), save :: tmp_flux_o, tmp_flux_g      real, allocatable, dimension(:), save:: tmp_flux_o, tmp_flux_g
144      real, allocatable, dimension(:), save :: tmp_radsol      real, allocatable, dimension(:), save:: tmp_radsol
145      real, allocatable, dimension(:, :), save :: tmp_pctsrf_slab      real, allocatable, dimension(:, :), save:: tmp_pctsrf_slab
146      real, allocatable, dimension(:), save :: tmp_seaice      real, allocatable, dimension(:), save:: tmp_seaice
147    
148      ! Local      ! Local
149      character (len = 20), save :: modname = 'interfsurf_hq'      character (len = 20), save:: modname = 'interfsurf_hq'
150      character (len = 80) :: abort_message      character (len = 80):: abort_message
151      logical, save :: first_call = .true.      logical, save:: first_call = .true.
152      integer, save :: error      integer, save:: error
153      integer :: ii      integer:: ii
154      logical, save :: check = .false.      logical, save:: check = .false.
155      real, dimension(klon):: cal, beta, dif_grnd, capsol      real, dimension(klon):: cal, beta, dif_grnd, capsol
156      real, parameter :: calice=1.0/(5.1444e+06*0.15), tau_gl=86400.*5.      real, parameter:: calice=1.0/(5.1444e+06*0.15), tau_gl=86400.*5.
157      real, parameter :: calsno=1./(2.3867e+06*.15)      real, parameter:: calsno=1./(2.3867e+06*.15)
158      real, dimension(klon):: tsurf_temp      real, dimension(klon):: tsurf_temp
159      real, dimension(klon):: alb_neig, alb_eau      real, dimension(klon):: alb_neig, alb_eau
160      real, DIMENSION(klon):: zfra      real, DIMENSION(klon):: zfra
161      logical :: cumul = .false.      logical:: cumul = .false.
162      INTEGER, dimension(1) :: iloc      INTEGER, dimension(1):: iloc
163      real, dimension(klon):: fder_prev      real, dimension(klon):: fder_prev
164      REAL, dimension(klon) :: bidule      REAL, dimension(klon):: bidule
165    
166      !-------------------------------------------------------------      !-------------------------------------------------------------
167    
# Line 197  contains Line 171  contains
171      ! car l'ocean a besoin du ruissellement qui est y calcule      ! car l'ocean a besoin du ruissellement qui est y calcule
172    
173      if (first_call) then      if (first_call) then
174         call conf_interface(tau_calv)         call conf_interface
175         if (nisurf /= is_ter .and. klon > 1) then         if (nisurf /= is_ter .and. klon > 1) then
176            write(*, *)' *** Warning ***'            write(*, *)' *** Warning ***'
177            write(*, *)' nisurf = ', nisurf, ' /= is_ter = ', is_ter            write(*, *)' nisurf = ', nisurf, ' /= is_ter = ', is_ter
# Line 500  contains Line 474  contains
474            CALL calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)            CALL calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)
475    
476            IF (soil_model) THEN            IF (soil_model) THEN
477               CALL soil(dtime, nisurf, knon, snow, tsurf_new, tsoil, soilcap, soilflux)               CALL soil(dtime, nisurf, knon, snow, tsurf_new, tsoil, soilcap, &
478                      soilflux)
479               cal(1:knon) = RCPD / soilcap(1:knon)               cal(1:knon) = RCPD / soilcap(1:knon)
480               radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)               radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
481            ELSE            ELSE
# Line 533  contains Line 508  contains
508            CALL calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)            CALL calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)
509    
510            IF (soil_model) THEN            IF (soil_model) THEN
511               !IM cf LF/JLD CALL soil(dtime, nisurf, knon, snow, tsurf, tsoil, soilcap, soilflux)               CALL soil(dtime, nisurf, knon, snow, tsurf_new, tsoil, soilcap, &
512               CALL soil(dtime, nisurf, knon, snow, tsurf_new, tsoil, soilcap, soilflux)                    soilflux)
513               cal(1:knon) = RCPD / soilcap(1:knon)               cal(1:knon) = RCPD / soilcap(1:knon)
514               radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)               radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
515               dif_grnd = 0.               dif_grnd = 0.
Legend:
Removed from v.71  
changed lines
  Added in v.72
  ViewVC Help
Powered by ViewVC 1.1.21