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

Last change on this file since 2243 was 2243, checked in by fhourdin, 9 years ago

Revisite de la formule des flux de surface
(en priorité sur l'océan) en tenant compte des bourrasques de
vent et de la différence entre les hauteurs de rugosités pour
la quantité de mouvement, l'enthalpie et éventuellement l'humidité.

Etape 2 :

  • Séparation des z0 pour la quantité de mouvement et l'enthalpie.

rugs (ou frugs, rugos, yrugos ...) disparait au profit de z0m, z0h.
Les variables qui étaient à la fois dans pbl_surface_init et

  • dans l'interface de pbl_surface sont suprimées de pbl_surface_init.

On travaille directement pour ces variables (evap, z0, qsol, agesno)
avec les versions de phys_state_var_mod (qui étaient
précédemment dans phys_local_var_mod

  • Nouveaux paramètres de contrôle :
    • iflag_z0_oce (par défaut 0, et seule option active jusque là)
    • z0m_seaice_omp, z0h_seaice_omp, comme leur nom l'indique (utilisées dans surf_landice
    • z0min appliqué sur z0m et z0h dans pbl_surface
  • Introduction des fonction phyeta0_get et phyetat0_srf pour lire

les conditions de initiales dans startphy.
Du coup une seule ligne suffit pour lire et contrôler d'éventuels
problèmes.

  • Pour la variable fxrugs, elle est remplacée par z0m(:,nbsrf+1)

Ce choix déjà utilisé pour d'autres variables pourrait être
systématiser pour alléger l'interface de pbl_surface_mod.

  • Dans les sorties, les variables rugs* ont été remplacées par

des z0m* et z0h*

  • Nettoyage des anciens alb1/alb2 dans les lectures/écritures

des états de redémarrage (et dans pbl_surface_mod.F90).

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