Ignore:
Timestamp:
Jan 12, 2001, 3:31:43 PM (24 years ago)
Author:
lmdzadmin
Message:

Changements necessaires pour l'appel a orchidee
LF

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  
    55     .                  paprs,pplay,radsol,snow,qsol,evap,albe,
    66     .                  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,
    99     .                  d_t,d_q,d_u,d_v,d_ts,
    1010     .                  flux_t,flux_q,flux_u,flux_v,cdragh,cdragm,
    11      .                  rugmer, dflux_t,dflux_q,
     11     .                  dflux_t,dflux_q,
    1212     .                  zcoefh,zu1,zv1)
    1313cAA .                  itr, tr, flux_surf, d_tr)
    … …  
    7777      REAL u(klon,klev), v(klon,klev)
    7878      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)
    8080      REAL d_t(klon, klev), d_q(klon, klev)
    8181      REAL d_u(klon, klev), d_v(klon, klev)
    … …  
    8383      REAL dflux_t(klon), dflux_q(klon)
    8484      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)
    8686      REAL cdragh(klon), cdragm(klon)
    8787      integer jour            ! jour de l'annee en cours
    … …  
    123123      real ysollw(klon), ysolsw(klon)
    124124      real yfder(klon), ytaux(klon), ytauy(klon)
    125       REAL yrugm(klon), yrads(klon)
     125      REAL yrugm(klon), yrads(klon),yrugoro(klon)
    126126      REAL y_d_ts(klon)
    127127      REAL y_d_t(klon, klev), y_d_q(klon, klev)
    … …  
    291291        ysollw(j) = sollw(i)
    292292        yrugos(j) = rugos(i,nsrf)
     293        yrugoro(j) = rugoro(i)
    293294        yu1(j) = u1lay(i)
    294295        yv1(j) = v1lay(i)
    … …  
    336337c calculer la diffusion de "q" et de "h"
    337338      CALL clqh(dtime, itap, jour, debut,lafin,
    338      e          rlon, rlat,
     339     e          rlon, rlat, cufi, cvfi,
    339340     e          knon, nsrf, ni, pctsrf,
    340341     e          ok_veget, ocean, npas, nexca,
    341      e          rmu0, yrugos,
     342     e          rmu0, yrugos, yrugoro,
    342343     e          yu1, yv1, ycoefh,
    343344     e          yt,yq,yts,ypaprs,ypplay,
    … …  
    429430C A rajouter: conservation de l'albedo
    430431C
     432      rugos(:,is_oce) = rugmer
    431433      pctsrf = pctsrf_new
    432434
    … …  
    434436      END
    435437      SUBROUTINE clqh(dtime,itime, jour,debut,lafin,
    436      e                rlon, rlat,
     438     e                rlon, rlat, cufi, cvfi,
    437439     e                knon, nisurf, knindex, pctsrf,
    438440     e                ok_veget, ocean, npas, nexca,
    439      e                rmu0, rugos,
     441     e                rmu0, rugos, rugoro,
    440442     e                u1lay,v1lay,coef,
    441443     e                t,q,ts,paprs,pplay,
    … …  
    482484      real precip_rain(klon), precip_snow(klon)
    483485      REAL agesno(klon)
     486      REAL rugoro(klon)
    484487      integer jour            ! jour de l'annee en cours
    485488      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
    … …  
    487490      integer knindex(klon)
    488491      real pctsrf(klon,nbsrf)
    489       real rlon(klon), rlat(klon)
     492      real rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
    490493      logical ok_veget
    491494      character*6 ocean
    … …  
    659662C Appel a interfsurf (appel generique) routine d'interface avec la surface
    660663
    661       do i = 1, knon
    662         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       enddo
     664c      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)
     675c      enddo
    673676c En attendant mieux
    674677      hum_air = 0.
    … …  
    681684     e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
    682685     e precip_rain, precip_snow, lwdown, swnet, swdown,
    683      e fder, taux, tauy, rugos,
     686     e fder, taux, tauy, rugos, rugoro,
    684687     e albedo, snow, qsol,
    685688     e ts, p1lay, psref, radsol,
    … …  
    690693
    691694      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)
    696699      enddo
    697700

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

    r159 r171  
    5454      & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    5555      & precip_rain, precip_snow, lwdown, swnet, swdown, &
    56       & fder, taux, tauy, rugos, &
     56      & fder, taux, tauy, rugos, rugoro, &
    5757      & albedo, snow, qsol, &
    5858      & tsurf, p1lay, ps, radsol, &
    … …  
    115115!   rugos        rugosite
    116116!   zmasq        masque terre/ocean
     117!   rugoro       rugosite orographique
    117118!
    118119! output:
    … …  
    152153  real, dimension(klon), intent(IN) :: radsol
    153154  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
    155156  character (len = 6)  :: ocean
    156157  integer              :: npas, nexca ! nombre et pas de temps couplage
    … …  
    281282       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    282283       alb_new = alb_neig*zfra + alb_new*(1.0-zfra)
     284       z0_new = SQRT(z0_new**2+rugoro**2)
    283285    else
    284286!
    … …  
    445447! Rugosite
    446448!
    447     z0_new = rugos
     449    z0_new = rugoro
    448450!
    449451! Remplissage des pourcentages de surface
    … …  
    943945        pctsrf_sav(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
    944946      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)))
    946948        pctsrf_sav(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
    947949        pctsrf_sav(:,is_oce) = 0.
    … …  
    11821184  if ((jour - jour_lu) /= 0) deja_lu = .false.
    11831185 
    1184   if (check) write(*,*)modname,' :: jour_lu, deja_lu', jour_lu, deja_lu
     1186  if (check) write(*,*)modname,' :: jour, jour_lu, deja_lu', jour, jour_lu, deja_lu
    11851187  if (check) write(*,*)modname,' :: itime, lmt_pas ', itime, lmt_pas,dtime
    11861188
    … …  
    13381340    lmt_sst(ii) = sst_lu(knindex(ii))
    13391341  enddo
    1340 ! je peux pas utiliser la ligne suivante a cause du compilo Sun
    1341 !  lmt_sst = sst_lu(knindex)
    1342   pctsrf_new = pct_tmp
     1342
     1343  pctsrf_new(:,is_oce) = pct_tmp(:,is_oce)
     1344  pctsrf_new(:,is_sic) = pct_tmp(:,is_sic)
    13431345
    13441346  END SUBROUTINE interfoce_lim
    … …  
    15921594      qsol = max_eau_sol
    15931595    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)
    15951599      qsol = qsol + (precip_rain - evap) * dtime
    15961600    endif

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

    r158 r171  
    4242c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
    4343c omega---input-R-vitesse verticale en Pa/s
     44c cufi----input-R-resolution des mailles en x (m)
     45c cvfi----input-R-resolution des mailles en y (m)
    4446c
    4547c d_u-----output-R-tendance physique de "u" (m/s/s)
    … …  
    7577c      ocean = type de modele ocean a utiliser: force, slab, couple
    7678      character *6 ocean
    77       parameter (ocean = 'force ')
    78 c     parameter (ocean = 'couple')
     79c     parameter (ocean = 'force ')
     80      parameter (ocean = 'couple')
    7981      logical ok_ocean
    8082c======================================================================
    … …  
    144146      REAL presnivs(klev)
    145147      REAL znivsig(klev)
     148      REAL zsurf(nbsrf)
     149      real cufi(klon), cvfi(klon)
    146150
    147151      REAL u(klon,klev)
    … …  
    226230      SAVE falbe                  ! albedo par type de surface
    227231c
    228       REAL rugmer(klon)
    229       SAVE rugmer                 ! longeur de rugosite sur mer (m)
    230232c
    231233c  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
    … …  
    692694     .                "ave(X)", zsto,zout)
    693695c
     696         CALL histdef(nid_day, "snow_cov", "Snow cover", "mm",
     697     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     698     .                "ave(X)", zsto,zout)
     699c
    694700         CALL histdef(nid_day, "evap", "Evaporation", "mm/day",
    695701     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    … …  
    887893     .                "ave(X)", zsto,zout)
    888894c
     895         CALL histdef(nid_mth, "snow_cov", "Snow cover", "mm",
     896     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     897     .                "ave(X)", zsto,zout)
     898c
    889899         CALL histdef(nid_mth, "ages", "Snow age", "day",
    890900     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    … …  
    13071317     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
    13081318     $         "inst(X)", zsto,zout)
     1319c
     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)
     1324c
     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)
    13091329C§§§
    13101330         END DO
     1331         CALL histdef(nid_ins, "rugs", "rugosity", "-",
     1332     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     1333     .                "inst(X)", zsto,zout)
     1334
     1335c
     1336         CALL histdef(nid_ins, "albs", "Surface albedo", "-",
     1337     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     1338     .                "inst(X)", zsto,zout)
     1339c
     1340         CALL histdef(nid_ins, "snow_cov", "Snow cover", "mm",
     1341     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     1342     .                "inst(X)", zsto,zout)
    13111343c
    13121344c Champs 3D:
    … …  
    15161548     e            paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,
    15171549     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 ,
    15201552     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,
    15221554     s            dsens, devap,
    15231555     s            ycoefh,yu1,yv1)
    … …  
    20422074      CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
    20432075c
     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)
     2078c
    20442079      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
    20452080      CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
    … …  
    22022237      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
    22032238      CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2239c
     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)
    22042242c
    22052243      CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
    … …  
    25742612        CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap,
    25752613     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2614C
     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)
     2619C
     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)
    25762624C
    25772625      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)
     2628c
     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)
     2631c
     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)
    25792634c
    25802635c Champs 3D:
Note: See TracChangeset for help on using the changeset viewer.