Changeset 2227 for LMDZ5/trunk/libf/phylmd/physiq.F90

Timestamp:

Mar 12, 2015, 12:07:43 PM (9 years ago)

Author:

Laurent Fairhead

Message:

New ocean albedo.

To activate the new scheme, put iflag_albedo=1 in physiq.def

To activate chlorophyll concentration effect on albedo,
put ok_chlorophyll=y in def file

and download file named chlorophyll.nc
chlorophyll.nc has the same dimension as the model grid with 12 months data,
(i=lon, j=lat, L=1:12) and can be degraded from the original file of dimension
i=1:4320 , j=1:2160 , L=1:12
ada:/workgpfs/rech/psl/rpsl949/clima/chlor_seasonal_clim_seawifs.nc

For 96X96 resolution, chlorophyll.nc file is in
ada:/workgpfs/rech/psl/rpsl949/clima/chlorophyll.nc

19. Baek

File:

• LMDZ5/trunk/libf/phylmd/physiq.F90 (modified) (8 diffs)

LMDZ5/trunk/libf/phylmd/physiq.F90

@@ -865 +865 @@
 
   REAL zzz
+!albedo SB >>>
+  real,dimension(6),save :: SFRWL
+!albedo SB <<<
 
   !======================================================================
@@ -1349 +1352 @@
      mskocean_beta=.FALSE.
 
+!albedo SB >>>
+     select case(nsw)
+     case(2)
+     SFRWL(1)=0.45538747
+     SFRWL(2)=0.54461211
+     case(4)
+     SFRWL(1)=0.45538747
+     SFRWL(2)=0.32870591
+     SFRWL(3)=0.18568763
+     SFRWL(4)=3.02191470E-02
+     case(6)
+     SFRWL(1)=1.28432794E-03
+     SFRWL(2)=0.12304168
+     SFRWL(3)=0.33106142
+     SFRWL(4)=0.32870591
+     SFRWL(5)=0.18568763
+     SFRWL(6)=3.02191470E-02
+     end select
+
+
+!albedo SB <<<
+
      OPEN(99,file='beta_crf.data',status='old', &
           form='formatted',err=9999)
@@ -1385 +1410 @@
   !
   CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
-       pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
-
+!albedo SB >>>
+!       pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
+       pctsrf, falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
+!albedo SB <<<
 
   ! Update time and other variables in Reprobus
@@ -1820 +1847 @@
 !>nrlmd+jyg
           pplay,     paprs,     pctsrf,             &
-          ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
+!albedo SB >>>
+!          ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
+          ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
+!albedo SB <<<
           cdragh,    cdragm,  u1,    v1,            &
-          albsol1,   albsol2,   sens,    evap,      &
+!albedo SB >>>
+!          albsol1,   albsol2,   sens,    evap,      &
+          albsol_dir,   albsol_dif,   sens,    evap,   &  
+!albedo SB <<<
           albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
           zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
@@ -1888 +1921 @@
         call writefield_phy('q_seri',q_seri,llm)
      endif
+
+
+!albedo SB >>>
+ albsol1=0.
+ albsol2=0.
+ falb1=0.
+ falb2=0.
+select case(nsw)
+case(2)
+ albsol1=albsol_dir(:,1)
+ albsol2=albsol_dir(:,2)
+ falb1=falb_dir(:,1,:)
+ falb2=falb_dir(:,2,:)
+case(4)
+ albsol1=albsol_dir(:,1)
+ albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)+albsol_dir(:,4)*SFRWL(4)
+ albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
+ falb1=falb_dir(:,1,:)
+ falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)+falb_dir(:,4,:)*SFRWL(4)
+ falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
+case(6)
+ albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)
+ albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
+ albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5)+albsol_dir(:,6)*SFRWL(6)
+ albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
+ falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)
+ falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
+ falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5)+falb_dir(:,6,:)*SFRWL(6)
+ falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
+end select
+!albedo SB <<<
+
 
      CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
@@ -3300 +3365 @@
   IF (MOD(itaprad,radpas).EQ.0) THEN
 
-     DO i = 1, klon
-        albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
-             + falb1(i,is_lic) * pctsrf(i,is_lic) &
-             + falb1(i,is_ter) * pctsrf(i,is_ter) &
-             + falb1(i,is_sic) * pctsrf(i,is_sic)
-        albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
-             + falb2(i,is_lic) * pctsrf(i,is_lic) &
-             + falb2(i,is_ter) * pctsrf(i,is_ter) &
-             + falb2(i,is_sic) * pctsrf(i,is_sic)
-     ENDDO
+!albedo SB >>>  
+  if(ok_chlorophyll)then
+  print*,"-- reading chlorophyll"
+  call readchlorophyll(debut)
+  endif
+  !do i=1,klon
+  !if(chl_con(i)>1.) print*,i,chl_con(i),pctsrf(i,is_ter)
+  !enddo
+!albedo SB <<<
+
+!albedo SB >>>
+!     DO i = 1, klon
+!        albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
+!             + falb1(i,is_lic) * pctsrf(i,is_lic) &
+!             + falb1(i,is_ter) * pctsrf(i,is_ter) &
+!             + falb1(i,is_sic) * pctsrf(i,is_sic)
+!        albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
+!             + falb2(i,is_lic) * pctsrf(i,is_lic) &
+!             + falb2(i,is_ter) * pctsrf(i,is_ter) &
+!             + falb2(i,is_sic) * pctsrf(i,is_sic)
+!     ENDDO
+!albedo SB <<<
 
      if (mydebug) then
@@ -3357 +3434 @@
         CALL radlwsw &
              (dist, rmu0, fract,  &
-             paprs, pplay,zxtsol,albsol1, albsol2,  &
+!albedo SB >>>
+!             paprs, pplay,zxtsol,albsol1, albsol2,  &
+             paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif,  &
+!albedo SB <<<
              t_seri,q_seri,wo, &
              cldfrarad, cldemirad, cldtaurad, &
@@ -3410 +3490 @@
               CALL radlwsw &
                    (dist, rmu0, fract,  &
-                   paprs, pplay,zxtsol,albsol1, albsol2,  &
+!albedo SB >>>
+!                   paprs, pplay,zxtsol,albsol1, albsol2,  &
+                   paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, & 
+!albedo SB <<<
                    t_seri,q_seri,wo, &
                    cldfra, cldemi, cldtau, &