25 |
use grille_m_m, only: grille_m |
use grille_m_m, only: grille_m |
26 |
use grid_change, only: init_dyn_phy, dyn_phy |
use grid_change, only: init_dyn_phy, dyn_phy |
27 |
use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra, nbsrf |
use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra, nbsrf |
28 |
use iniadvtrac_m, only: iniadvtrac |
use infotrac_init_m, only: infotrac_init |
29 |
use inifilr_m, only: inifilr |
use inifilr_m, only: inifilr |
30 |
use massdair_m, only: massdair |
use massdair_m, only: massdair |
31 |
use netcdf, only: nf90_nowrite |
use netcdf, only: nf90_nowrite |
32 |
use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, nf95_put_var, & |
use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, nf95_put_var, & |
33 |
nf95_inq_varid, nf95_open |
nf95_inq_varid, nf95_open |
34 |
use nr_util, only: pi, assert |
use nr_util, only: pi, assert |
35 |
use phyetat0_m, only: zmasq, phyetat0_new |
use phyetat0_m, only: masque, phyetat0_new |
36 |
use phyredem0_m, only: phyredem0, ncid_restartphy |
use phyredem0_m, only: phyredem0, ncid_restartphy |
37 |
use phyredem_m, only: phyredem |
use phyredem_m, only: phyredem |
38 |
use q_sat_m, only: q_sat |
use q_sat_m, only: q_sat |
84 |
INTEGER iml_lic, jml_lic |
INTEGER iml_lic, jml_lic |
85 |
INTEGER ncid, varid |
INTEGER ncid, varid |
86 |
REAL, ALLOCATABLE:: dlon_lic(:), dlat_lic(:) |
REAL, ALLOCATABLE:: dlon_lic(:), dlat_lic(:) |
87 |
REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice |
REAL, ALLOCATABLE:: landice(:, :) ! fraction land ice |
88 |
REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary |
REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary |
89 |
|
|
90 |
INTEGER l, ji |
INTEGER l, ji |
207 |
jml_lic = size(dlat_lic) |
jml_lic = size(dlat_lic) |
208 |
|
|
209 |
call nf95_inq_varid(ncid, 'landice', varid) |
call nf95_inq_varid(ncid, 'landice', varid) |
210 |
ALLOCATE(fraclic(iml_lic, jml_lic)) |
ALLOCATE(landice(iml_lic, jml_lic)) |
211 |
call nf95_get_var(ncid, varid, fraclic) |
call nf95_get_var(ncid, varid, landice) |
212 |
|
|
213 |
call nf95_close(ncid) |
call nf95_close(ncid) |
214 |
|
|
225 |
dlat_lic = dlat_lic * pi/ 180. |
dlat_lic = dlat_lic * pi/ 180. |
226 |
ENDIF |
ENDIF |
227 |
|
|
228 |
flic_tmp(:iim, :) = grille_m(dlon_lic, dlat_lic, fraclic, rlonv(:iim), & |
flic_tmp(:iim, :) = grille_m(dlon_lic, dlat_lic, landice, rlonv(:iim), & |
229 |
rlatu) |
rlatu) |
230 |
flic_tmp(iim + 1, :) = flic_tmp(1, :) |
flic_tmp(iim + 1, :) = flic_tmp(1, :) |
231 |
|
|
235 |
|
|
236 |
! Ad\'equation avec le maque terre/mer : |
! Ad\'equation avec le maque terre/mer : |
237 |
WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0. |
WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0. |
238 |
WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0. |
WHERE (masque < EPSFRA) pctsrf(:, is_lic) = 0. |
239 |
where (zmasq <= EPSFRA) pctsrf(:, is_ter) = zmasq |
where (masque <= EPSFRA) pctsrf(:, is_ter) = masque |
240 |
where (zmasq > EPSFRA) |
where (masque > EPSFRA) |
241 |
where (pctsrf(:, is_lic) >= zmasq) |
where (pctsrf(:, is_lic) >= masque) |
242 |
pctsrf(:, is_lic) = zmasq |
pctsrf(:, is_lic) = masque |
243 |
pctsrf(:, is_ter) = 0. |
pctsrf(:, is_ter) = 0. |
244 |
elsewhere |
elsewhere |
245 |
pctsrf(:, is_ter) = zmasq - pctsrf(:, is_lic) |
pctsrf(:, is_ter) = masque - pctsrf(:, is_lic) |
246 |
where (pctsrf(:, is_ter) < EPSFRA) |
where (pctsrf(:, is_ter) < EPSFRA) |
247 |
pctsrf(:, is_ter) = 0. |
pctsrf(:, is_ter) = 0. |
248 |
pctsrf(:, is_lic) = zmasq |
pctsrf(:, is_lic) = masque |
249 |
end where |
end where |
250 |
end where |
end where |
251 |
end where |
end where |
252 |
|
|
253 |
! Sous-surface oc\'ean et glace de mer (pour d\'emarrer on met glace |
! Sous-surface oc\'ean et glace de mer (pour d\'emarrer on met glace |
254 |
! de mer \`a 0) : |
! de mer \`a 0) : |
255 |
pctsrf(:, is_oce) = 1. - zmasq |
pctsrf(:, is_oce) = 1. - masque |
256 |
WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0. |
WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0. |
257 |
|
|
258 |
! V\'erification que la somme des sous-surfaces vaut 1 : |
! V\'erification que la somme des sous-surfaces vaut 1 : |
270 |
SUM(aire_2d(:iim, jjm + 1) * masse(:iim, jjm + 1, l)) / apols |
SUM(aire_2d(:iim, jjm + 1) * masse(:iim, jjm + 1, l)) / apols |
271 |
END forall |
END forall |
272 |
|
|
273 |
call iniadvtrac |
call infotrac_init |
274 |
CALL geopot(teta, pk , pks, phis, phi) |
CALL geopot(teta, pk , pks, phis, phi) |
275 |
CALL caldyn0(ucov, vcov, teta, ps, pk, phis, phi) |
CALL caldyn0(ucov, vcov, teta, ps, pk, phis, phi) |
276 |
CALL dynredem0(day_ref, phis) |
CALL dynredem0(day_ref, phis) |