1 |
|
|
MODULE create_etat0_unstruct_mod |
2 |
|
|
|
3 |
|
|
|
4 |
|
|
|
5 |
|
|
|
6 |
|
|
|
7 |
|
|
|
8 |
|
|
CONTAINS |
9 |
|
|
|
10 |
|
|
SUBROUTINE init_create_etat0_unstruct |
11 |
|
|
#ifdef CPP_XIOS |
12 |
|
|
USE xios |
13 |
|
|
USE netcdf |
14 |
|
|
USE mod_phys_lmdz_para |
15 |
|
|
IMPLICIT NONE |
16 |
|
|
INTEGER :: file_id, iret |
17 |
|
|
|
18 |
|
|
! for coupling activate ocean fraction reading from file "ocean_fraction.nc" |
19 |
|
|
IF (is_omp_master) THEN |
20 |
|
|
|
21 |
|
|
IF (NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN |
22 |
|
|
CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.) |
23 |
|
|
CALL xios_set_field_attr("mask",field_ref="frac_ocean_read") |
24 |
|
|
iret=NF90_CLOSE(file_id) |
25 |
|
|
ELSE IF (NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN |
26 |
|
|
CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.) |
27 |
|
|
CALL xios_set_field_attr("mask",field_ref="land_water") |
28 |
|
|
iret=NF90_CLOSE(file_id) |
29 |
|
|
ELSE IF (NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN |
30 |
|
|
CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.) |
31 |
|
|
CALL xios_set_field_attr("mask",field_ref="land_water") |
32 |
|
|
iret=NF90_CLOSE(file_id) |
33 |
|
|
ELSE IF (NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN |
34 |
|
|
CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.) |
35 |
|
|
CALL xios_set_field_attr("mask",field_ref="land_water") |
36 |
|
|
iret=NF90_CLOSE(file_id) |
37 |
|
|
ENDIF |
38 |
|
|
|
39 |
|
|
ENDIF |
40 |
|
|
|
41 |
|
|
#endif |
42 |
|
|
|
43 |
|
|
END SUBROUTINE init_create_etat0_unstruct |
44 |
|
|
|
45 |
|
|
|
46 |
|
|
SUBROUTINE create_etat0_unstruct |
47 |
|
|
USE dimphy |
48 |
|
|
#ifdef CPP_XIOS |
49 |
|
|
USE xios |
50 |
|
|
USE infotrac_phy |
51 |
|
|
USE fonte_neige_mod |
52 |
|
|
USE pbl_surface_mod |
53 |
|
|
USE phys_state_var_mod |
54 |
|
|
USE indice_sol_mod |
55 |
|
|
USE surface_data, ONLY: landice_opt |
56 |
|
|
USE mod_phys_lmdz_para |
57 |
|
|
USE print_control_mod, ONLY: lunout |
58 |
|
|
USE geometry_mod |
59 |
|
|
USE ioipsl_getin_p_mod, ONLY: getin_p |
60 |
|
|
|
61 |
|
|
IMPLICIT NONE |
62 |
|
|
INCLUDE 'dimsoil.h' |
63 |
|
|
|
64 |
|
|
LOGICAL :: no_ter_antartique ! If true, no land points are allowed at Antartic |
65 |
|
|
REAL, DIMENSION(klon) :: tsol |
66 |
|
|
REAL, DIMENSION(klon) :: sn |
67 |
|
|
REAL, DIMENSION(klon) :: rugmer |
68 |
|
|
REAL, DIMENSION(klon) :: run_off_lic_0 |
69 |
|
|
REAL, DIMENSION(klon) :: lic |
70 |
|
|
REAL, DIMENSION(klon) :: fder |
71 |
|
|
|
72 |
|
|
REAL, DIMENSION(klon,nbsrf) :: qsolsrf, snsrf |
73 |
|
|
REAL, DIMENSION(klon,nsoilmx,nbsrf) :: tsoil |
74 |
|
|
|
75 |
|
|
REAL, DIMENSION(klon_mpi) :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi |
76 |
|
|
REAL, DIMENSION(klon_mpi) :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi |
77 |
|
|
REAL, DIMENSION(klon_mpi) :: cell_area_mpi |
78 |
|
|
REAL, DIMENSION(klon_mpi,nbsrf) :: pctsrf_mpi |
79 |
|
|
|
80 |
|
|
INTEGER :: ji,j,i |
81 |
|
|
|
82 |
|
|
IF (is_omp_master) THEN |
83 |
|
|
CALL xios_recv_field("ts",tsol_mpi) |
84 |
|
|
CALL xios_recv_field("qs",qsol_mpi) |
85 |
|
|
CALL xios_recv_field("mask",zmasq_mpi) |
86 |
|
|
IF (landice_opt .LT. 2) CALL xios_recv_field("landice",lic_mpi) |
87 |
|
|
CALL xios_recv_field("zmea",zmea_mpi) |
88 |
|
|
CALL xios_recv_field("zstd",zstd_mpi) |
89 |
|
|
CALL xios_recv_field("zsig",zsig_mpi) |
90 |
|
|
CALL xios_recv_field("zgam",zgam_mpi) |
91 |
|
|
CALL xios_recv_field("zthe",zthe_mpi) |
92 |
|
|
ENDIF |
93 |
|
|
CALL scatter_omp(tsol_mpi,tsol) |
94 |
|
|
CALL scatter_omp(qsol_mpi,qsol) |
95 |
|
|
CALL scatter_omp(zmasq_mpi,zmasq) |
96 |
|
|
IF (landice_opt .LT. 2) CALL scatter_omp(lic_mpi,lic) |
97 |
|
|
CALL scatter_omp(zmea_mpi,zmea) |
98 |
|
|
CALL scatter_omp(zstd_mpi,zstd) |
99 |
|
|
CALL scatter_omp(zsig_mpi,zsig) |
100 |
|
|
CALL scatter_omp(zgam_mpi,zgam) |
101 |
|
|
CALL scatter_omp(zthe_mpi,zthe) |
102 |
|
|
|
103 |
|
|
radsol(:) = 0.0 |
104 |
|
|
rugmer(:) = 0.001 |
105 |
|
|
sn(:) = 0 |
106 |
|
|
|
107 |
|
|
WHERE(qsol(:)<0) qsol(:)=0 |
108 |
|
|
|
109 |
|
|
WHERE( zmasq(:)<EPSFRA) zmasq(:)=0. |
110 |
|
|
WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1. |
111 |
|
|
|
112 |
|
|
pctsrf(:,:) = 0 |
113 |
|
|
IF (landice_opt .LT. 2) THEN |
114 |
|
|
pctsrf(:,is_lic)=lic |
115 |
|
|
WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0. |
116 |
|
|
WHERE(zmasq(:)<EPSFRA) pctsrf(:,is_lic)=0. |
117 |
|
|
|
118 |
|
|
pctsrf(:,is_ter)=zmasq(:) |
119 |
|
|
|
120 |
|
|
!--- Adequation with soil/sea mask |
121 |
|
|
DO ji=1,klon |
122 |
|
|
IF(zmasq(ji)>EPSFRA) THEN |
123 |
|
|
IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN |
124 |
|
|
pctsrf(ji,is_lic)=zmasq(ji) |
125 |
|
|
pctsrf(ji,is_ter)=0. |
126 |
|
|
ELSE |
127 |
|
|
pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic) |
128 |
|
|
IF(pctsrf(ji,is_ter)<EPSFRA) THEN |
129 |
|
|
pctsrf(ji,is_ter)=0. |
130 |
|
|
pctsrf(ji,is_lic)=zmasq(ji) |
131 |
|
|
END IF |
132 |
|
|
END IF |
133 |
|
|
END IF |
134 |
|
|
END DO |
135 |
|
|
|
136 |
|
|
ELSE |
137 |
|
|
! landice_opt=>2 : no land ice |
138 |
|
|
pctsrf(:,is_lic)=0.0 |
139 |
|
|
pctsrf(:,is_ter)=zmasq(:) |
140 |
|
|
END IF |
141 |
|
|
|
142 |
|
|
|
143 |
|
|
|
144 |
|
|
|
145 |
|
|
|
146 |
|
|
!--- Option no_ter_antartique removes all land fractions souther than 60S. |
147 |
|
|
!--- Land ice is set instead of the land fractions on these latitudes. |
148 |
|
|
!--- The ocean and sea-ice fractions are not changed. |
149 |
|
|
no_ter_antartique=.FALSE. |
150 |
|
|
CALL getin_p('no_ter_antartique',no_ter_antartique) |
151 |
|
|
WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique |
152 |
|
|
IF (no_ter_antartique) THEN |
153 |
|
|
! Remove all land fractions souther than 60S and set land-ice instead |
154 |
|
|
WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing" |
155 |
|
|
WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic." |
156 |
|
|
DO ji=1, klon |
157 |
|
|
IF (latitude_deg(ji)<-60.0) THEN |
158 |
|
|
pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter) |
159 |
|
|
pctsrf(ji,is_ter) = 0 |
160 |
|
|
END IF |
161 |
|
|
END DO |
162 |
|
|
END IF |
163 |
|
|
|
164 |
|
|
! sub-surface ocean and sea ice (sea ice set to zero for start) |
165 |
|
|
!******************************************************************************* |
166 |
|
|
pctsrf(:,is_oce)=(1.-zmasq(:)) |
167 |
|
|
WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0. |
168 |
|
|
|
169 |
|
|
zval(:)=max(0.,zmea-2*zstd(:)) |
170 |
|
|
zpic(:)=zmea+2*zstd(:) |
171 |
|
|
|
172 |
|
|
!! WARNING DON'T FORGET FOR LATER |
173 |
|
|
!!ym IF(couple) pctsrf(:,is_oce)=ocemask_fi(:) |
174 |
|
|
!! |
175 |
|
|
|
176 |
|
|
! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs |
177 |
|
|
!******************************************************************************* |
178 |
|
|
DO i=1,nbsrf |
179 |
|
|
ftsol(:,i) = tsol |
180 |
|
|
END DO |
181 |
|
|
|
182 |
|
|
DO i=1,nbsrf |
183 |
|
|
snsrf(:,i) = sn |
184 |
|
|
END DO |
185 |
|
|
!albedo SB >>> |
186 |
|
|
!ym error : the sub surface dimension is the third not second |
187 |
|
|
! falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6 |
188 |
|
|
! falb_dir(:,is_oce,:)=0.5; falb_dir(:,is_sic,:)=0.6 |
189 |
|
|
falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6 |
190 |
|
|
falb_dir(:,:,is_oce)=0.5; falb_dir(:,:,is_sic)=0.6 |
191 |
|
|
|
192 |
|
|
!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ? |
193 |
|
|
!ym probably the uninitialized value was 0 for standard (regular grid) case |
194 |
|
|
falb_dif(:,:,:)=0 |
195 |
|
|
|
196 |
|
|
!albedo SB <<< |
197 |
|
|
fevap(:,:) = 0. |
198 |
|
|
DO i=1,nbsrf |
199 |
|
|
qsolsrf(:,i)=150. |
200 |
|
|
END DO |
201 |
|
|
|
202 |
|
|
DO i=1,nbsrf |
203 |
|
|
DO j=1,nsoilmx |
204 |
|
|
tsoil(:,j,i) = tsol |
205 |
|
|
END DO |
206 |
|
|
END DO |
207 |
|
|
|
208 |
|
|
rain_fall = 0.; snow_fall = 0. |
209 |
|
|
solsw = 165.; sollw = -53. |
210 |
|
|
!ym warning missing init for sollwdown => set to 0 |
211 |
|
|
sollwdown = 0. |
212 |
|
|
|
213 |
|
|
|
214 |
|
|
t_ancien = 273.15 |
215 |
|
|
u_ancien=0 |
216 |
|
|
v_ancien=0 |
217 |
|
|
q_ancien = 0. |
218 |
|
|
agesno = 0. |
219 |
|
|
|
220 |
|
|
z0m(:,is_oce) = rugmer(:) |
221 |
|
|
|
222 |
|
|
z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0) |
223 |
|
|
z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0) |
224 |
|
|
|
225 |
|
|
z0m(:,is_sic) = 0.001 |
226 |
|
|
z0h(:,:)=z0m(:,:) |
227 |
|
|
|
228 |
|
|
fder = 0.0 |
229 |
|
|
clwcon = 0.0 |
230 |
|
|
rnebcon = 0.0 |
231 |
|
|
ratqs = 0.0 |
232 |
|
|
run_off_lic_0 = 0.0 |
233 |
|
|
rugoro = 0.0 |
234 |
|
|
|
235 |
|
|
! Before phyredem calling, surface modules and values to be saved in startphy.nc |
236 |
|
|
! are initialized |
237 |
|
|
!******************************************************************************* |
238 |
|
|
pbl_tke(:,:,:) = 1.e-8 |
239 |
|
|
zmax0(:) = 40. |
240 |
|
|
f0(:) = 1.e-5 |
241 |
|
|
sig1(:,:) = 0. |
242 |
|
|
w01(:,:) = 0. |
243 |
|
|
wake_deltat(:,:) = 0. |
244 |
|
|
wake_deltaq(:,:) = 0. |
245 |
|
|
wake_s(:) = 0. |
246 |
|
|
wake_cstar(:) = 0. |
247 |
|
|
wake_fip(:) = 0. |
248 |
|
|
wake_pe = 0. |
249 |
|
|
fm_therm = 0. |
250 |
|
|
entr_therm = 0. |
251 |
|
|
detr_therm = 0. |
252 |
|
|
ale_bl = 0. |
253 |
|
|
ale_bl_trig =0. |
254 |
|
|
alp_bl =0. |
255 |
|
|
CALL fonte_neige_init(run_off_lic_0) |
256 |
|
|
CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil ) |
257 |
|
|
|
258 |
|
|
CALL gather_omp(cell_area,cell_area_mpi) |
259 |
|
|
CALL gather_omp(pctsrf,pctsrf_mpi) |
260 |
|
|
IF (is_omp_master) THEN |
261 |
|
|
CALL xios_send_field("area_ce0l",cell_area_mpi) |
262 |
|
|
CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce)) |
263 |
|
|
CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic)) |
264 |
|
|
ENDIF |
265 |
|
|
|
266 |
|
|
CALL phyredem( "startphy.nc" ) |
267 |
|
|
|
268 |
|
|
#endif |
269 |
|
|
END SUBROUTINE create_etat0_unstruct |
270 |
|
|
|
271 |
|
|
|
272 |
|
|
END MODULE create_etat0_unstruct_mod |