source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/change_srf_frac_mod.F90 @ 2404

Last change on this file since 2404 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • 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.0 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    REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: pbl_tke
52
53! Loccal variables
54!****************************************************************************************
55    INTEGER                        :: i, nsrf
56    LOGICAL                        :: is_modified   ! true if pctsrf is modified at this time step
57    LOGICAL                        :: test_sum=.FALSE.
58    LOGICAL, DIMENSION(klon,nbsrf) :: new_surf
59    REAL, DIMENSION(klon,nbsrf)    :: pctsrf_old    ! fraction from previous time-step
60    REAL                           :: tmpsum
61
62    pctsrf_old(:,:) = pctsrf(:,:)
63!****************************************************************************************
64! 1)
65! For each type of ocean (force, slab, couple) receive new fractions only if it's time 
66! to modify (is_modified=true). Otherwise nothing is done (is_modified=false).   
67!****************************************************************************************
68    SELECT CASE (type_ocean)
69    CASE ('force')
70       ! Read fraction from limit.nc
71       CALL limit_read_frac(itime, dtime, jour, pctsrf, is_modified)
72    CASE ('slab')
73       ! Get fraction from slab module
74       CALL ocean_slab_frac(itime, dtime, jour, pctsrf, is_modified)
75    CASE ('couple')
76       ! Get fraction from the coupler
77       CALL cpl_receive_frac(itime, dtime, pctsrf, is_modified)
78    END SELECT
79
80
81!****************************************************************************************
82! 2)
83! Tests and ajustements on the new fractions :
84! - Put to zero fractions that are too small
85! - Test total fraction sum is one for each grid point
86!
87!****************************************************************************************
88    IF (is_modified) THEN
89 
90! Test and exit if a fraction is negative
91       IF (MINVAL(pctsrf(:,:)) < 0.) THEN
92          WRITE(lunout,*)'Warning! One or several fractions are negative, itime=',itime
93          WRITE(lunout,*)'at point = ',MINLOC(pctsrf(:,:))
94          WRITE(lunout,*)'value = ',MINVAL(pctsrf(:,:))
95          CALL abort_gcm('change_srf_frac','Negative fraction',1)
96       END IF
97
98! Optional test on the incoming fraction
99       IF (test_sum) THEN
100          DO i= 1, klon
101             tmpsum = SUM(pctsrf(i,:))
102             IF (ABS(1. - tmpsum) > 0.05) CALL abort_gcm('change_srf_frac','Total fraction not equal 1.',1)
103          END DO
104       END IF
105
106! Test for too small fractions of the sum land+landice and ocean+sea-ice
107       WHERE ((pctsrf(:,is_ter) + pctsrf(:,is_lic)) < 2*EPSFRA)
108          pctsrf(:,is_ter) = 0.
109          pctsrf(:,is_lic) = 0.
110       END WHERE
111
112       WHERE ((pctsrf(:,is_oce) + pctsrf(:,is_sic)) < 2*EPSFRA)
113          pctsrf(:,is_oce) = 0.
114          pctsrf(:,is_sic) = 0.
115       END WHERE
116
117! Normalize to force total fraction to be equal one
118       DO i= 1, klon
119          tmpsum = SUM(pctsrf(i,:))
120          DO nsrf = 1, nbsrf
121             pctsrf(i,nsrf) = pctsrf(i,nsrf) / tmpsum
122          END DO
123       END DO
124
125! Test for too small fractions at each sub-surface
126       WHERE (pctsrf(:,is_ter) < EPSFRA)
127          pctsrf(:,is_lic) = pctsrf(:,is_ter) + pctsrf(:,is_lic)
128          pctsrf(:,is_ter) = 0.
129       END WHERE
130
131       WHERE (pctsrf(:,is_lic) < EPSFRA)
132          pctsrf(:,is_ter) = pctsrf(:,is_ter) + pctsrf(:,is_lic)
133          pctsrf(:,is_lic) = 0.
134       END WHERE
135
136       WHERE (pctsrf(:,is_oce) < EPSFRA)
137          pctsrf(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
138          pctsrf(:,is_oce) = 0.
139       END WHERE
140
141       WHERE (pctsrf(:,is_sic) < EPSFRA)
142          pctsrf(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
143          pctsrf(:,is_sic) = 0.
144       END WHERE
145
146!****************************************************************************************
147! 3)
148! Initialize variables where a new fraction has appered,
149! i.e. where new sea ice has been formed
150! or where ice free ocean has appread in a grid cell
151!
152!****************************************************************************************
153       CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, pbl_tke)
154
155    ELSE
156       ! No modifcation should be done
157       pctsrf(:,:) = pctsrf_old(:,:)
158
159    END IF ! is_modified
160
161  END SUBROUTINE change_srf_frac
162
163
164END MODULE change_srf_frac_mod
Note: See TracBrowser for help on using the repository browser.