source: LMDZ5/trunk/libf/phylmd/change_srf_frac_mod.F90 @ 2237

Last change on this file since 2237 was 2227, checked in by Laurent Fairhead, 10 years ago

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

  1. Baek
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.7 KB
Line 
1!
2! $Id: change_srf_frac_mod.F90 2227 2015-03-12 11:07:43Z fhourdin $
3!
4MODULE change_srf_frac_mod
5
6  IMPLICIT NONE
7
8CONTAINS
9!
10! Change Surface Fractions
11! Author J Ghattas 2008
12
13  SUBROUTINE change_srf_frac(itime, dtime, jour, &
14!albedo SB >>>
15!       pctsrf, alb1, alb2, tsurf, ustar, u10m, v10m, pbl_tke)
16        pctsrf, alb_dir, alb_dif, tsurf, ustar, u10m, v10m, pbl_tke)
17!albedo SB <<<
18   
19
20
21!
22! This subroutine is called from physiq.F at each timestep.
23! 1- For each type of ocean (force, slab, couple) receive new fractions only if
24!    it's time to modify (is_modified=true). Otherwise nothing is done (is_modified=false).   
25! If received new fraction :
26! 2- Tests and ajustements are done on the fractions
27! 3- Initialize variables where a new fraction(new or melted ice) has appered,
28!
29
30    USE dimphy
31    USE surface_data, ONLY : type_ocean,version_ocean
32    USE limit_read_mod
33    USE pbl_surface_mod, ONLY : pbl_surface_newfrac
34    USE cpl_mod, ONLY : cpl_receive_frac
35    USE ocean_slab_mod, ONLY : fsic, ocean_slab_frac
36    USE indice_sol_mod
37
38    INCLUDE "iniprint.h"
39    INCLUDE "YOMCST.h"
40!albedo SB >>>
41    include "clesphys.h"
42!albedo SB <<<
43
44
45
46! Input arguments
47!****************************************************************************************
48    INTEGER, INTENT(IN)                     :: itime   ! current time step
49    INTEGER, INTENT(IN)                     :: jour    ! day of the year
50    REAL,    INTENT(IN)                     :: dtime   ! length of time step (s)
51 
52! In-Output arguments
53!****************************************************************************************
54   
55    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf ! sub-surface fraction
56!albedo SB >>>
57!   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb1   ! albedo first interval in SW spektrum
58!   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb2   ! albedo second interval in SW spektrum
59    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
60!albedo SB <<<
61
62    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf
63    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar
64    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: u10m
65    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: v10m
66!jyg<
67!!    REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: pbl_tke
68    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: pbl_tke
69!>jyg
70
71! Loccal variables
72!****************************************************************************************
73    INTEGER                        :: i, nsrf
74    LOGICAL                        :: is_modified   ! true if pctsrf is modified at this time step
75    LOGICAL                        :: test_sum=.FALSE.
76    LOGICAL, DIMENSION(klon,nbsrf) :: new_surf
77    REAL, DIMENSION(klon,nbsrf)    :: pctsrf_old    ! fraction from previous time-step
78    REAL                           :: tmpsum
79
80    pctsrf_old(:,:) = pctsrf(:,:)
81!****************************************************************************************
82! 1)
83! For each type of ocean (force, slab, couple) receive new fractions only if it's time 
84! to modify (is_modified=true). Otherwise nothing is done (is_modified=false).   
85!****************************************************************************************
86    SELECT CASE (type_ocean)
87    CASE ('force')
88       ! Read fraction from limit.nc
89       CALL limit_read_frac(itime, dtime, jour, pctsrf, is_modified)
90    CASE ('slab')
91       ! Get fraction from slab module
92       CALL ocean_slab_frac(itime, dtime, jour, pctsrf, is_modified)
93    CASE ('couple')
94       ! Get fraction from the coupler
95       CALL cpl_receive_frac(itime, dtime, pctsrf, is_modified)
96    END SELECT
97
98
99!****************************************************************************************
100! 2)
101! Tests and ajustements on the new fractions :
102! - Put to zero fractions that are too small
103! - Test total fraction sum is one for each grid point
104!
105!****************************************************************************************
106    IF (is_modified) THEN
107 
108! Test and exit if a fraction is negative
109       IF (MINVAL(pctsrf(:,:)) < 0.) THEN
110          WRITE(lunout,*)'Warning! One or several fractions are negative, itime=',itime
111          WRITE(lunout,*)'at point = ',MINLOC(pctsrf(:,:))
112          WRITE(lunout,*)'value = ',MINVAL(pctsrf(:,:))
113          CALL abort_gcm('change_srf_frac','Negative fraction',1)
114       END IF
115
116! Optional test on the incoming fraction
117       IF (test_sum) THEN
118          DO i= 1, klon
119             tmpsum = SUM(pctsrf(i,:))
120             IF (ABS(1. - tmpsum) > 0.05) CALL abort_gcm('change_srf_frac','Total fraction not equal 1.',1)
121          END DO
122       END IF
123
124! Test for too small fractions of the sum land+landice and ocean+sea-ice
125       WHERE ((pctsrf(:,is_ter) + pctsrf(:,is_lic)) < 2*EPSFRA)
126          pctsrf(:,is_ter) = 0.
127          pctsrf(:,is_lic) = 0.
128       END WHERE
129
130       WHERE ((pctsrf(:,is_oce) + pctsrf(:,is_sic)) < 2*EPSFRA)
131          pctsrf(:,is_oce) = 0.
132          pctsrf(:,is_sic) = 0.
133       END WHERE
134
135! Normalize to force total fraction to be equal one
136       DO i= 1, klon
137          tmpsum = SUM(pctsrf(i,:))
138          DO nsrf = 1, nbsrf
139             pctsrf(i,nsrf) = pctsrf(i,nsrf) / tmpsum
140          END DO
141       END DO
142
143! Test for too small fractions at each sub-surface
144       WHERE (pctsrf(:,is_ter) < EPSFRA)
145          pctsrf(:,is_lic) = pctsrf(:,is_ter) + pctsrf(:,is_lic)
146          pctsrf(:,is_ter) = 0.
147       END WHERE
148
149       WHERE (pctsrf(:,is_lic) < EPSFRA)
150          pctsrf(:,is_ter) = pctsrf(:,is_ter) + pctsrf(:,is_lic)
151          pctsrf(:,is_lic) = 0.
152       END WHERE
153
154       WHERE (pctsrf(:,is_oce) < EPSFRA)
155          pctsrf(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
156          pctsrf(:,is_oce) = 0.
157       END WHERE
158
159       WHERE (pctsrf(:,is_sic) < EPSFRA)
160          pctsrf(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
161          pctsrf(:,is_sic) = 0.
162       END WHERE
163! Send fractions back to slab ocean if needed
164       IF (type_ocean == 'slab'.AND. version_ocean.NE.'sicINT') THEN
165           WHERE (1.-zmasq(:)>EPSFRA)
166               fsic(:)=pctsrf(:,is_sic)/(1.-zmasq(:))
167           END WHERE
168       END IF
169
170!****************************************************************************************
171! 3)
172! Initialize variables where a new fraction has appered,
173! i.e. where new sea ice has been formed
174! or where ice free ocean has appread in a grid cell
175!
176!****************************************************************************************
177
178!albedo SB >>>
179! CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, ustar,
180! u10m, v10m, pbl_tke)
181       CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb_dir,alb_dif, ustar, u10m, v10m, pbl_tke)
182!albedo SB <<<
183
184
185
186    ELSE
187       ! No modifcation should be done
188       pctsrf(:,:) = pctsrf_old(:,:)
189
190    END IF ! is_modified
191
192  END SUBROUTINE change_srf_frac
193
194
195END MODULE change_srf_frac_mod
Note: See TracBrowser for help on using the repository browser.