12 |
! It uses files with climatological data. |
! It uses files with climatological data. |
13 |
! Both grids must be regular. |
! Both grids must be regular. |
14 |
|
|
|
use comgeom, only: rlonu, rlatv |
|
15 |
use conf_dat2d_m, only: conf_dat2d |
use conf_dat2d_m, only: conf_dat2d |
16 |
use dimens_m, only: iim, jjm |
use dimens_m, only: iim, jjm |
17 |
use dimphy, only: klon, zmasq |
use dimphy, only: klon, zmasq |
18 |
|
use dynetat0_m, only: rlonu, rlatv |
19 |
use etat0_mod, only: pctsrf |
use etat0_mod, only: pctsrf |
20 |
use grid_change, only: dyn_phy |
use grid_change, only: dyn_phy |
21 |
use indicesol, only: epsfra, nbsrf, is_ter, is_oce, is_lic, is_sic |
use indicesol, only: epsfra, nbsrf, is_ter, is_oce, is_lic, is_sic |
33 |
! Variables local to the procedure: |
! Variables local to the procedure: |
34 |
|
|
35 |
LOGICAL:: extrap = .FALSE. |
LOGICAL:: extrap = .FALSE. |
36 |
! (extrapolation de données, comme pour les SST lorsque le fichier |
! (extrapolation de donn\'ees, comme pour les SST lorsque le fichier |
37 |
! ne contient pas uniquement des points océaniques) |
! ne contient pas uniquement des points oc\'eaniques) |
38 |
|
|
39 |
REAL phy_alb(klon, 360) |
REAL phy_alb(klon, 360) |
40 |
REAL phy_sst(klon, 360) |
REAL phy_sst(klon, 360) |
44 |
|
|
45 |
real pctsrf_t(klon, nbsrf, 360) ! composition of the surface |
real pctsrf_t(klon, nbsrf, 360) ! composition of the surface |
46 |
|
|
47 |
! Pour le champ de départ: |
! Pour le champ de d\'epart: |
48 |
INTEGER imdep, jmdep, lmdep |
INTEGER imdep, jmdep, lmdep |
49 |
|
|
50 |
REAL, ALLOCATABLE:: dlon(:), dlat(:) |
REAL, ALLOCATABLE:: dlon(:), dlat(:) |
51 |
REAL, pointer:: dlon_ini(:), dlat_ini(:), timeyear(:) |
REAL, ALLOCATABLE:: dlon_ini(:), dlat_ini(:), timeyear(:) |
52 |
REAL, ALLOCATABLE:: champ(:, :) |
REAL, ALLOCATABLE:: champ(:, :) |
53 |
REAL, ALLOCATABLE:: work(:, :) |
REAL, ALLOCATABLE:: work(:, :) |
54 |
|
|
55 |
! Pour le champ interpolé 3D : |
! Pour le champ interpol\'e 3D : |
56 |
REAL, allocatable:: champtime(:, :, :) |
REAL, allocatable:: champtime(:, :, :) |
57 |
REAL champan(iim + 1, jjm + 1, 360) |
REAL champan(iim + 1, jjm + 1, 360) |
58 |
|
|
114 |
|
|
115 |
call NF95_CLOSE(ncid) |
call NF95_CLOSE(ncid) |
116 |
|
|
117 |
DEALLOCATE(dlon, dlat, champ, dlon_ini, dlat_ini) |
DEALLOCATE(dlon, dlat, champ) |
118 |
allocate(yder(lmdep)) |
allocate(yder(lmdep)) |
119 |
|
|
120 |
! Interpolate monthly values to daily values, at each horizontal position: |
! Interpolate monthly values to daily values, at each horizontal position: |
128 |
ENDDO |
ENDDO |
129 |
ENDDO |
ENDDO |
130 |
|
|
131 |
deallocate(timeyear, champtime, yder) |
deallocate(champtime, yder) |
132 |
champan(iim + 1, :, :) = champan(1, :, :) |
champan(iim + 1, :, :) = champan(1, :, :) |
133 |
forall (k = 1:360) phy_rug(:, k) = pack(champan(:, :, k), dyn_phy) |
forall (k = 1:360) phy_rug(:, k) = pack(champan(:, :, k), dyn_phy) |
134 |
|
|
148 |
call nf95_inq_dimid(ncid, "time", dimid) |
call nf95_inq_dimid(ncid, "time", dimid) |
149 |
call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep) |
call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep) |
150 |
print *, 'lmdep = ', lmdep |
print *, 'lmdep = ', lmdep |
151 |
! Coordonnée temporelle fichiers AMIP pas en jours. Ici on suppose |
! Coordonn\'ee temporelle fichiers AMIP pas en jours. Ici on suppose |
152 |
! qu'on a 12 mois (de 30 jours). |
! qu'on a 12 mois (de 30 jours). |
153 |
IF (lmdep /= 12) then |
IF (lmdep /= 12) then |
154 |
print *, 'Unknown AMIP file: not 12 months?' |
print *, 'Unknown AMIP file: not 12 months?' |
167 |
|
|
168 |
call NF95_CLOSE(ncid) |
call NF95_CLOSE(ncid) |
169 |
|
|
170 |
DEALLOCATE(dlon, dlat, champ, dlon_ini, dlat_ini) |
DEALLOCATE(dlon, dlat, champ) |
171 |
PRINT *, 'Interpolation temporelle' |
PRINT *, 'Interpolation temporelle' |
172 |
allocate(yder(lmdep)) |
allocate(yder(lmdep)) |
173 |
|
|
199 |
pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter) |
pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter) |
200 |
pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic) |
pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic) |
201 |
pctsrf_t(:, is_sic, k) = max(phy_ice - pctsrf_t(:, is_lic, k), 0.) |
pctsrf_t(:, is_sic, k) = max(phy_ice - pctsrf_t(:, is_lic, k), 0.) |
202 |
! Il y a des cas où il y a de la glace dans landiceref et |
! Il y a des cas o\`u il y a de la glace dans landiceref et |
203 |
! pas dans AMIP |
! pas dans AMIP |
204 |
WHERE (1. - zmasq < EPSFRA) |
WHERE (1. - zmasq < EPSFRA) |
205 |
pctsrf_t(:, is_sic, k) = 0. |
pctsrf_t(:, is_sic, k) = 0. |
219 |
|
|
220 |
DO i = 1, klon |
DO i = 1, klon |
221 |
if (pctsrf_t(i, is_oce, k) < 0.) then |
if (pctsrf_t(i, is_oce, k) < 0.) then |
222 |
print *, 'Problème sous maille : pctsrf_t(', i, & |
print *, 'Bad surface fraction: pctsrf_t(', i, & |
223 |
', is_oce, ', k, ') = ', pctsrf_t(i, is_oce, k) |
', is_oce, ', k, ') = ', pctsrf_t(i, is_oce, k) |
224 |
ENDIF |
ENDIF |
225 |
IF (abs(pctsrf_t(i, is_ter, k) + pctsrf_t(i, is_lic, k) & |
IF (abs(pctsrf_t(i, is_ter, k) + pctsrf_t(i, is_lic, k) & |
226 |
+ pctsrf_t(i, is_oce, k) + pctsrf_t(i, is_sic, k) - 1.) & |
+ pctsrf_t(i, is_oce, k) + pctsrf_t(i, is_sic, k) - 1.) & |
227 |
> EPSFRA) THEN |
> EPSFRA) THEN |
228 |
print *, 'Problème sous surface :' |
print *, 'Bad surface fraction:' |
229 |
print *, "pctsrf_t(", i, ", :, ", k, ") = ", & |
print *, "pctsrf_t(", i, ", :, ", k, ") = ", & |
230 |
pctsrf_t(i, :, k) |
pctsrf_t(i, :, k) |
231 |
print *, "phy_ice(", i, ") = ", phy_ice(i) |
print *, "phy_ice(", i, ") = ", phy_ice(i) |
271 |
|
|
272 |
call NF95_CLOSE(ncid) |
call NF95_CLOSE(ncid) |
273 |
|
|
274 |
DEALLOCATE(dlon, dlat, champ, dlon_ini, dlat_ini) |
DEALLOCATE(dlon, dlat, champ) |
275 |
allocate(yder(lmdep)) |
allocate(yder(lmdep)) |
276 |
|
|
277 |
! interpolation temporelle |
! interpolation temporelle |
329 |
|
|
330 |
call NF95_CLOSE(ncid) |
call NF95_CLOSE(ncid) |
331 |
|
|
|
deallocate(dlon_ini, dlat_ini) |
|
332 |
allocate(yder(lmdep)) |
allocate(yder(lmdep)) |
333 |
|
|
334 |
! interpolation temporelle |
! interpolation temporelle |
341 |
ENDDO |
ENDDO |
342 |
ENDDO |
ENDDO |
343 |
ENDDO |
ENDDO |
|
deallocate(timeyear) |
|
344 |
|
|
345 |
champan(iim + 1, :, :) = champan(1, :, :) |
champan(iim + 1, :, :) = champan(1, :, :) |
346 |
forall (k = 1:360) phy_alb(:, k) = pack(champan(:, :, k), dyn_phy) |
forall (k = 1:360) phy_alb(:, k) = pack(champan(:, :, k), dyn_phy) |