--- trunk/libf/phylmd/clmain.f90 2011/02/22 13:49:36 40 +++ trunk/libf/phylmd/clmain.f90 2011/08/24 11:43:14 49 @@ -33,103 +33,81 @@ ! en leur ajoutant une dimension, c'est-à-dire "nbsrf" (nombre de ! sous-surfaces). + use calendar, ONLY : ymds2ju + use clqh_m, only: clqh + use coefkz_m, only: coefkz + use coefkzmin_m, only: coefkzmin + USE conf_phys_m, ONLY : iflag_pbl + USE dimens_m, ONLY : iim, jjm + USE dimphy, ONLY : klev, klon, zmasq + USE dimsoil, ONLY : nsoilmx + USE dynetat0_m, ONLY : day_ini + USE gath_cpl, ONLY : gath2cpl + use hbtm_m, only: hbtm + USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync + use histwrite_m, only: histwrite + USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf + USE iniprint, ONLY : prt_level + USE suphec_m, ONLY : rd, rg, rkappa + USE temps, ONLY : annee_ref, itau_phy + use yamada4_m, only: yamada4 + ! Arguments: - ! dtime----input-R- interval du temps (secondes) - ! itap-----input-I- numero du pas de temps + + REAL, INTENT (IN) :: dtime ! interval du temps (secondes) + REAL date0 ! date0----input-R- jour initial + INTEGER, INTENT (IN) :: itap + ! itap-----input-I- numero du pas de temps + REAL t(klon, klev), q(klon, klev) ! t--------input-R- temperature (K) ! q--------input-R- vapeur d'eau (kg/kg) + REAL, INTENT (IN):: u(klon, klev), v(klon, klev) ! u--------input-R- vitesse u ! v--------input-R- vitesse v - ! ts-------input-R- temperature du sol (en Kelvin) + REAL, INTENT (IN):: paprs(klon, klev+1) ! paprs----input-R- pression a intercouche (Pa) + REAL, INTENT (IN):: pplay(klon, klev) ! pplay----input-R- pression au milieu de couche (Pa) - ! radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2 + REAL, INTENT (IN):: rlon(klon), rlat(klon) ! rlat-----input-R- latitude en degree - ! rugos----input-R- longeur de rugosite (en m) + REAL cufi(klon), cvfi(klon) ! cufi-----input-R- resolution des mailles en x (m) ! cvfi-----input-R- resolution des mailles en y (m) - + REAL d_t(klon, klev), d_q(klon, klev) ! d_t------output-R- le changement pour "t" ! d_q------output-R- le changement pour "q" + REAL d_u(klon, klev), d_v(klon, klev) ! d_u------output-R- le changement pour "u" ! d_v------output-R- le changement pour "v" - ! d_ts-----output-R- le changement pour "ts" + REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf) ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2) ! (orientation positive vers le bas) ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s) - ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal - ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal + REAL dflux_t(klon), dflux_q(klon) ! dflux_t derive du flux sensible ! dflux_q derive du flux latent !IM "slab" ocean + REAL flux_o(klon), flux_g(klon) + !IM "slab" ocean ! flux_g---output-R- flux glace (pour OCEAN='slab ') ! flux_o---output-R- flux ocean (pour OCEAN='slab ') - + REAL y_flux_o(klon), y_flux_g(klon) + REAL tslab(klon), ytslab(klon) ! tslab-in/output-R temperature du slab ocean (en Kelvin) ! uniqmnt pour slab - + REAL seaice(klon), y_seaice(klon) ! seaice---output-R- glace de mer (kg/m2) (pour OCEAN='slab ') - !cc + REAL y_fqcalving(klon), y_ffonte(klon) + REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf) ! ffonte----Flux thermique utilise pour fondre la neige ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la ! hauteur de neige, en kg/m2/s - ! on rajoute en output yu1 et yv1 qui sont les vents dans - ! la premiere couche - ! ces 4 variables sont maintenant traites dans phytrac - ! itr--------input-I- nombre de traceurs - ! tr---------input-R- q. de traceurs - ! flux_surf--input-R- flux de traceurs a la surface - ! d_tr-------output-R tendance de traceurs - !IM cf. AM : PBL - ! trmb1-------deep_cape - ! trmb2--------inhibition - ! trmb3-------Point Omega - ! Cape(klon)-------Cape du thermique - ! EauLiq(klon)-------Eau liqu integr du thermique - ! ctei(klon)-------Critere d'instab d'entrainmt des nuages de CL - ! lcl------- Niveau de condensation - ! pblh------- HCL - ! pblT------- T au nveau HCL - - USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync - use histwrite_m, only: histwrite - use calendar, ONLY : ymds2ju - USE dimens_m, ONLY : iim, jjm - USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf - USE dimphy, ONLY : klev, klon, zmasq - USE dimsoil, ONLY : nsoilmx - USE temps, ONLY : annee_ref, itau_phy - USE dynetat0_m, ONLY : day_ini - USE iniprint, ONLY : prt_level - USE suphec_m, ONLY : rd, rg, rkappa - USE conf_phys_m, ONLY : iflag_pbl - USE gath_cpl, ONLY : gath2cpl - use hbtm_m, only: hbtm - - REAL, INTENT (IN) :: dtime - REAL date0 - INTEGER, INTENT (IN) :: itap - REAL t(klon, klev), q(klon, klev) - REAL u(klon, klev), v(klon, klev) - REAL, INTENT (IN) :: paprs(klon, klev+1) - REAL, INTENT (IN) :: pplay(klon, klev) - REAL, INTENT (IN) :: rlon(klon), rlat(klon) - REAL cufi(klon), cvfi(klon) - REAL d_t(klon, klev), d_q(klon, klev) - REAL d_u(klon, klev), d_v(klon, klev) - REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf) - REAL dflux_t(klon), dflux_q(klon) - !IM "slab" ocean - REAL flux_o(klon), flux_g(klon) - REAL y_flux_o(klon), y_flux_g(klon) - REAL tslab(klon), ytslab(klon) - REAL seaice(klon), y_seaice(klon) - REAL y_fqcalving(klon), y_ffonte(klon) - REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf) REAL run_off_lic_0(klon), y_run_off_lic_0(klon) REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf) + ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal + ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal REAL rugmer(klon), agesno(klon, nbsrf) REAL, INTENT (IN) :: rugoro(klon) REAL cdragh(klon), cdragm(klon) @@ -146,7 +124,9 @@ REAL pctsrf(klon, nbsrf) REAL ts(klon, nbsrf) + ! ts-------input-R- temperature du sol (en Kelvin) REAL d_ts(klon, nbsrf) + ! d_ts-----output-R- le changement pour "ts" REAL snow(klon, nbsrf) REAL qsurf(klon, nbsrf) REAL evap(klon, nbsrf) @@ -160,6 +140,7 @@ REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon) REAL rugos(klon, nbsrf) + ! rugos----input-R- longeur de rugosite (en m) ! la nouvelle repartition des surfaces sortie de l'interface REAL pctsrf_new(klon, nbsrf) @@ -179,12 +160,14 @@ REAL ytsoil(klon, nsoilmx) REAL qsol(klon) - EXTERNAL clqh, clvent, coefkz, calbeta, cltrac + EXTERNAL clvent, calbeta, cltrac REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon) REAL yalb(klon) REAL yalblw(klon) REAL yu1(klon), yv1(klon) + ! on rajoute en output yu1 et yv1 qui sont les vents dans + ! la premiere couche REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon) REAL yrain_f(klon), ysnow_f(klon) REAL ysollw(klon), ysolsw(klon), ysollwdown(klon) @@ -208,13 +191,11 @@ PARAMETER (ok_nonloc=.FALSE.) REAL ycoefm0(klon, klev), ycoefh0(klon, klev) - !IM 081204 hcl_Anne ? BEG REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev) REAL ykmm(klon, klev+1), ykmn(klon, klev+1) REAL ykmq(klon, klev+1) REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf) REAL q2diag(klon, klev+1) - !IM 081204 hcl_Anne ? END REAL u1lay(klon), v1lay(klon) REAL delp(klon, klev) @@ -260,15 +241,20 @@ !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds ! physiq ce qui permet de sortir les grdeurs par sous surface) REAL pblh(klon, nbsrf) + ! pblh------- HCL REAL plcl(klon, nbsrf) REAL capcl(klon, nbsrf) REAL oliqcl(klon, nbsrf) REAL cteicl(klon, nbsrf) REAL pblt(klon, nbsrf) + ! pblT------- T au nveau HCL REAL therm(klon, nbsrf) REAL trmb1(klon, nbsrf) + ! trmb1-------deep_cape REAL trmb2(klon, nbsrf) + ! trmb2--------inhibition REAL trmb3(klon, nbsrf) + ! trmb3-------Point Omega REAL ypblh(klon) REAL ylcl(klon) REAL ycapcl(klon) @@ -411,8 +397,8 @@ pctsrf_pot(:, is_oce) = 1. - zmasq pctsrf_pot(:, is_sic) = 1. - zmasq - DO nsrf = 1, nbsrf - ! chercher les indices: + loop_surface: DO nsrf = 1, nbsrf + ! Chercher les indices : ni = 0 knon = 0 DO i = 1, klon @@ -436,7 +422,7 @@ CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab) END IF - IF (knon==0) CYCLE + IF (knon == 0) CYCLE DO j = 1, knon i = ni(j) @@ -468,8 +454,8 @@ ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j)) END DO - ! IF bucket model for continent, copy soil water content - IF (nsrf==is_ter .AND. .NOT. ok_veget) THEN + ! IF bucket model for continent, copy soil water content + IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN DO j = 1, knon i = ni(j) yqsol(j) = qsol(i) @@ -500,10 +486,7 @@ ! calculer Cdrag et les coefficients d'echange CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,& yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh) - !IM 081204 BEG - !CR test - IF (iflag_pbl==1) THEN - !IM 081204 END + IF (iflag_pbl == 1) THEN CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0) DO k = 1, klev DO i = 1, knon @@ -513,36 +496,28 @@ END DO END IF - !IM cf JLD : on seuille ycoefm et ycoefh - IF (nsrf==is_oce) THEN + ! on seuille ycoefm et ycoefh + IF (nsrf == is_oce) THEN DO j = 1, knon - ! ycoefm(j, 1)=min(ycoefm(j, 1), 1.1E-3) ycoefm(j, 1) = min(ycoefm(j, 1), cdmmax) - ! ycoefh(j, 1)=min(ycoefh(j, 1), 1.1E-3) ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax) END DO END IF - !IM: 261103 IF (ok_kzmin) THEN - !IM cf FH: 201103 BEG - ! Calcul d'une diffusion minimale pour les conditions tres stables. - CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm, & + ! Calcul d'une diffusion minimale pour les conditions tres stables + CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm(:, 1), & ycoefm0, ycoefh0) - IF (1==1) THEN - DO k = 1, klev - DO i = 1, knon - ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k)) - ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k)) - END DO + DO k = 1, klev + DO i = 1, knon + ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k)) + ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k)) END DO - END IF - !IM cf FH: 201103 END - !IM: 261103 - END IF !ok_kzmin + END DO + END IF - IF (iflag_pbl>=3) THEN + IF (iflag_pbl >= 3) THEN ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, & 1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg @@ -568,30 +543,23 @@ END DO END DO - ! Bug introduit volontairement pour converger avec les resultats - ! du papier sur les thermiques. - IF (1==1) THEN - y_cd_m(1:knon) = ycoefm(1:knon, 1) - y_cd_h(1:knon) = ycoefh(1:knon, 1) - ELSE - y_cd_h(1:knon) = ycoefm(1:knon, 1) - y_cd_m(1:knon) = ycoefh(1:knon, 1) - END IF + y_cd_m(1:knon) = ycoefm(1:knon, 1) + y_cd_h(1:knon) = ycoefh(1:knon, 1) CALL ustarhb(knon, yu, yv, y_cd_m, yustar) IF (prt_level>9) THEN PRINT *, 'USTAR = ', yustar END IF - ! iflag_pbl peut etre utilise comme longuer de melange + ! iflag_pbl peut être utilisé comme longueur de mélange - IF (iflag_pbl>=11) THEN + IF (iflag_pbl >= 11) THEN CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, & yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, & iflag_pbl) ELSE - CALL yamada4(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, yu, & - yv, yteta, y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl) + CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, & + y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl) END IF ycoefm(1:knon, 1) = y_cd_m(1:knon) @@ -624,7 +592,7 @@ ! calculer la longueur de rugosite sur ocean yrugm = 0. - IF (nsrf==is_oce) THEN + IF (nsrf == is_oce) THEN DO j = 1, knon yrugm(j) = 0.018*ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + & 0.11*14E-6/sqrt(ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2)) @@ -645,17 +613,12 @@ ycoefm(j, k) = ycoefm(j, k)*ypct(j) y_d_t(j, k) = y_d_t(j, k)*ypct(j) y_d_q(j, k) = y_d_q(j, k)*ypct(j) - !§§§ PB flux_t(i, k, nsrf) = y_flux_t(j, k) flux_q(i, k, nsrf) = y_flux_q(j, k) flux_u(i, k, nsrf) = y_flux_u(j, k) flux_v(i, k, nsrf) = y_flux_v(j, k) - !$$$ PB y_flux_t(j, k) = y_flux_t(j, k) * ypct(j) - !$$$ PB y_flux_q(j, k) = y_flux_q(j, k) * ypct(j) y_d_u(j, k) = y_d_u(j, k)*ypct(j) y_d_v(j, k) = y_d_v(j, k)*ypct(j) - !$$$ PB y_flux_u(j, k) = y_flux_u(j, k) * ypct(j) - !$$$ PB y_flux_v(j, k) = y_flux_v(j, k) * ypct(j) END DO END DO @@ -676,12 +639,10 @@ qsurf(i, nsrf) = yqsurf(j) rugos(i, nsrf) = yz0_new(j) fluxlat(i, nsrf) = yfluxlat(j) - !$$$ pb rugmer(i) = yrugm(j) - IF (nsrf==is_oce) THEN + IF (nsrf == is_oce) THEN rugmer(i) = yrugm(j) rugos(i, nsrf) = yrugm(j) END IF - !IM cf JLD ?? agesno(i, nsrf) = yagesno(j) fqcalving(i, nsrf) = y_fqcalving(j) ffonte(i, nsrf) = y_ffonte(j) @@ -692,13 +653,13 @@ zu1(i) = zu1(i) + yu1(j) zv1(i) = zv1(i) + yv1(j) END DO - IF (nsrf==is_ter) THEN + IF (nsrf == is_ter) THEN DO j = 1, knon i = ni(j) qsol(i) = yqsol(j) END DO END IF - IF (nsrf==is_lic) THEN + IF (nsrf == is_lic) THEN DO j = 1, knon i = ni(j) run_off_lic_0(i) = y_run_off_lic_0(j) @@ -718,12 +679,8 @@ DO k = 1, klev d_t(i, k) = d_t(i, k) + y_d_t(j, k) d_q(i, k) = d_q(i, k) + y_d_q(j, k) - !$$$ PB flux_t(i, k) = flux_t(i, k) + y_flux_t(j, k) - !$$$ flux_q(i, k) = flux_q(i, k) + y_flux_q(j, k) d_u(i, k) = d_u(i, k) + y_d_u(j, k) d_v(i, k) = d_v(i, k) + y_d_v(j, k) - !$$$ PB flux_u(i, k) = flux_u(i, k) + y_flux_u(j, k) - !$$$ flux_v(i, k) = flux_v(i, k) + y_flux_v(j, k) zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k) END DO END DO @@ -740,7 +697,7 @@ 1)))*(ypaprs(j, 1)-ypplay(j, 1)) tairsol(j) = yts(j) + y_d_ts(j) rugo1(j) = yrugos(j) - IF (nsrf==is_oce) THEN + IF (nsrf == is_oce) THEN rugo1(j) = rugos(i, nsrf) END IF psfce(j) = ypaprs(j, 1) @@ -752,7 +709,6 @@ CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, & tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, & yu10m, yustar) - !IM 081204 END DO j = 1, knon i = ni(j) @@ -794,7 +750,7 @@ END DO END DO !IM "slab" ocean - IF (nsrf==is_oce) THEN + IF (nsrf == is_oce) THEN DO j = 1, knon ! on projette sur la grille globale i = ni(j) @@ -806,11 +762,10 @@ END DO END IF - IF (nsrf==is_sic) THEN + IF (nsrf == is_sic) THEN DO j = 1, knon i = ni(j) ! On pondère lorsque l'on fait le bilan au sol : - ! flux_g(i) = y_flux_g(j)*ypct(j) IF (pctsrf_new(i, is_sic)>epsfra) THEN flux_g(i) = y_flux_g(j) ELSE @@ -819,19 +774,15 @@ END DO END IF - !nsrf.EQ.is_sic - IF (ocean=='slab ') THEN - IF (nsrf==is_oce) THEN + IF (ocean == 'slab ') THEN + IF (nsrf == is_oce) THEN tslab(1:klon) = ytslab(1:klon) seaice(1:klon) = y_seaice(1:klon) - !nsrf END IF - !OCEAN END IF - END DO + END DO loop_surface ! On utilise les nouvelles surfaces - ! A rajouter: conservation de l'albedo rugos(:, is_oce) = rugmer pctsrf = pctsrf_new