/[lmdze]/trunk/dyn3d/limit.f90
ViewVC logotype

Diff of /trunk/dyn3d/limit.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/dyn3d/limit.f revision 98 by guez, Tue May 13 17:23:16 2014 UTC trunk/Sources/dyn3d/limit.f revision 225 by guez, Mon Oct 16 12:35:41 2017 UTC
# Line 12  contains Line 12  contains
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
# Line 33  contains Line 33  contains
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)
# Line 44  contains Line 44  contains
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    
# Line 114  contains Line 114  contains
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:
# Line 128  contains Line 128  contains
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    
# Line 148  contains Line 148  contains
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?'
# Line 167  contains Line 167  contains
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    
# Line 199  contains Line 199  contains
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.
# Line 219  contains Line 219  contains
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)
# Line 271  contains Line 271  contains
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
# Line 329  contains Line 329  contains
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
# Line 342  contains Line 341  contains
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)
Legend:
Removed from v.98  
changed lines
  Added in v.225
  ViewVC Help
Powered by ViewVC 1.1.21