Changeset 171
- Timestamp:
- Jan 12, 2001, 3:31:43 PM (24 years ago)
- Location:
- LMDZ.3.3/branches/rel-LF/libf/phylmd
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F
r159 r171 5 5 . paprs,pplay,radsol,snow,qsol,evap,albe, 6 6 . rain_f, snow_f, solsw, sollw, fder, 7 . rlon, rlat, rugos,8 . debut, lafin, agesno, 7 . rlon, rlat, cufi, cvfi, rugos, 8 . debut, lafin, agesno,rugoro, 9 9 . d_t,d_q,d_u,d_v,d_ts, 10 10 . flux_t,flux_q,flux_u,flux_v,cdragh,cdragm, 11 . rugmer,dflux_t,dflux_q,11 . dflux_t,dflux_q, 12 12 . zcoefh,zu1,zv1) 13 13 cAA . itr, tr, flux_surf, d_tr) … … 77 77 REAL u(klon,klev), v(klon,klev) 78 78 REAL paprs(klon,klev+1), pplay(klon,klev), radsol(klon) 79 REAL rlon(klon), rlat(klon) 79 REAL rlon(klon), rlat(klon), cufi(klon), cvfi(klon) 80 80 REAL d_t(klon, klev), d_q(klon, klev) 81 81 REAL d_u(klon, klev), d_v(klon, klev) … … 83 83 REAL dflux_t(klon), dflux_q(klon) 84 84 REAL flux_u(klon,klev, nbsrf), flux_v(klon,klev, nbsrf) 85 REAL rugmer(klon), agesno(klon) 85 REAL rugmer(klon), agesno(klon),rugoro(klon) 86 86 REAL cdragh(klon), cdragm(klon) 87 87 integer jour ! jour de l'annee en cours … … 123 123 real ysollw(klon), ysolsw(klon) 124 124 real yfder(klon), ytaux(klon), ytauy(klon) 125 REAL yrugm(klon), yrads(klon) 125 REAL yrugm(klon), yrads(klon),yrugoro(klon) 126 126 REAL y_d_ts(klon) 127 127 REAL y_d_t(klon, klev), y_d_q(klon, klev) … … 291 291 ysollw(j) = sollw(i) 292 292 yrugos(j) = rugos(i,nsrf) 293 yrugoro(j) = rugoro(i) 293 294 yu1(j) = u1lay(i) 294 295 yv1(j) = v1lay(i) … … 336 337 c calculer la diffusion de "q" et de "h" 337 338 CALL clqh(dtime, itap, jour, debut,lafin, 338 e rlon, rlat, 339 e rlon, rlat, cufi, cvfi, 339 340 e knon, nsrf, ni, pctsrf, 340 341 e ok_veget, ocean, npas, nexca, 341 e rmu0, yrugos, 342 e rmu0, yrugos, yrugoro, 342 343 e yu1, yv1, ycoefh, 343 344 e yt,yq,yts,ypaprs,ypplay, … … 429 430 C A rajouter: conservation de l'albedo 430 431 C 432 rugos(:,is_oce) = rugmer 431 433 pctsrf = pctsrf_new 432 434 … … 434 436 END 435 437 SUBROUTINE clqh(dtime,itime, jour,debut,lafin, 436 e rlon, rlat, 438 e rlon, rlat, cufi, cvfi, 437 439 e knon, nisurf, knindex, pctsrf, 438 440 e ok_veget, ocean, npas, nexca, 439 e rmu0, rugos, 441 e rmu0, rugos, rugoro, 440 442 e u1lay,v1lay,coef, 441 443 e t,q,ts,paprs,pplay, … … 482 484 real precip_rain(klon), precip_snow(klon) 483 485 REAL agesno(klon) 486 REAL rugoro(klon) 484 487 integer jour ! jour de l'annee en cours 485 488 real rmu0(klon) ! cosinus de l'angle solaire zenithal … … 487 490 integer knindex(klon) 488 491 real pctsrf(klon,nbsrf) 489 real rlon(klon), rlat(klon) 492 real rlon(klon), rlat(klon), cufi(klon), cvfi(klon) 490 493 logical ok_veget 491 494 character*6 ocean … … 659 662 C Appel a interfsurf (appel generique) routine d'interface avec la surface 660 663 661 do i = 1, knon662 petAcoef=zx_ch( i,1)663 peqAcoef=zx_cq( i,1)664 petBcoef=zx_dh( i,1)665 peqBcoef=zx_dq( i,1)666 tq_cdrag=coef( i,1)667 temp_air=t( i,1)668 spechum=q( i,1)669 p1lay = pplay( i,1)670 zlev1 = delp( i,1)671 swnet (i) = swdown(i) * (1. - albedo(i))672 enddo664 c do i = 1, knon 665 petAcoef=zx_ch(:,1) 666 peqAcoef=zx_cq(:,1) 667 petBcoef=zx_dh(:,1) 668 peqBcoef=zx_dq(:,1) 669 tq_cdrag=coef(:,1) 670 temp_air=t(:,1) 671 spechum=q(:,1) 672 p1lay = pplay(:,1) 673 zlev1 = delp(:,1) 674 swnet = swdown * (1. - albedo) 675 c enddo 673 676 c En attendant mieux 674 677 hum_air = 0. … … 681 684 e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, 682 685 e precip_rain, precip_snow, lwdown, swnet, swdown, 683 e fder, taux, tauy, rugos, 686 e fder, taux, tauy, rugos, rugoro, 684 687 e albedo, snow, qsol, 685 688 e ts, p1lay, psref, radsol, … … 690 693 691 694 do i = 1, knon 692 flux_t(i,1) = fluxsens(i)693 flux_q(i,1) = - evap(i)694 d_ts(i) = tsurf_new(i) - ts(i)695 albedo(i) = alb_new(i)695 flux_t(i,1) = fluxsens(i) 696 flux_q(i,1) = - evap(i) 697 d_ts(i) = tsurf_new(i) - ts(i) 698 albedo(i) = alb_new(i) 696 699 enddo 697 700 -
LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
r159 r171 54 54 & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & 55 55 & precip_rain, precip_snow, lwdown, swnet, swdown, & 56 & fder, taux, tauy, rugos, &56 & fder, taux, tauy, rugos, rugoro, & 57 57 & albedo, snow, qsol, & 58 58 & tsurf, p1lay, ps, radsol, & … … 115 115 ! rugos rugosite 116 116 ! zmasq masque terre/ocean 117 ! rugoro rugosite orographique 117 118 ! 118 119 ! output: … … 152 153 real, dimension(klon), intent(IN) :: radsol 153 154 real, dimension(klon), intent(IN) :: zmasq 154 real, dimension(klon), intent(IN) :: fder, taux, tauy, rugos 155 real, dimension(klon), intent(IN) :: fder, taux, tauy, rugos, rugoro 155 156 character (len = 6) :: ocean 156 157 integer :: npas, nexca ! nombre et pas de temps couplage … … 281 282 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 282 283 alb_new = alb_neig*zfra + alb_new*(1.0-zfra) 284 z0_new = SQRT(z0_new**2+rugoro**2) 283 285 else 284 286 ! … … 445 447 ! Rugosite 446 448 ! 447 z0_new = rugo s449 z0_new = rugoro 448 450 ! 449 451 ! Remplissage des pourcentages de surface … … 943 945 pctsrf_sav(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic) 944 946 endwhere 945 where (abs(pctsrf_sav(:,is_oce)) .le. epsilon(pctsrf_sav(1,is_ sic)))947 where (abs(pctsrf_sav(:,is_oce)) .le. epsilon(pctsrf_sav(1,is_oce))) 946 948 pctsrf_sav(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic) 947 949 pctsrf_sav(:,is_oce) = 0. … … 1182 1184 if ((jour - jour_lu) /= 0) deja_lu = .false. 1183 1185 1184 if (check) write(*,*)modname,' :: jour _lu, deja_lu', jour_lu, deja_lu1186 if (check) write(*,*)modname,' :: jour, jour_lu, deja_lu', jour, jour_lu, deja_lu 1185 1187 if (check) write(*,*)modname,' :: itime, lmt_pas ', itime, lmt_pas,dtime 1186 1188 … … 1338 1340 lmt_sst(ii) = sst_lu(knindex(ii)) 1339 1341 enddo 1340 ! je peux pas utiliser la ligne suivante a cause du compilo Sun 1341 ! lmt_sst = sst_lu(knindex)1342 pctsrf_new = pct_tmp1342 1343 pctsrf_new(:,is_oce) = pct_tmp(:,is_oce) 1344 pctsrf_new(:,is_sic) = pct_tmp(:,is_sic) 1343 1345 1344 1346 END SUBROUTINE interfoce_lim … … 1592 1594 qsol = max_eau_sol 1593 1595 else 1594 snow = max(0.0, snow + (precip_snow - evap) * dtime) 1596 snow = snow + (precip_snow * dtime) 1597 where (snow > epsilon(snow)) snow = max(0.0, snow - (evap * dtime)) 1598 ! snow = max(0.0, snow + (precip_snow - evap) * dtime) 1595 1599 qsol = qsol + (precip_rain - evap) * dtime 1596 1600 endif -
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
r158 r171 42 42 c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s) 43 43 c omega---input-R-vitesse verticale en Pa/s 44 c cufi----input-R-resolution des mailles en x (m) 45 c cvfi----input-R-resolution des mailles en y (m) 44 46 c 45 47 c d_u-----output-R-tendance physique de "u" (m/s/s) … … 75 77 c ocean = type de modele ocean a utiliser: force, slab, couple 76 78 character *6 ocean 77 78 cparameter (ocean = 'couple')79 c parameter (ocean = 'force ') 80 parameter (ocean = 'couple') 79 81 logical ok_ocean 80 82 c====================================================================== … … 144 146 REAL presnivs(klev) 145 147 REAL znivsig(klev) 148 REAL zsurf(nbsrf) 149 real cufi(klon), cvfi(klon) 146 150 147 151 REAL u(klon,klev) … … 226 230 SAVE falbe ! albedo par type de surface 227 231 c 228 REAL rugmer(klon)229 SAVE rugmer ! longeur de rugosite sur mer (m)230 232 c 231 233 c Parametres de l'Orographie a l'Echelle Sous-Maille (OESM): … … 692 694 . "ave(X)", zsto,zout) 693 695 c 696 CALL histdef(nid_day, "snow_cov", "Snow cover", "mm", 697 . iim,jjmp1,nhori, 1,1,1, -99, 32, 698 . "ave(X)", zsto,zout) 699 c 694 700 CALL histdef(nid_day, "evap", "Evaporation", "mm/day", 695 701 . iim,jjmp1,nhori, 1,1,1, -99, 32, … … 887 893 . "ave(X)", zsto,zout) 888 894 c 895 CALL histdef(nid_mth, "snow_cov", "Snow cover", "mm", 896 . iim,jjmp1,nhori, 1,1,1, -99, 32, 897 . "ave(X)", zsto,zout) 898 c 889 899 CALL histdef(nid_mth, "ages", "Snow age", "day", 890 900 . iim,jjmp1,nhori, 1,1,1, -99, 32, … … 1307 1317 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1308 1318 $ "inst(X)", zsto,zout) 1319 c 1320 call histdef(nid_ins, "albe_"//clnsurf(nsrf), 1321 $ "Albedo "//clnsurf(nsrf), "-", 1322 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1323 $ "inst(X)", zsto,zout) 1324 c 1325 call histdef(nid_ins, "rugs_"//clnsurf(nsrf), 1326 $ "rugosite "//clnsurf(nsrf), "-", 1327 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1328 $ "inst(X)", zsto,zout) 1309 1329 C§§§ 1310 1330 END DO 1331 CALL histdef(nid_ins, "rugs", "rugosity", "-", 1332 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1333 . "inst(X)", zsto,zout) 1334 1335 c 1336 CALL histdef(nid_ins, "albs", "Surface albedo", "-", 1337 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1338 . "inst(X)", zsto,zout) 1339 c 1340 CALL histdef(nid_ins, "snow_cov", "Snow cover", "mm", 1341 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1342 . "inst(X)", zsto,zout) 1311 1343 c 1312 1344 c Champs 3D: … … 1516 1548 e paprs,pplay,radsol, fsnow,fqsol,fevap,falbe, 1517 1549 e rain_fall, snow_fall, solsw, sollw, fder, 1518 e rlon, rlat, frugs,1519 e debut, lafin, agesno, 1550 e rlon, rlat, cufi, cvfi, frugs, 1551 e debut, lafin, agesno,rugoro , 1520 1552 s d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts, 1521 s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm, rugmer,1553 s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm, 1522 1554 s dsens, devap, 1523 1555 s ycoefh,yu1,yv1) … … 2042 2074 CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2043 2075 c 2076 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d) 2077 CALL histwrite(nid_day,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2078 c 2044 2079 CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d) 2045 2080 CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d) … … 2202 2237 CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d) 2203 2238 CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2239 c 2240 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d) 2241 CALL histwrite(nid_mth,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2204 2242 c 2205 2243 CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d) … … 2574 2612 CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap, 2575 2613 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2614 C 2615 zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf) 2616 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2617 CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itap, 2618 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2619 C 2620 zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf) 2621 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2622 CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itap, 2623 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2576 2624 C 2577 2625 END DO 2578 2626 CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d) 2627 CALL histwrite(nid_ins,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2628 c 2629 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d) 2630 CALL histwrite(nid_ins,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2631 c 2632 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d) 2633 CALL histwrite(nid_ins,"rugs",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2579 2634 c 2580 2635 c Champs 3D:
Note: See TracChangeset
for help on using the changeset viewer.
