Changeset 438 for LMDZ.3.3/branches


Ignore:
Timestamp:
Jan 27, 2003, 11:07:30 AM (22 years ago)
Author:
lmdzadmin
Message:

Remplacement qsol par qsurf JLD
IM

File:
1 edited

Legend:

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

    r433 r438  
    77     .                  jour, rmu0,
    88     .                  ok_veget, ocean, npas, nexca, ts,
    9      .                  soil_model,ftsoil,
    10      .                  paprs,pplay,radsol,snow,qsol,evap,albe,alblw,
     9     .                  soil_model,ftsoil,qsol,
     10     .                  paprs,pplay,radsol,snow,qsurf,evap,albe,alblw,
    1111     .                  fluxlat,
    1212     .                  rain_f, snow_f, solsw, sollw, sollwdown, fder,
     
    110110      REAL d_ts(klon,nbsrf)
    111111      REAL snow(klon,nbsrf)
    112       REAL qsol(klon,nbsrf)
     112      REAL qsurf(klon,nbsrf)
    113113      REAL evap(klon,nbsrf)
    114114      REAL albe(klon,nbsrf)
     
    133133      REAL ftsoil(klon,nsoilmx,nbsrf)
    134134      REAL ytsoil(klon,nsoilmx)
     135      REAL qsol(klon)
    135136c======================================================================
    136137      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac
     
    140141      REAL yalblw(klon)
    141142      REAL yu1(klon), yv1(klon)
    142       real ysnow(klon), yqsol(klon), yagesno(klon)
     143      real ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)
    143144      real yrain_f(klon), ysnow_f(klon)
    144145      real ysollw(klon), ysolsw(klon), ysollwdown(klon)
     
    225226      PARAMETER(t_coup=273.15)
    226227C
    227       PRINT*,'IMclmain klon=',klon
     228      character (len = 20) :: modname = 'clmain'
     229      LOGICAL check
     230      PARAMETER (check=.true.)
     231C
     232      if (check) THEN
     233          write(*,*) modname,'  klon=',klon
     234          call flush(6)
     235      endif
    228236      IF (first_appel) THEN
    229237          first_appel=.false.
     
    283291      yts = 0.0
    284292      ysnow = 0.0
    285       yqsol = 0.0
     293      yqsurf = 0.0
    286294      yalb = 0.0
    287295      yalblw = 0.0
     
    377385      ENDDO
    378386c
    379 c      write(*,*)'CLMAIN, nsrf, knon =',nsrf, knon
     387      if (check) THEN
     388          write(*,*)'CLMAIN, nsrf, knon =',nsrf, knon
     389          call flush(6)
     390      endif
    380391c
    381392c variables pour avoir une sortie IOIPSL des INDEX
     
    399410        yts(j) = ts(i,nsrf)
    400411        ysnow(j) = snow(i,nsrf)
    401         yqsol(j) = qsol(i,nsrf)
     412        yqsurf(j) = qsurf(i,nsrf)
    402413        yalb(j) = albe(i,nsrf)
    403414        yalblw(j) = alblw(i,nsrf)
     
    436447        ypaprs(j,klev+1) = paprs(i,klev+1)
    437448      END DO
     449      IF ( nsrf .eq. is_ter ) THEN
     450          DO j = 1, knon
     451            i = ni(j)
     452            yqsol(j) = qsol(i)
     453          END DO
     454      ELSE
     455          yqsol(:)=0.
     456      ENDIF
    438457c$$$ PB ajour pour soil
    439458      DO k = 1, nsoilmx
     
    460479      CALL coefkz(nsrf, knon, ypaprs, ypplay,
    461480     .            yts, yrugos, yu, yv, yt, yq,
    462 cIM remplace qsurf par yqsol
    463      .            yqsol,
     481     .            yqsurf,
    464482     .            ycoefm, ycoefh)
    465483      CALL coefkz2(nsrf, knon, ypaprs, ypplay,yt,
     
    493511     e          rlon, rlat, cufi, cvfi,
    494512     e          knon, nsrf, ni, pctsrf,
    495      e          soil_model, ytsoil,
     513     e          soil_model, ytsoil,yqsol,
    496514     e          ok_veget, ocean, npas, nexca,
    497515     e          rmu0, yrugos, yrugoro,
    498516     e          yu1, yv1, ycoefh,
    499517     e          yt,yq,yts,ypaprs,ypplay,
    500      e          ydelp,yrads,yalb, yalblw, ysnow, yqsol,
     518     e          ydelp,yrads,yalb, yalblw, ysnow, yqsurf,
    501519     e          yrain_f, ysnow_f, yfder, ytaux, ytauy,
    502520c$$$     e          ysollw, ysolsw,
     
    548566      alblw(:, nsrf) = 0.
    549567      snow(:, nsrf) = 0.
    550       qsol(:, nsrf) = 0.
     568      qsurf(:, nsrf) = 0.
    551569      rugos(:, nsrf) = 0.
    552570      fluxlat(:,nsrf) = 0.
     
    557575         alblw(i,nsrf) = yalblw(j)
    558576         snow(i,nsrf) = ysnow(j)
    559          qsol(i,nsrf) = yqsol(j)
     577         qsurf(i,nsrf) = yqsurf(j)
    560578         rugos(i,nsrf) = yz0_new(j)
    561579         fluxlat(i,nsrf) = yfluxlat(j)
     
    572590         zv1(i) = zv1(i) + yv1(j)
    573591      END DO
     592      IF ( nsrf .eq. is_ter ) THEN
     593      DO j = 1, knon
     594         i = ni(j)
     595         qsol(i) = yqsol(j)
     596      END DO
     597      END IF
    574598c$$$ PB ajout pour soil
    575599      ftsoil(:,:,nsrf) = 0.
     
    624648        patm(j)=ypplay(j,1)
    625649c
    626         IF (nsrf.EQ.1) THEN
    627           qairsol(j) = yqsol(j)
    628         ELSE IF(nsrf.GT.1) THEN
    629          zt = ts(i,nsrf)
    630          IF (thermcep) THEN
    631            zdelta = MAX(0.,SIGN(1.,RTT-zt))
    632            zqs = R2ES * FOEEW(zt,zdelta) / ypplay(j,1)
    633            zqs = MIN(0.5,zqs)
    634            zcor = 1./(1.-RETV*zqs)
    635            zqs = zqs*zcor
    636          ELSE
    637            IF (zt .LT. t_coup) THEN
    638              zqs = qsats(zt) / ypplay(j,1)
    639            ELSE
    640              zqs = qsatl(zt) / ypplay(j,1)
    641            ENDIF
    642          ENDIF   
    643          qairsol(j) = zqs
    644         ENDIF   
    645       ENDDO
    646 c
    647       IF(nsrf.EQ.3) THEN
    648        j=1465
    649        WRITE(*,*)' INstO',klon,knon,nsrf,zxli,uzon(j),vmer(j),
    650      & tair1(j),qair1(j),zgeo1(j),tairsol(j),qairsol(j),rugo1(j),
    651      & psfce(j),patm(j)
     650        qairsol(j) = yqsurf(j)
     651c$$$        IF (nsrf.EQ.1) THEN
     652c$$$          qairsol(j) = yqsurf(j)
     653c$$$        ELSE IF(nsrf.GT.1) THEN
     654c$$$         zt = ts(i,nsrf)
     655c$$$         IF (thermcep) THEN
     656c$$$           zdelta = MAX(0.,SIGN(1.,RTT-zt))
     657c$$$           zqs = R2ES * FOEEW(zt,zdelta) / ypplay(j,1)
     658c$$$           zqs = MIN(0.5,zqs)
     659c$$$           zcor = 1./(1.-RETV*zqs)
     660c$$$           zqs = zqs*zcor
     661c$$$         ELSE
     662c$$$           IF (zt .LT. t_coup) THEN
     663c$$$             zqs = qsats(zt) / ypplay(j,1)
     664c$$$           ELSE
     665c$$$             zqs = qsatl(zt) / ypplay(j,1)
     666c$$$           ENDIF
     667c$$$         ENDIF   
     668c$$$         qairsol(j) = zqs
     669c$$$        ENDIF   
     670      ENDDO
     671c
     672      if (check) THEN
     673       WRITE(*,*)' avant stdlevvar. nsrf=',nsrf
     674       IF(nsrf.EQ.3) THEN
     675        j=1465
     676        WRITE(*,*)' INstO',klon,knon,nsrf,zxli,uzon(j),vmer(j),
     677     &      tair1(j),qair1(j),zgeo1(j),tairsol(j),qairsol(j),rugo1(j),
     678     &      psfce(j),patm(j)
     679       ENDIF
     680       WRITE(*,*)' qairsol (min, max)'
     681     $     , minval(qairsol(1:knon)), maxval(qairsol(1:knon))
     682       call flush(6)
    652683      ENDIF
    653684c
     
    658689
    659690c
     691      if (check) THEN
    660692      IF(nsrf.EQ.3) THEN
    661693       j=1465
     
    664696     & psfce(j),patm(j)
    665697       WRITE(*,*)' tqu',yt2m(j),yq2m(j),yu10m(j)
     698          call flush(6)
     699      ENDIF
    666700      ENDIF
    667701c
     
    670704       t2m(i,nsrf)=yt2m(j)
    671705
    672         IF(nsrf.EQ.3) THEN
    673          IF(j.EQ.1465) THEN
     706       if (check) THEN
     707        IF(nsrf.EQ.3 .and. j.EQ.1465) THEN
    674708         WRITE(*,*) 't2m APRES stdlev',j,i,tair1(j),t2m(i,nsrf),
    675709     $   tairsol(j),rlon(i),rlat(i)
    676          ENDIF
     710         call flush(6)
    677711        ENDIF
     712       ENDIF
    678713c
    679714       q2m(i,nsrf)=yq2m(j)
     
    706741     e                rlon, rlat, cufi, cvfi,
    707742     e                knon, nisurf, knindex, pctsrf,
    708      $                soil_model,tsoil,
     743     $                soil_model,tsoil,qsol,
    709744     e                ok_veget, ocean, npas, nexca,
    710745     e                rmu0, rugos, rugoro,
    711746     e                u1lay,v1lay,coef,
    712747     e                t,q,ts,paprs,pplay,
    713      e                delp,radsol,albedo,alblw,snow,qsol,
     748     e                delp,radsol,albedo,alblw,snow,qsurf,
    714749     e                precip_rain, precip_snow, fder, taux, tauy,
    715750     $                sollw, sollwdown, swnet,fluxlat,
     
    753788      REAL alblw(klon)
    754789      REAL snow(klon)         ! hauteur de neige
    755       REAL qsol(klon)         ! humidite de la surface
     790      REAL qsurf(klon)         ! humidite de l'air au dessus de la surface
    756791      real precip_rain(klon), precip_snow(klon)
    757792      REAL agesno(klon)
     
    822857      LOGICAL soil_model
    823858      REAL tsoil(klon, nsoilmx)
     859      REAL qsol(klon)
    824860
    825861! Parametres de sortie
     
    830866c JLD
    831867      real zzpk
    832      
    833 c
    834 
     868C
     869      character (len = 20) :: modname = 'Debut clqh'
     870      LOGICAL check
     871      PARAMETER (check=.true.)
     872C
     873      if (check) THEN
     874          write(*,*) modname,' nisurf=',nisurf
     875          call flush(6)
     876      endif
     877c
     878      if (check) THEN
     879       WRITE(*,*)' qsurf (min, max)'
     880     $     , minval(qsurf(1:knon)), maxval(qsurf(1:knon))
     881       call flush(6)
     882      ENDIF
     883C
    835884      if (.not. contreg) then
    836885        do k = 2, klev
     
    9691018     e klon, iim, jjm, nisurf, knon, knindex, pctsrf,
    9701019     e rlon, rlat, cufi, cvfi,
    971      e debut, lafin, ok_veget, soil_model, nsoilmx,tsoil,
     1020     e debut, lafin, ok_veget, soil_model, nsoilmx,tsoil, qsol,
    9721021     e zlev1,  u1lay, v1lay, temp_air, spechum, epot_air, ccanopy,
    9731022     e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
    9741023     e precip_rain, precip_snow, sollw, sollwdown, swnet, swdown,
    9751024     e fder, taux, tauy, rugos, rugoro,
    976      e albedo, snow, qsol,
     1025     e albedo, snow, qsurf,
    9771026     e ts, p1lay, psref, radsol,
    9781027     e ocean, npas, nexca, zmasq,
     
    11461195     .                  ts, rugos,
    11471196     .                  u,v,t,q,
    1148 cIM remplace qsurf par yqsol
    1149      .                  qsol,
     1197     .                  qsurf,
    11501198     .                  pcfm, pcfh)
    11511199      IMPLICIT none
     
    12371285c contre-gradient pour la chaleur sensible: Kelvin/metre
    12381286      REAL gamt(2:klev)
    1239 c essai qsurf
    1240 cIM   real qsurf(klon)
    1241       real qsol(klon)
     1287      real qsurf(klon)
    12421288c
    12431289      LOGICAL appel1er
     
    12771323      ENDDO
    12781324
    1279 cIM remplace qsurf par qsol
    1280       IF(nsrf.NE.1) THEN
    1281       do i = 1, knon
    1282 cIM     qsurf(i) = qsatl(ts(i))/paprs(i,1)
    1283         qsol(i) = qsatl(ts(i))/paprs(i,1)
    1284       enddo
    1285       ENDIF
     1325c$$$      IF(nsrf.NE.1) THEN
     1326c$$$      do i = 1, knon
     1327c$$$        qsurf(i) = qsatl(ts(i))/paprs(i,1)
     1328c$$$      enddo
     1329c$$$      ENDIF
    12861330
    12871331c
Note: See TracChangeset for help on using the changeset viewer.