Ignore:
Timestamp:
May 10, 2000, 12:30:30 PM (25 years ago)
Author:
lmdzadmin
Message:

nouvelle version de la routine incluant l'appel a la routine d'interface
avec la surface
LF

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F

    r84 r86  
    143143      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
    144144c======================================================================
     145
     146      write(*,*)'CLMAIN.NEW'
     147
    145148      DO k = 1, klev   ! epaisseur de couche
    146149      DO i = 1, klon
     
    322325c
    323326c calculer la diffusion de "q" et de "h"
    324       CALL clqh(knon, dtime, yu1, yv1,
     327      CALL clqh(knon, dtime, nsrf,yu1, yv1,
    325328     e          ycoefh,yt,yq,yts,ypaprs,ypplay,ydelp,yrads,
    326329     e          ycal,ybeta,ydif,ygamt,ygamq,
     
    429432      RETURN
    430433      END
    431       SUBROUTINE clqh(knon,dtime,u1lay,v1lay,coef,t,q,ts,paprs,pplay,
     434      SUBROUTINE clqh(knon,dtime,nisurf,u1lay,v1lay,coef,
     435     e                t,q,ts,paprs,pplay,
    432436     e                delp,radsol,cal,beta,dif_grnd, gamt,gamq,
    433437     s                d_t, d_q, d_ts, flux_t, flux_q,dflux_s,dflux_l)
     438
     439      USE interface_surf
     440
    434441      IMPLICIT none
    435442c======================================================================
     
    517524#include "YOETHF.h"
    518525#include "FCTTRE.h"
    519 c======================================================================
     526#include "indicesol.h"
     527c======================================================================
     528c Rajout pour l'interface
     529      integer itime
     530      integer jour
     531      integer nisurf
     532      integer knindex(klon)
     533      logical debut, lafin, ok_veget
     534      real rlon(klon), rlat(klon)
     535      real zlev(klon), zlflu(klon)
     536      real temp_air(klon), spechum(klon)
     537      real hum_air(klon), ccanopy(klon)
     538      real tq_cdrag(klon), petAcoef(klon), peqAcoef(klon)
     539      real petBcoef(klon), peqBcoef(klon)
     540      real precip_rain(klon), precip_snow(klon)
     541      real lwdown(klon), swnet(klon), swdown(klon), ps(klon)
     542      real p1lay(klon)
     543      real coef1lay(klon)
     544      character*6 ocean
     545
     546! Parametres de sortie
     547      real evap(klon), fluxsens(klon), fluxlat(klon)
     548      real tsol_rad(klon), tsurf_new(klon), alb_new(klon)
     549      real emis_new(klon), z0_new(klon)
     550      real dflux_l(klon), dflux_s(klon)
     551      real pctsrf_new(klon,nbsrf)
     552c
     553
    520554      DO i = 1, knon
    521555         psref(i) = paprs(i,1) !pression de reference est celle au sol
     
    533567c Convertir les coefficients en variables convenables au calcul:
    534568c
    535       DO i = 1, knon
    536          zx_coef(i,1) = coef(i,1)
    537      .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
    538      .                 * pplay(i,1)/(RD*t(i,1))
    539       ENDDO
    540569c
    541570      DO k = 2, klev
     
    557586      ENDDO
    558587      ENDDO
    559 c======================================================================
    560 c
    561 c zx_qs = qsat en kg/kg
    562 c
    563       DO i = 1, knon
    564          IF (thermcep) THEN
    565            zdelta=MAX(0.,SIGN(1.,rtt-local_ts(i)))
    566            zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
    567            zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1))
    568            zx_qs= r2es * FOEEW(local_ts(i),zdelta)/paprs(i,1)
    569            zx_qs=MIN(0.5,zx_qs)
    570            zcor=1./(1.-retv*zx_qs)
    571            zx_qs=zx_qs*zcor
    572            zx_dq_s_dh = FOEDE(local_ts(i),zdelta,zcvm5,zx_qs,zcor)
    573      .                 /RLVTT / zx_pkh(i,1)
    574          ELSE
    575            IF (local_ts(i).LT.t_coup) THEN
    576               zx_qs = qsats(local_ts(i)) / paprs(i,1)
    577               zx_dq_s_dh = dqsats(local_ts(i),zx_qs)/RLVTT
    578      .                    / zx_pkh(i,1)
    579            ELSE
    580               zx_qs = qsatl(local_ts(i)) / paprs(i,1)
    581               zx_dq_s_dh = dqsatl(local_ts(i),zx_qs)/RLVTT
    582      .                    / zx_pkh(i,1)
    583            ENDIF
    584          ENDIF
    585588
    586 c        zx_dq_s_dh = 0.
    587          zx_dq_s_dt(i) = RCPD * zx_pkh(i,1) * zx_dq_s_dh
    588          zx_qsat(i) = zx_qs
    589 c
    590       ENDDO
    591589      DO i = 1, knon
    592590         zx_buf1(i) = zx_coef(i,klev) + delp(i,klev)
     
    639637      ENDDO
    640638
    641 C === Calcul de la temperature de surface ===
    642 C
    643 C zx_sl = chaleur latente d'evaporation ou de sublimation
    644 C
    645       do i = 1, knon
    646         zx_sl(i) = RLVTT
    647         if (local_ts(i) .LT. RTT) zx_sl(i) = RLSTT
    648         zx_k1(i) = zx_coef(i,1)
    649       enddo
    650       do i = 1, knon
    651 C Q
    652         zx_oq(i) = 1. - (beta(i) * zx_k1(i) * zx_dq(i,1) * dtime)
    653         zx_mq(i) = beta(i) * zx_k1(i) *
    654      .              (zx_cq(i,1) - zx_qsat(i)
    655      .                             + zx_dq_s_dt(i) * local_ts(i))
    656      .              / zx_oq(i)
    657         zx_nq(i) = beta(i) * zx_k1(i) * (-1. * zx_dq_s_dt(i))
    658      .                                                / zx_oq(i)
    659 c H
    660         zx_oh(i) = 1. - (zx_k1(i) * zx_dh(i,1) * dtime)
    661         zx_mh(i) = zx_k1(i) * zx_ch(i,1) / zx_oh(i)
    662         zx_nh(i) = - (zx_k1(i) * RCPD * zx_pkh(i,1))/ zx_oh(i)
    663 c Tsurface
    664         local_ts(i) = (ts(i) + cal(i)/(RCPD * zx_pkh(i,1)) * dtime *
    665      .                   (radsol(i) + zx_mh(i) + zx_sl(i) * zx_mq(i))
    666      .                       + dif_grnd(i) * t_grnd * dtime)/
    667      .                ( 1. - dtime * cal(i)/(RCPD * zx_pkh(i,1)) * (
    668      .                       zx_nh(i) + zx_sl(i) * zx_nq(i)) 
    669      .                     + dtime * dif_grnd(i))
    670         zx_h_ts(i) = local_ts(i) * RCPD * zx_pkh(i,1)
    671         d_ts(i) = local_ts(i) - ts(i)
    672         zx_q_0(i) = zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
    673 c== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
    674 c== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
    675         flux_q(i,1) = zx_mq(i) + zx_nq(i) * local_ts(i)
    676         flux_t(i,1) = zx_mh(i) + zx_nh(i) * local_ts(i)
    677 c Derives des flux dF/dTs (W m-2 K-1):
    678         dflux_s(i) = zx_nh(i)
    679         dflux_l(i) = (zx_sl(i) * zx_nq(i))
    680       ENDDO
     639C Appel a interfsurf (appel generique) routine d'interface avec la surface
    681640
     641      ok_veget = .false.
     642      ocean = 'force '
     643
     644      petAcoef=zx_ch(:,1)
     645      peqAcoef=zx_cq(:,1)
     646      petBcoef=zx_dh(:,1)
     647      peqBcoef=zx_dq(:,1)
     648      coef1lay=coef(:,1)
     649      temp_air=t(:,1)
     650      spechum=q(:,1)
     651      p1lay = pplay(:,1)
     652
     653      CALL interfsurf(itime, dtime, jour,
     654     . klon, nisurf, knon, knindex, rlon, rlat,
     655     . debut, lafin, ok_veget,
     656     . zlev, zlflu, u1lay, v1lay, temp_air, spechum, hum_air, ccanopy,
     657     . tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
     658     . precip_rain, precip_snow, lwdown, swnet, swdown,
     659     . ts, p1lay, cal, beta, coef1lay, psref, radsol, dif_grnd,
     660     . ocean,
     661     . evap, fluxsens, fluxlat, dflux_l, dflux_s,             
     662     . tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
     663
     664      flux_t(:,1) = fluxsens
     665      flux_q(:,1) = fluxlat
     666      d_ts = tsurf_new - ts
    682667
    683668c==== une fois on a zx_h_ts, on peut faire l'iteration ========
    684669      DO i = 1, knon
    685          local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i)*dtime
    686          local_q(i,1) = zx_cq(i,1) + zx_dq(i,1)*flux_q(i)*dtime
     670         local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i,1)*dtime
     671         local_q(i,1) = zx_cq(i,1) + zx_dq(i,1)*flux_q(i,1)*dtime
    687672      ENDDO
    688673      DO k = 2, klev
Note: See TracChangeset for help on using the changeset viewer.