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

Diff of /trunk/dyn3d/limit.f

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 247 by guez, Fri Jan 5 14:45:45 2018 UTC
# Line 9  contains Line 9  contains
9      ! Authors: L. Fairhead, Z. X. Li, P. Le Van      ! Authors: L. Fairhead, Z. X. Li, P. Le Van
10    
11      ! This subroutine creates files containing boundary conditions.      ! This subroutine creates files containing boundary conditions.
12      ! It uses files with climatological data.      ! It uses files with climatological data.  Both grids must be
13      ! Both grids must be regular.      ! 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 26  contains Line 26  contains
26           NF95_PUT_VAR           NF95_PUT_VAR
27      use netcdf, only: NF90_CLOBBER, NF90_FLOAT, NF90_GLOBAL, NF90_NOWRITE, &      use netcdf, only: NF90_CLOBBER, NF90_FLOAT, NF90_GLOBAL, NF90_NOWRITE, &
28           NF90_UNLIMITED           NF90_UNLIMITED
29        use nr_util, only: assert
30      use numer_rec_95, only: spline, splint      use numer_rec_95, only: spline, splint
31      use start_init_orog_m, only: mask      use start_init_orog_m, only: mask
32      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
33    
34      ! Variables local to the procedure:      ! Local:
35    
36      LOGICAL:: extrap = .FALSE.      LOGICAL:: extrap = .FALSE.
37      ! (extrapolation de données, comme pour les SST lorsque le fichier      ! (extrapolation de donn\'ees, comme pour les SST lorsque le fichier
38      ! ne contient pas uniquement des points océaniques)      ! ne contient pas uniquement des points oc\'eaniques)
39    
40      REAL phy_alb(klon, 360)      REAL phy_alb(klon, 360)
41      REAL phy_sst(klon, 360)      REAL phy_sst(klon, 360)
# Line 44  contains Line 45  contains
45    
46      real pctsrf_t(klon, nbsrf, 360) ! composition of the surface      real pctsrf_t(klon, nbsrf, 360) ! composition of the surface
47    
48      ! Pour le champ de départ:      ! Pour le champ de d\'epart:
49      INTEGER imdep, jmdep, lmdep      INTEGER imdep, jmdep, lmdep
50    
51      REAL, ALLOCATABLE:: dlon(:), dlat(:)      REAL, ALLOCATABLE:: dlon(:), dlat(:)
52      REAL, pointer:: dlon_ini(:), dlat_ini(:), timeyear(:)      REAL, ALLOCATABLE:: dlon_ini(:), dlat_ini(:), timeyear(:)
53      REAL, ALLOCATABLE:: champ(:, :)      REAL, ALLOCATABLE:: champ(:, :)
54      REAL, ALLOCATABLE:: work(:, :)      REAL, ALLOCATABLE:: work(:, :)
55    
56      ! Pour le champ interpolé 3D :      ! Pour le champ interpol\'e 3D :
57      REAL, allocatable:: champtime(:, :, :)      REAL, allocatable:: champtime(:, :, :)
58      REAL champan(iim + 1, jjm + 1, 360)      REAL champan(iim + 1, jjm + 1, 360)
59    
# Line 114  contains Line 115  contains
115    
116      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
117    
118      DEALLOCATE(dlon, dlat, champ, dlon_ini, dlat_ini)      DEALLOCATE(dlon, dlat, champ)
119      allocate(yder(lmdep))      allocate(yder(lmdep))
120    
121      ! Interpolate monthly values to daily values, at each horizontal position:      ! Interpolate monthly values to daily values, at each horizontal position:
# Line 128  contains Line 129  contains
129         ENDDO         ENDDO
130      ENDDO      ENDDO
131    
132      deallocate(timeyear, champtime, yder)      deallocate(champtime, yder)
133      champan(iim + 1, :, :) = champan(1, :, :)      champan(iim + 1, :, :) = champan(1, :, :)
134      forall (k = 1:360) phy_rug(:, k) = pack(champan(:, :, k), dyn_phy)      forall (k = 1:360) phy_rug(:, k) = pack(champan(:, :, k), dyn_phy)
135    
# Line 148  contains Line 149  contains
149      call nf95_inq_dimid(ncid, "time", dimid)      call nf95_inq_dimid(ncid, "time", dimid)
150      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)
151      print *, 'lmdep = ', lmdep      print *, 'lmdep = ', lmdep
152      ! Coordonnée temporelle fichiers AMIP pas en jours. Ici on suppose      ! Coordonn\'ee temporelle fichiers AMIP pas en jours. Ici on suppose
153      ! qu'on a 12 mois (de 30 jours).      ! qu'on a 12 mois (de 30 jours).
154      IF (lmdep /= 12) then      IF (lmdep /= 12) then
155         print *, 'Unknown AMIP file: not 12 months?'         print *, 'Unknown AMIP file: not 12 months?'
# Line 167  contains Line 168  contains
168    
169      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
170    
171      DEALLOCATE(dlon, dlat, champ, dlon_ini, dlat_ini)      DEALLOCATE(dlon, dlat, champ)
172      PRINT *, 'Interpolation temporelle'      PRINT *, 'Interpolation temporelle'
173      allocate(yder(lmdep))      allocate(yder(lmdep))
174    
# Line 199  contains Line 200  contains
200         pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter)         pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter)
201         pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic)         pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic)
202         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.)
203         ! 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
204         ! pas dans AMIP         ! pas dans AMIP
205         WHERE (1. - zmasq < EPSFRA)         WHERE (1. - zmasq < EPSFRA)
206            pctsrf_t(:, is_sic, k) = 0.            pctsrf_t(:, is_sic, k) = 0.
# Line 219  contains Line 220  contains
220    
221         DO i = 1, klon         DO i = 1, klon
222            if (pctsrf_t(i, is_oce, k) < 0.) then            if (pctsrf_t(i, is_oce, k) < 0.) then
223               print *, 'Problème sous maille : pctsrf_t(', i, &               print *, 'Bad surface fraction: pctsrf_t(', i, &
224                    ', is_oce, ', k, ') = ', pctsrf_t(i, is_oce, k)                    ', is_oce, ', k, ') = ', pctsrf_t(i, is_oce, k)
225            ENDIF            ENDIF
226            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) &
227                 + 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.) &
228                 > EPSFRA) THEN                 > EPSFRA) THEN
229               print *, 'Problème sous surface :'               print *, 'Bad surface fraction:'
230               print *, "pctsrf_t(", i, ", :, ", k, ") = ", &               print *, "pctsrf_t(", i, ", :, ", k, ") = ", &
231                    pctsrf_t(i, :, k)                    pctsrf_t(i, :, k)
232               print *, "phy_ice(", i, ") = ", phy_ice(i)               print *, "phy_ice(", i, ") = ", phy_ice(i)
# Line 247  contains Line 248  contains
248      call nf95_inq_dimid(ncid, "time", dimid)      call nf95_inq_dimid(ncid, "time", dimid)
249      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)
250      print *, 'lmdep = ', lmdep      print *, 'lmdep = ', lmdep
251      !PM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours      ! Ici on suppose qu'on a 12 mois (de 30 jours).
252      !        Ici on suppose qu'on a 12 mois (de 30 jours).      call assert(lmdep == 12, 'limit: AMIP file does not contain 12 months')
     IF (lmdep /= 12) stop 'Unknown AMIP file: not 12 months?'  
