source: LMDZ4/trunk/libf/phylmd/change_srf_frac_mod.F90 @ 3710

Last change on this file since 3710 was 996, checked in by lsce, 16 years ago
  • Modifications liées au calcul des nouveau sous-fractions
  • Nettoyage de ocean slab : il reste uniquement la version avec glace de mer forcé
  • Nouveaux variables pour distiguer la version et type d'ocean : type_ocean=force/slab/couple, version_ocean=opa8/nemo pour couplé ou version_ocean=sicOBS pour slab

JG

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