source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/change_srf_frac_mod.F90 @ 3809

Last change on this file since 3809 was 3809, checked in by ymipsl, 10 years ago

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