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

Last change on this file since 3866 was 2656, checked in by Ehouarn Millour, 8 years ago

Making the slab work:

  • added a slab_heat_transp_mod module for horizontal diffusion and Ekman transport
  • added storage and output of relevent variables in phyredem, phyetat0, phy_output_ctrlout_mod, phys_output_write_mod
  • moved nslay (number of slab layers) out of dimphy into ocean_slab_mod.

FC

  • 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.8 KB
RevLine 
[996]1!
[2227]2! $Id: change_srf_frac_mod.F90 2656 2016-10-10 08:57:24Z fairhead $
[996]3!
4MODULE change_srf_frac_mod
5
6  IMPLICIT NONE
7
8CONTAINS
9!
10! Change Surface Fractions
[1454]11! Author J Ghattas 2008
12
[996]13  SUBROUTINE change_srf_frac(itime, dtime, jour, &
[2243]14        pctsrf, evap, z0m, z0h, agesno,              &
15        alb_dir, alb_dif, tsurf, ustar, u10m, v10m, pbl_tke)
[2227]16   
17
18
[996]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
[2209]29    USE surface_data, ONLY : type_ocean,version_ocean
[996]30    USE limit_read_mod
31    USE pbl_surface_mod, ONLY : pbl_surface_newfrac
32    USE cpl_mod, ONLY : cpl_receive_frac
[2209]33    USE ocean_slab_mod, ONLY : fsic, ocean_slab_frac
[1785]34    USE indice_sol_mod
[2311]35    USE print_control_mod, ONLY: lunout
36   
[996]37    INCLUDE "YOMCST.h"
[2227]38!albedo SB >>>
39    include "clesphys.h"
40!albedo SB <<<
[996]41
[2227]42
43
[996]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
[2243]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
[2227]56!albedo SB >>>
57    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
58!albedo SB <<<
59
[996]60    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf
[1670]61    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar
[996]62    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: u10m
63    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: v10m
[2181]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
[996]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')
[2656]89       IF (version_ocean == 'sicOBS'.OR. version_ocean == 'sicNO') THEN
90       ! Read fraction from limit.nc
91           CALL limit_read_frac(itime, dtime, jour, pctsrf, is_modified)
92       ELSE
[996]93       ! Get fraction from slab module
[2656]94           CALL ocean_slab_frac(itime, dtime, jour, pctsrf, is_modified)
95       ENDIF
[996]96    CASE ('couple')
97       ! Get fraction from the coupler
98       CALL cpl_receive_frac(itime, dtime, pctsrf, is_modified)
99    END SELECT
100
[1454]101
[996]102!****************************************************************************************
103! 2)
104! Tests and ajustements on the new fractions :
105! - Put to zero fractions that are too small
106! - Test total fraction sum is one for each grid point
107!
108!****************************************************************************************
[1454]109    IF (is_modified) THEN
[996]110 
111! Test and exit if a fraction is negative
112       IF (MINVAL(pctsrf(:,:)) < 0.) THEN
113          WRITE(lunout,*)'Warning! One or several fractions are negative, itime=',itime
114          WRITE(lunout,*)'at point = ',MINLOC(pctsrf(:,:))
115          WRITE(lunout,*)'value = ',MINVAL(pctsrf(:,:))
[2311]116          CALL abort_physic('change_srf_frac','Negative fraction',1)
[996]117       END IF
118
119! Optional test on the incoming fraction
120       IF (test_sum) THEN
121          DO i= 1, klon
122             tmpsum = SUM(pctsrf(i,:))
[2311]123             IF (ABS(1. - tmpsum) > 0.05) CALL abort_physic('change_srf_frac','Total fraction not equal 1.',1)
[996]124          END DO
125       END IF
126
127! Test for too small fractions of the sum land+landice and ocean+sea-ice
128       WHERE ((pctsrf(:,is_ter) + pctsrf(:,is_lic)) < 2*EPSFRA)
129          pctsrf(:,is_ter) = 0.
130          pctsrf(:,is_lic) = 0.
131       END WHERE
132
133       WHERE ((pctsrf(:,is_oce) + pctsrf(:,is_sic)) < 2*EPSFRA)
134          pctsrf(:,is_oce) = 0.
135          pctsrf(:,is_sic) = 0.
136       END WHERE
137
138! Normalize to force total fraction to be equal one
139       DO i= 1, klon
140          tmpsum = SUM(pctsrf(i,:))
141          DO nsrf = 1, nbsrf
142             pctsrf(i,nsrf) = pctsrf(i,nsrf) / tmpsum
143          END DO
144       END DO
145
146! Test for too small fractions at each sub-surface
147       WHERE (pctsrf(:,is_ter) < EPSFRA)
148          pctsrf(:,is_lic) = pctsrf(:,is_ter) + pctsrf(:,is_lic)
149          pctsrf(:,is_ter) = 0.
150       END WHERE
151
152       WHERE (pctsrf(:,is_lic) < EPSFRA)
153          pctsrf(:,is_ter) = pctsrf(:,is_ter) + pctsrf(:,is_lic)
154          pctsrf(:,is_lic) = 0.
155       END WHERE
156
157       WHERE (pctsrf(:,is_oce) < EPSFRA)
158          pctsrf(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
159          pctsrf(:,is_oce) = 0.
160       END WHERE
161
162       WHERE (pctsrf(:,is_sic) < EPSFRA)
163          pctsrf(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
164          pctsrf(:,is_sic) = 0.
165       END WHERE
[2209]166! Send fractions back to slab ocean if needed
167       IF (type_ocean == 'slab'.AND. version_ocean.NE.'sicINT') THEN
168           WHERE (1.-zmasq(:)>EPSFRA)
169               fsic(:)=pctsrf(:,is_sic)/(1.-zmasq(:))
170           END WHERE
171       END IF
[996]172
173!****************************************************************************************
174! 3)
175! Initialize variables where a new fraction has appered,
176! i.e. where new sea ice has been formed
177! or where ice free ocean has appread in a grid cell
178!
179!****************************************************************************************
180
[2243]181       CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old,        &
182           evap, z0m, z0h, agesno,                                &
183           tsurf, alb_dir,alb_dif, ustar, u10m, v10m, pbl_tke)
[2227]184
185
[1454]186    ELSE
187       ! No modifcation should be done
188       pctsrf(:,:) = pctsrf_old(:,:)
189
[996]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.