253    
254      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
255      IF(extrap)  THEN      IF (extrap) ALLOCATE(work(imdep, jmdep))
        ALLOCATE(work(imdep, jmdep))  
     ENDIF  
256      ALLOCATE(dlon(imdep), dlat(jmdep))      ALLOCATE(dlon(imdep), dlat(jmdep))
257      call NF95_INQ_VARID(ncid, 'tosbcs', varid)      call NF95_INQ_VARID(ncid, 'tosbcs', varid)
258    
259      DO l = 1, lmdep      DO l = 1, lmdep
260         call NF95_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))         call NF95_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))
261         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
262         IF (extrap) THEN         IF (extrap) &
263            CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)              CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)
        ENDIF  
   
264         CALL inter_barxy(dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
265              champtime(:, :, l))              champtime(:, :, l))
266      ENDDO      ENDDO
267    
268      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
269        DEALLOCATE(dlon, dlat, champ)
     DEALLOCATE(dlon, dlat, champ, dlon_ini, dlat_ini)  
270      allocate(yder(lmdep))      allocate(yder(lmdep))
271    
272      ! interpolation temporelle      ! interpolation temporelle
# Line 289  contains Line 284  contains
284      champan(iim + 1, :, :) = champan(1, :, :)      champan(iim + 1, :, :) = champan(1, :, :)
285    
286      !IM14/03/2002 : SST amipbc greater then 271.38      !IM14/03/2002 : SST amipbc greater then 271.38
287      PRINT *, 'SUB. limit_netcdf.F IM : SST Amipbc >= 271.38 '      PRINT *, 'limit: SST Amipbc >= 271.38 '
288    
289      DO k = 1, 360      DO k = 1, 360
290         DO j = 1, jjm + 1         DO j = 1, jjm + 1
291            DO i = 1, iim            DO i = 1, iim
292               champan(i, j, k) = amax1(champan(i, j, k), 271.38)               champan(i, j, k) = max(champan(i, j, k), 271.38)
293            ENDDO            ENDDO
294              
295            champan(iim + 1, j, k) = champan(1, j, k)            champan(iim + 1, j, k) = champan(1, j, k)
296         ENDDO         ENDDO
297      ENDDO      ENDDO
298        
299      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)
300    
301      PRINT *, "Traitement de l'albedo..."      PRINT *, "Traitement de l'albedo..."
# Line 329  contains Line 327  contains
327    
328      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
329    
     deallocate(dlon_ini, dlat_ini)  
330      allocate(yder(lmdep))      allocate(yder(lmdep))
331    
332      ! interpolation temporelle      ! interpolation temporelle
# Line 342  contains Line 339  contains
339            ENDDO            ENDDO
340         ENDDO         ENDDO
341      ENDDO      ENDDO
     deallocate(timeyear)  
342    
343      champan(iim + 1, :, :) = champan(1, :, :)      champan(iim + 1, :, :) = champan(1, :, :)
344      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.247
  ViewVC Help
Powered by ViewVC 1.1.21