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

Last change on this file since 2186 was 2181, checked in by jyg, 10 years ago

1/ Update of the loop on sub-surfaces in pbl_surface_mod.F90 : all initializations
are removed from the loop and put before the loop.
2/ The possibility of nudging RH, T, u, and v is added in lmdz1d.F90 (and in
1DUTILS.h).

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