Changeset 158 for LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

Timestamp:

Nov 10, 2000, 11:51:05 AM (24 years ago)

Author:

lmdzadmin

Message:

Un peu de menage
Elimination du runoff
LF

File:

• LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F (modified) (20 diffs)

LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

@@ -77 +77 @@
       parameter (ocean = 'force ')
 c     parameter (ocean = 'couple')
-c======================================================================
-c ok_ocean indique l'utilisation du modele oceanique "slab ocean",
-c il faut bien sur s'assurer que le bilan energetique de reference
-c a la surface de l'ocean est bien present dans le fichier des
-c conditions aux limites, ainsi que l'indicateur du sol ne contient
-c pas de glace oceanique (pas de valeur 3).
-c
-      LOGICAL ok_ocean
-      PARAMETER (ok_ocean=.FALSE.)
-      REAL cyang  ! capacite thermique de l'ocean superficiel
-      PARAMETER (cyang=30.0 * 4.228e+06)
-      REAL cbing  ! capacite thermique de la glace oceanique
-      PARAMETER (cbing=1.0 * 4.228e+06)
-      REAL cthermiq
+      logical ok_ocean
 c======================================================================
 c Clef controlant l'activation du cycle diurne:
@@ -120 +107 @@
 c
       LOGICAL ok_mensuel ! sortir le fichier mensuel
-      PARAMETER (ok_mensuel=.TRUE.)
+      PARAMETER (ok_mensuel=.true.)
 c
       LOGICAL ok_instan ! sortir le fichier instantane
@@ -273 +260 @@
       SAVE zuthe
       SAVE zvthe
-      INTEGER igwd,igwdim,idx(klon),itest(klon)
+      INTEGER igwd,idx(klon),itest(klon)
 c
       REAL agesno(klon)
       SAVE agesno                 ! age de la neige
 c
-      REAL alb_neig(klon)
-      SAVE alb_neig               ! albedo de la neige
 c
 c Variables locales:
@@ -305 +290 @@
       REAL rain_fall(klon) ! pluie
       REAL snow_fall(klon) ! neige
+      save snow_fall, rain_fall
       REAL evap(klon), devap(klon) ! evaporation et sa derivee
       REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
       REAL bils(klon) ! bilan de chaleur au sol
       REAL fder(klon) ! Derive de flux (sensible et latente) 
-      REAL ruis(klon) ! ruissellement
+      save fder
       REAL ve(klon) ! integr. verticale du transport meri. de l'energie
       REAL vq(klon) ! integr. verticale du transport meri. de l'eau
@@ -316 +302 @@
 c
       REAL frugs(klon,nbsrf) ! longueur de rugosite
+      save frugs
       REAL zxrugs(klon) ! longueur de rugosite
 c
@@ -328 +315 @@
       REAL pctsrf(klon,nbsrf)
       SAVE pctsrf                 ! sous-fraction du sol
-      REAL lmt_bils(klon)
-      SAVE lmt_bils               ! bilan de chaleur au sol
       REAL albsol(klon)
       SAVE albsol                 ! albedo du sol total
@@ -419 +404 @@
 c
       REAL za, zb
-      REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
+      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
       INTEGER i, k, iq, nsrf, ll
       REAL t_coup
@@ -545 +530 @@
 c
 
+         frugs = 0.
          itap    = 0
          itaprad = 0
@@ -777 +763 @@
          END DO 
            
-         CALL histdef(nid_day, "ruis", "Runoff", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
          CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
      .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
@@ -993 +975 @@
          END DO
 C
-         CALL histdef(nid_mth, "ruis", "Runoff", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
          CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
      .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
@@ -1840 +1818 @@
       IF (MOD(itaprad,radpas).EQ.0) THEN
       DO i = 1, klon
-         falbe(i,is_sic) = alb_neig(i)*zfra + 0.6*(1.0-zfra)
          albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
      .             + falbe(i,is_lic) * pctsrf(i,is_lic)
@@ -1898 +1875 @@
          bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
       ENDDO
-      IF (ok_ocean) THEN
-         DO i = 1, klon
-            cthermiq = cyang
-            IF (ftsol(i,is_oce).LT. 271.35) cthermiq = cbing
-            IF (pctsrf(i,is_oce).GT.epsfra) deltat(i) = deltat(i) +
-     .                          (bils(i)-lmt_bils(i))/cthermiq * dtime
-            IF (deltat(i).GT.15.0 ) deltat(i) = 15.0
-            IF (deltat(i).LT.-15.0) deltat(i) = -15.0
-         ENDDO
-      ENDIF
 c
 cmoddeblott(jan95)
@@ -1926 +1893 @@
         ENDIF
         ENDDO
-        igwdim=MAX(1,igwd)
+c        igwdim=MAX(1,igwd)
 c
         CALL drag_noro(klon,klev,dtime,paprs,pplay,
      e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
-     e                   igwd,igwdim,idx,itest,
+     e                   igwd,idx,itest,
      e                   t_seri, u_seri, v_seri,
      s                   zulow, zvlow, zustr, zvstr,
@@ -1958 +1925 @@
         ENDIF
         ENDDO
-        igwdim=MAX(1,igwd)
+c        igwdim=MAX(1,igwd)
 c
         CALL lift_noro(klon,klev,dtime,paprs,pplay,
-     e                   rlat,zmea,zstd, zsig, zgam, zthe,zpic,zval,
-     e                   igwd,igwdim,idx,itest,
+     e                   rlat,zmea,zstd,zpic,
+     e                   itest,
      e                   t_seri, u_seri, v_seri,
      s                   zulow, zvlow, zustr, zvstr,
@@ -2029 +1996 @@
 c Champs 2D:
 c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_day)
+
          i = NINT(zout/zsto)
          CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
@@ -2096 +2066 @@
       CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
 c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ruis,zx_tmp_2d)
-      CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c      DO i = 1, klon
-c         zx_tmp_fi2d(i) = fluxu(i,1)
-c      ENDDO
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-c      CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c      DO i = 1, klon
-c         zx_tmp_fi2d(i) = fluxv(i,1)
-c      ENDDO
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-c      CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
 c
       DO nsrf = 1, nbsrf
@@ -2203 +2159 @@
 c Champs 2D:
 c
+         zsto = dtime
+         zout = dtime * ecrit_mth
+
          i = NINT(zout/zsto)
          CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
@@ -2283 +2242 @@
       CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
 c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ruis,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
 c
 c      DO i = 1, klon
@@ -2533 +2490 @@
 c Champs 2D:
 c
+         zsto = dtime * ecrit_ins
+         zout = dtime * ecrit_ins
+
          i = NINT(zout/zsto)
          CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
@@ -2783 +2743 @@
       REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
 c
-      INTEGER i, j, n, ig
+      INTEGER i, n, ig
 c
       jjm = jjmp1 - 1