Changeset 456 for LMDZ.3.3/branches/rel-LF/libf/phylmd

Timestamp:

Mar 7, 2003, 5:49:40 PM (22 years ago)

Author:

lmdzadmin

Message:

Ajout fonte neige, calving, albedo moyen de la maille et slp IM/FH/JLD

File:

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

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

@@ -233 +233 @@
 c
       REAL radsol(klon)
-      SAVE radsol                 ! bilan radiatif au sol
+      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
 c
       REAL rlat(klon)
@@ -367 +367 @@
       REAL yu1(klon)            ! vents dans la premiere couche U
       REAL yv1(klon)            ! vents dans la premiere couche V
+cIM cf JLD
+      REAL ffonte(klon,nbsrf)         !Flux thermique utilise pour fondre la neige
+      REAL fqcalving(klon,nbsrf)      !Flux d'eau "perdue" par la surface 
+c                               !et necessaire pour limiter la
+c                               !hauteur de neige, en kg/m2/s
+      REAL zxffonte(klon), zxfqcalving(klon)
+
       LOGICAL offline           ! Controle du stockage ds "physique"
       PARAMETER (offline=.false.)
@@ -412 +419 @@
       REAL albsollw(klon)
       SAVE albsollw                 ! albedo du sol total
-      REAL albsol1(klon)
-      SAVE albsol1                 ! albedo du sol total
-      REAL albsollw1(klon)
-      SAVE albsollw1                 ! albedo du sol total
 
       REAL wo(klon,klev)
@@ -1088 +1091 @@
         rmu0 = -999.999
       ENDIF
-
+C
+C     Calcul de l'abedo moyen par maille
+      albsol(:)=0.
+      albsollw(:)=0.
+      DO nsrf = 1, nbsrf
+      DO i = 1, klon
+         albsol(i) = albsol(i) + falbe(i,nsrf) * pctsrf(i,nsrf)
+         albsollw(i) = albsollw(i) + falblw(i,nsrf) * pctsrf(i,nsrf)
+      ENDDO
+      ENDDO
+C
+C     Repartition sous maille des flux LW et SW
       DO nsrf = 1, nbsrf
       DO i = 1, klon
@@ -1112 +1126 @@
      s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
      s            dsens, devap,
-     s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m) 
+cIM cf JLD    s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m) 
+     s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m,
+     s            fqcalving,ffonte) 
 c
 CXXX PB
@@ -1175 +1191 @@
          zu10m(i) = 0.0
          zv10m(i) = 0.0
+cIM cf JLD ??
+         zxffonte(i) = 0.0
+         zxfqcalving(i) = 0.0
 c
          IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + 
@@ -1197 +1216 @@
             zu10m(i) = zu10m(i) + u10m(i,nsrf)*pctsrf(i,nsrf)
             zv10m(i) = zv10m(i) + v10m(i,nsrf)*pctsrf(i,nsrf)
+cIM cf JLD ??
+            zxffonte(i) = zxffonte(i) + ffonte(i,nsrf)*pctsrf(i,nsrf)
+            zxfqcalving(i) = zxfqcalving(i) + 
+     .                      fqcalving(i,nsrf)*pctsrf(i,nsrf)
 c        ENDIF 
         ENDDO
@@ -1212 +1235 @@
           IF (pctsrf(i,nsrf) .LT. epsfra) u10m(i,nsrf) = zu10m(i)
           IF (pctsrf(i,nsrf) .LT. epsfra) v10m(i,nsrf) = zv10m(i)
+cIM cf JLD ??
+          IF (pctsrf(i,nsrf) .LT. epsfra) ffonte(i,nsrf) = zxffonte(i)
+          IF (pctsrf(i,nsrf) .LT. epsfra) 
+     .    fqcalving(i,nsrf) = zxfqcalving(i)
         ENDDO
       ENDDO
@@ -1939 +1966 @@
       call plevel(klon,klev,.true. ,paprs,50000.,omega,w500)
 
-      slp(:) = paprs(:,1)*exp(pphis(:)/(289.*t_seri(:,1)))
-c
-
+cIM cf. FH     slp(:) = paprs(:,1)*exp(pphis(:)/(289.*t_seri(:,1)))
+      slp(:) = paprs(:,1)*exp(pphis(:)/(RD*t_seri(:,1)))
+      PRINT*,' physiq slp ',slp(2185),paprs(2185,1),pphis(2185),
+     .       RD,t_seri(2185,1)
+c
 
 c=============================================================