source: LMDZ5/branches/LMDZ5_AR5/libf/phylmd/change_srf_frac_mod.F90

Last change on this file was 1454, checked in by Laurent Fairhead, 14 years ago

Merge of LMDZ5V1.0-dev branch r1453 into LMDZ5 trunk r1434


Fusion entre la version r1453 de la branche de développement LMDZ5V1.0-dev
et le tronc LMDZ5 (r1434)

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