/[lmdze]/trunk/phylmd/physiq.f
ViewVC logotype

Diff of /trunk/phylmd/physiq.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 69 by guez, Mon Feb 18 16:33:12 2013 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 167  contains Line 167  contains
167    
168      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
169    
170      INTEGER klevp1      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
171      PARAMETER(klevp1 = llm + 1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
172      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
173    
174      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
175      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
176      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
177    
178      !IM Amip2      !IM Amip2
# Line 372  contains Line 369  contains
369      INTEGER julien      INTEGER julien
370    
371      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
372      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
373      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
374    
     SAVE pctsrf ! sous-fraction du sol  
375      REAL albsol(klon)      REAL albsol(klon)
376      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
377      REAL albsollw(klon)      REAL albsollw(klon)
# Line 957  contains Line 952  contains
952      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
953         DO k = 1, llm         DO k = 1, llm
954            DO i = 1, klon            DO i = 1, klon
955               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
956                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
957               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
958                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)
              zxfluxu(i, k) = zxfluxu(i, k) + &  
                   fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + &  
                   fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
959            END DO            END DO
960         END DO         END DO
961      END DO      END DO
# Line 1095  contains Line 1086  contains
1086    
1087      if (iflag_con == 2) then      if (iflag_con == 2) then
1088         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1089         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), q_seri, &
1090              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              conv_t, conv_q, zxfluxq(:, 1), omega, d_t_con, d_q_con, &
1091              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              rain_con, snow_con, pmfu, pmfd, pen_u, pde_u, pen_d, &
1092              pmflxs)              pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs)
1093         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1094         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1095         DO i = 1, klon         DO i = 1, klon
# Line 1224  contains Line 1215  contains
1215    
1216      ! Caclul des ratqs      ! Caclul des ratqs
1217    
1218      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q
1219      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on écrase le tableau ratqsc calculé par clouds_gno
1220      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1221         do k = 1, llm         do k = 1, llm
1222            do i = 1, klon            do i = 1, klon
1223               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1224                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1225                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
1226               else               else
1227                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1228               endif               endif
# Line 1242  contains Line 1233  contains
1233      ! ratqs stables      ! ratqs stables
1234      do k = 1, llm      do k = 1, llm
1235         do i = 1, klon         do i = 1, klon
1236            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1237                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1238         enddo         enddo
1239      enddo      enddo
1240    
# Line 1253  contains Line 1244  contains
1244         ! ratqs final         ! ratqs final
1245         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1246         ! relaxation des ratqs         ! relaxation des ratqs
1247         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1248         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1249      else      else
1250         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
# Line 1342  contains Line 1332  contains
1332         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1333         do k = 1, llm         do k = 1, llm
1334            do i = 1, klon            do i = 1, klon
1335               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1336               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1337                    then                    then
1338                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
Legend:
Removed from v.69  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.21