/[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 92 by guez, Wed Mar 26 18:16:05 2014 UTC revision 97 by guez, Fri Apr 25 14:58:31 2014 UTC
# Line 77  contains Line 77  contains
77      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
78    
79      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
80      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! géopotentiel de chaque couche (référence sol)
81    
82      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! géopotentiel du sol
83    
84      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
85      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
# Line 243  contains Line 243  contains
243    
244      ! ISCCP simulator v3.4      ! ISCCP simulator v3.4
245    
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
   
246      ! Variables propres a la physique      ! Variables propres a la physique
247    
248      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 301  contains Line 298  contains
298      !KE43      !KE43
299      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
300    
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
301      REAL Ma(klon, llm) ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
302      SAVE Ma      SAVE Ma
303      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
# Line 376  contains Line 369  contains
369    
370      ! Declaration des procedures appelees      ! Declaration des procedures appelees
371    
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
372      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
373      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
374    
# Line 466  contains Line 456  contains
456      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
457      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
458      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
     REAL tvp(klon, llm) ! virtual temp of lifted parcel  
459      REAL cape(klon) ! CAPE      REAL cape(klon) ! CAPE
460      SAVE cape      SAVE cape
461    
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
462      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     ! -- convect43:  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
463    
464      ! Variables du changement      ! Variables du changement
465    
# Line 533  contains Line 514  contains
514      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
515      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
516      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
   
517      REAL tr_seri(klon, llm, nbtr)      REAL tr_seri(klon, llm, nbtr)
     REAL d_tr(klon, llm, nbtr)  
518    
519      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
520    
# Line 546  contains Line 525  contains
525    
526      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
527    
528      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_ins
529    
530      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
531      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
# Line 562  contains Line 541  contains
541      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
542      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
543      REAL zero_v(klon)      REAL zero_v(klon)
544      CHARACTER(LEN = 15) tit      CHARACTER(LEN = 20) tit
545      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
546      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
547    
# Line 983  contains Line 962  contains
962    
963         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
964              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
965              'physiq : probl\`eme sous surface au point ', i, pctsrf(i, 1 : nbsrf)              'physiq : probl\`eme sous surface au point ', i, &
966                pctsrf(i, 1 : nbsrf)
967      ENDDO      ENDDO
968      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
969         DO i = 1, klon         DO i = 1, klon
# Line 1011  contains Line 991  contains
991         ENDDO         ENDDO
992      ENDDO      ENDDO
993    
994      ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :
   
995      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
996         DO i = 1, klon         DO i = 1, klon
997            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
# Line 1071  contains Line 1050  contains
1050      else      else
1051         ! iflag_con >= 3         ! iflag_con >= 3
1052    
1053         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
1054              v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
1055              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
1056              itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &              qcondc, wd, pmflxr, pmflxs, da, phi, mp)
             pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &  
             wd, pmflxr, pmflxs, da, phi, mp, ntra=1)  
        ! (number of tracers for the convection scheme of Kerry Emanuel:  
        ! la partie traceurs est faite dans phytrac  
        ! on met ntra = 1 pour limiter les appels mais on peut  
        ! supprimer les calculs / ftra.)  
   
1057         clwcon0 = qcondc         clwcon0 = qcondc
1058         mfu = upwd + dnwd         mfu = upwd + dnwd
1059         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
# Line 1090  contains Line 1062  contains
1062    
1063         DO k = 1, llm         DO k = 1, llm
1064            DO i = 1, klon            DO i = 1, klon
              zx_t = t_seri(i, k)  
1065               IF (thermcep) THEN               IF (thermcep) THEN
1066                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt - t_seri(i, k)))
1067                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)                  zqsat(i, k) = r2es * FOEEW(t_seri(i, k), zdelta) / play(i, k)
1068                  zx_qs = MIN(0.5, zx_qs)                  zqsat(i, k) = MIN(0.5, zqsat(i, k))
1069                  zcor = 1./(1.-retv*zx_qs)                  zqsat(i, k) = zqsat(i, k) / (1.-retv*zqsat(i, k))
                 zx_qs = zx_qs*zcor  
1070               ELSE               ELSE
1071                  IF (zx_t < t_coup) THEN                  IF (t_seri(i, k) < t_coup) THEN
1072                     zx_qs = qsats(zx_t)/play(i, k)                     zqsat(i, k) = qsats(t_seri(i, k))/play(i, k)
1073                  ELSE                  ELSE
1074                     zx_qs = qsatl(zx_t)/play(i, k)                     zqsat(i, k) = qsatl(t_seri(i, k))/play(i, k)
1075                  ENDIF                  ENDIF
1076               ENDIF               ENDIF
              zqsat(i, k) = zx_qs  
1077            ENDDO            ENDDO
1078         ENDDO         ENDDO
1079    
# Line 1383  contains Line 1352  contains
1352         cg_ae = 0.         cg_ae = 0.
1353      ENDIF      ENDIF
1354    
1355      ! Param\`etres optiques des nuages et quelques param\`etres pour diagnostics :      ! Param\`etres optiques des nuages et quelques param\`etres pour
1356        ! diagnostics :
1357      if (ok_newmicro) then      if (ok_newmicro) then
1358         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1359              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
Legend:
Removed from v.92  
changed lines
  Added in v.97
  ViewVC Help
Powered by ViewVC 1.1.21