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

Diff of /trunk/Sources/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 71 by guez, Mon Jul 8 18:12:18 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 268  contains Line 265  contains
265      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
266      ! soil temperature of surface fraction      ! soil temperature of surface fraction
267    
268      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
269      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
270      SAVE fluxlat      SAVE fluxlat
271    
# Line 351  contains Line 347  contains
347    
348      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
349    
350      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
351      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
352      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
353      SAVE dlw      SAVE dlw
# Line 372  contains Line 368  contains
368      INTEGER julien      INTEGER julien
369    
370      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
371      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
372      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
373    
     SAVE pctsrf ! sous-fraction du sol  
374      REAL albsol(klon)      REAL albsol(klon)
375      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
376      REAL albsollw(klon)      REAL albsollw(klon)
# Line 505  contains Line 499  contains
499      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
500      REAL rneb(klon, llm)      REAL rneb(klon, llm)
501    
502      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
503      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
504      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
505      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
# Line 957  contains Line 951  contains
951      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
952         DO k = 1, llm         DO k = 1, llm
953            DO i = 1, klon            DO i = 1, klon
954               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
955                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
956               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
957                    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)  
958            END DO            END DO
959         END DO         END DO
960      END DO      END DO
# Line 1095  contains Line 1085  contains
1085    
1086      if (iflag_con == 2) then      if (iflag_con == 2) then
1087         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1088         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1089              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1090              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1091              pmflxs)              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1092                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         ibas_con = llm + 1 - kcbot
1096            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
           itop_con(i) = llm + 1 - kctop(i)  
        ENDDO  
1097      else      else
1098         ! iflag_con >= 3         ! iflag_con >= 3
1099         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
# Line 1119  contains Line 1108  contains
1108         ! supprimer les calculs / ftra.)         ! supprimer les calculs / ftra.)
1109    
1110         clwcon0 = qcondc         clwcon0 = qcondc
1111         pmfu = upwd + dnwd         mfu = upwd + dnwd
1112         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
1113    
1114         ! Calcul des propriétés des nuages convectifs         ! Calcul des propriétés des nuages convectifs
# Line 1129  contains Line 1118  contains
1118               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1119               IF (thermcep) THEN               IF (thermcep) THEN
1120                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1121                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)
1122                  zx_qs = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1123                  zcor = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1124                  zx_qs = zx_qs*zcor                  zx_qs = zx_qs*zcor
# Line 1145  contains Line 1134  contains
1134         ENDDO         ENDDO
1135    
1136         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1137         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1138         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1139              rnebcon0)              rnebcon0)
1140      END if      END if
# Line 1224  contains Line 1213  contains
1213    
1214      ! Caclul des ratqs      ! Caclul des ratqs
1215    
1216      ! 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
1217      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on écrase le tableau ratqsc calculé par clouds_gno
1218      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1219         do k = 1, llm         do k = 1, llm
1220            do i = 1, klon            do i = 1, klon
1221               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1222                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1223                       +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)
1224               else               else
1225                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1226               endif               endif
# Line 1242  contains Line 1231  contains
1231      ! ratqs stables      ! ratqs stables
1232      do k = 1, llm      do k = 1, llm
1233         do i = 1, klon         do i = 1, klon
1234            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1235                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1236         enddo         enddo
1237      enddo      enddo
1238    
# Line 1253  contains Line 1242  contains
1242         ! ratqs final         ! ratqs final
1243         ! 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
1244         ! relaxation des ratqs         ! relaxation des ratqs
1245         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1246         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1247      else      else
1248         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
# Line 1342  contains Line 1330  contains
1330         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1331         do k = 1, llm         do k = 1, llm
1332            do i = 1, klon            do i = 1, klon
1333               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1334               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)) &
1335                    then                    then
1336                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
# Line 1564  contains Line 1552  contains
1552    
1553      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1554      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1555           dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &
1556           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1557           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1558           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1559    
1560      IF (offline) THEN      IF (offline) THEN
1561         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, pde_u, &
1562              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1563              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1564      ENDIF      ENDIF
Legend:
Removed from v.69  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.21