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

Diff of /trunk/Sources/dyn3d/limit.f

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

trunk/dyn3d/limit.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/Sources/dyn3d/limit.f revision 139 by guez, Tue May 26 17:46:03 2015 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
22      use inter_barxy_m, only: inter_barxy      use inter_barxy_m, only: inter_barxy
23      use netcdf95, only: handle_err, nf95_gw_var, NF95_CLOSE, NF95_DEF_DIM, &      use netcdf95, only: NF95_CLOSE, NF95_CREATE, NF95_DEF_DIM, nf95_def_var, &
24           nf95_enddef, NF95_CREATE, nf95_inq_dimid, nf95_inquire_dimension, &           nf95_enddef, nf95_get_var, nf95_gw_var, nf95_inq_dimid, &
25           nf95_inq_varid, NF95_OPEN           nf95_inq_varid, nf95_inquire_dimension, NF95_OPEN, NF95_PUT_ATT, &
26      use netcdf, only: NF90_CLOBBER, nf90_def_var, NF90_FLOAT, NF90_GET_VAR, &           NF95_PUT_VAR
27           NF90_GLOBAL, NF90_NOWRITE, NF90_PUT_ATT, NF90_PUT_VAR, &      use netcdf, only: NF90_CLOBBER, NF90_FLOAT, NF90_GLOBAL, NF90_NOWRITE, &
28           NF90_UNLIMITED           NF90_UNLIMITED
29      use numer_rec_95, only: spline, splint      use numer_rec_95, only: spline, splint
30      use start_init_orog_m, only: mask      use start_init_orog_m, only: mask
# 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(:)
# Line 52  contains Line 52  contains
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    
59      ! Pour l'inteprolation verticale :      ! Pour l'inteprolation verticale :
60      REAL, allocatable:: yder(:)      REAL, allocatable:: yder(:)
61    
     INTEGER ierr  
   
62      INTEGER nid, ndim, ntim      INTEGER nid, ndim, ntim
     INTEGER dims(2), debut(2)  
63      INTEGER id_tim      INTEGER id_tim
64      INTEGER id_SST, id_BILS, id_RUG, id_ALB      INTEGER id_SST, id_BILS, id_RUG, id_ALB
65      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
# Line 79  contains Line 76  contains
76      print *, "Call sequence information: limit"      print *, "Call sequence information: limit"
77    
78      print *, "Enter namelist 'limit_nml'."      print *, "Enter namelist 'limit_nml'."
79      read (unit=*, nml=limit_nml)      read(unit=*, nml=limit_nml)
80      write(unit_nml, nml=limit_nml)      write(unit_nml, nml=limit_nml)
81    
82      PRINT *, 'Processing rugosity...'      PRINT *, 'Processing rugosity...'
# Line 107  contains Line 104  contains
104      ! Read the primary variable day by day and regrid horizontally,      ! Read the primary variable day by day and regrid horizontally,
105      ! result in "champtime":      ! result in "champtime":
106      DO  l = 1, lmdep      DO  l = 1, lmdep
107         ierr = NF90_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))         call NF95_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))
        call handle_err("NF90_GET_VAR", ierr)  
   
108         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
109         CALL inter_barxy(dlon, dlat(:jmdep -1), LOG(champ), rlonu(:iim), &         CALL inter_barxy(dlon, dlat(:jmdep -1), LOG(champ), rlonu(:iim), &
110              rlatv, champtime(:, :, l))              rlatv, champtime(:, :, l))
# Line 153  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 161  contains Line 156  contains
156      end IF      end IF
157    
158      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
159      ALLOCATE (dlon(imdep), dlat(jmdep))      ALLOCATE(dlon(imdep), dlat(jmdep))
160      call NF95_INQ_VARID(ncid, 'sicbcs', varid)      call NF95_INQ_VARID(ncid, 'sicbcs', varid)
161      DO l = 1, lmdep      DO l = 1, lmdep
162         ierr = NF90_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))         call NF95_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))
        call handle_err("NF90_GET_VAR", ierr)  
   
163         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
164         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
165              champtime(:, :, l))              champtime(:, :, l))
166      ENDDO      ENDDO
167    
# Line 206  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 226  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 260  contains Line 253  contains
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)  THEN
256         ALLOCATE (work(imdep, jmdep))         ALLOCATE(work(imdep, jmdep))
257      ENDIF      ENDIF
258      ALLOCATE(dlon(imdep), dlat(jmdep))      ALLOCATE(dlon(imdep), dlat(jmdep))
259      call NF95_INQ_VARID(ncid, 'tosbcs', varid)      call NF95_INQ_VARID(ncid, 'tosbcs', varid)
260    
261      DO l = 1, lmdep      DO l = 1, lmdep
262         ierr = NF90_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))         call NF95_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))
        call handle_err("NF90_GET_VAR", ierr)  
   
263         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
264         IF (extrap) THEN         IF (extrap) THEN
265            CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)            CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)
266         ENDIF         ENDIF
267    
268         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
269              champtime(:, :, l))              champtime(:, :, l))
270      ENDDO      ENDDO
271    
# Line 309  contains Line 300  contains
300      ENDDO      ENDDO
301      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)
302    
303      PRINT *, 'Traitement de l albedo'      PRINT *, "Traitement de l'albedo..."
304      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)
305    
306      call nf95_inq_varid(ncid, "longitude", varid)      call nf95_inq_varid(ncid, "longitude", varid)
# Line 324  contains Line 315  contains
315      call nf95_gw_var(ncid, varid, timeyear)      call nf95_gw_var(ncid, varid, timeyear)
316      lmdep = size(timeyear)      lmdep = size(timeyear)
317    
318      ALLOCATE (champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
319      ALLOCATE (dlon(imdep), dlat(jmdep))      ALLOCATE(dlon(imdep), dlat(jmdep))
320      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)
321    
322      DO l = 1, lmdep      DO l = 1, lmdep
323         PRINT *, 'Lecture temporelle et int. horizontale ', l, timeyear(l)         PRINT *, "timeyear(", l, ") =", timeyear(l)
324         ierr = NF90_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))         call NF95_GET_VAR(ncid, varid, champ, start=(/1, 1, l/))
        call handle_err("NF90_GET_VAR", ierr)  
   
325         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
326         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &
327              champtime(:, :, l))              champtime(:, :, l))
# Line 364  contains Line 353  contains
353         ENDDO         ENDDO
354      ENDDO      ENDDO
355    
356      PRINT *, 'Ecriture du fichier limit'      PRINT *, 'Ecriture du fichier limit.nc...'
357    
358      call NF95_CREATE("limit.nc", NF90_CLOBBER, nid)      call NF95_CREATE("limit.nc", NF90_CLOBBER, nid)
359    
360      ierr = NF90_PUT_ATT(nid, NF90_GLOBAL, "title", &      call NF95_PUT_ATT(nid, NF90_GLOBAL, "title", &
361           "Fichier conditions aux limites")           "Fichier conditions aux limites")
362      call NF95_DEF_DIM (nid, "points_physiques", klon, ndim)      call NF95_DEF_DIM(nid, "points_physiques", klon, ndim)
363      call NF95_DEF_DIM (nid, "time", NF90_UNLIMITED, ntim)      call NF95_DEF_DIM(nid, "time", NF90_UNLIMITED, ntim)
   
     dims(1) = ndim  
     dims(2) = ntim  
   
     ierr = NF90_DEF_VAR (nid, "TEMPS", NF90_FLOAT, ntim, id_tim)  
     ierr = NF90_PUT_ATT (nid, id_tim, "title", "Jour dans l annee")  
     ierr = NF90_DEF_VAR (nid, "FOCE", NF90_FLOAT, dims, id_FOCE)  
     ierr = NF90_PUT_ATT (nid, id_FOCE, "title", "Fraction ocean")  
   
     ierr = NF90_DEF_VAR (nid, "FSIC", NF90_FLOAT, dims, id_FSIC)  
     ierr = NF90_PUT_ATT (nid, id_FSIC, "title", "Fraction glace de mer")  
364    
365      ierr = NF90_DEF_VAR (nid, "FTER", NF90_FLOAT, dims, id_FTER)      call NF95_DEF_VAR(nid, "TEMPS", NF90_FLOAT, ntim, id_tim)
366      ierr = NF90_PUT_ATT (nid, id_FTER, "title", "Fraction terre")      call NF95_PUT_ATT(nid, id_tim, "title", "Jour dans l annee")
367    
368      ierr = NF90_DEF_VAR (nid, "FLIC", NF90_FLOAT, dims, id_FLIC)      call NF95_DEF_VAR(nid, "FOCE", NF90_FLOAT, dimids=(/ndim, ntim/), &
369      ierr = NF90_PUT_ATT (nid, id_FLIC, "title", "Fraction land ice")           varid=id_foce)
370        call NF95_PUT_ATT(nid, id_FOCE, "title", "Fraction ocean")
371      ierr = NF90_DEF_VAR (nid, "SST", NF90_FLOAT, dims, id_SST)  
372      ierr = NF90_PUT_ATT (nid, id_SST, "title",  &      call NF95_DEF_VAR(nid, "FSIC", NF90_FLOAT, dimids=(/ndim, ntim/), &
373             varid=id_FSIC)
374        call NF95_PUT_ATT(nid, id_FSIC, "title", "Fraction glace de mer")
375    
376        call NF95_DEF_VAR(nid, "FTER", NF90_FLOAT, dimids=(/ndim, ntim/), &
377             varid=id_FTER)
378        call NF95_PUT_ATT(nid, id_FTER, "title", "Fraction terre")
379    
380        call NF95_DEF_VAR(nid, "FLIC", NF90_FLOAT, dimids=(/ndim, ntim/), &
381             varid=id_FLIC)
382        call NF95_PUT_ATT(nid, id_FLIC, "title", "Fraction land ice")
383    
384        call NF95_DEF_VAR(nid, "SST", NF90_FLOAT, dimids=(/ndim, ntim/), &
385             varid=id_SST)
386        call NF95_PUT_ATT(nid, id_SST, "title",  &
387           "Temperature superficielle de la mer")           "Temperature superficielle de la mer")
388      ierr = NF90_DEF_VAR (nid, "BILS", NF90_FLOAT, dims, id_BILS)  
389      ierr = NF90_PUT_ATT (nid, id_BILS, "title", &      call NF95_DEF_VAR(nid, "BILS", NF90_FLOAT, dimids=(/ndim, ntim/), &
390           "Reference flux de chaleur au sol")           varid=id_BILS)
391      ierr = NF90_DEF_VAR (nid, "ALB", NF90_FLOAT, dims, id_ALB)      call NF95_PUT_ATT(nid, id_BILS, "title", "Reference flux de chaleur au sol")
392      ierr = NF90_PUT_ATT (nid, id_ALB, "title", "Albedo a la surface")  
393      ierr = NF90_DEF_VAR (nid, "RUG", NF90_FLOAT, dims, id_RUG)      call NF95_DEF_VAR(nid, "ALB", NF90_FLOAT, dimids=(/ndim, ntim/), &
394      ierr = NF90_PUT_ATT (nid, id_RUG, "title", "Rugosite")           varid=id_ALB)
395        call NF95_PUT_ATT(nid, id_ALB, "title", "Albedo a la surface")
396    
397        call NF95_DEF_VAR(nid, "RUG", NF90_FLOAT, dimids=(/ndim, ntim/), &
398             varid=id_RUG)
399        call NF95_PUT_ATT(nid, id_RUG, "title", "Rugosite")
400    
401      call NF95_ENDDEF(nid)      call NF95_ENDDEF(nid)
402    
403      DO k = 1, 360      DO k = 1, 360
404         debut(1) = 1         call NF95_PUT_VAR(nid, id_tim, REAL(k), (/k/))
405         debut(2) = k         call NF95_PUT_VAR(nid, id_FOCE, pctsrf_t(:, is_oce, k), start=(/1, k/))
406           call NF95_PUT_VAR(nid, id_FSIC, pctsrf_t(:, is_sic, k), start=(/1, k/))
407         ierr = NF90_PUT_VAR(nid, id_tim, REAL(k), (/k/))         call NF95_PUT_VAR(nid, id_FTER, pctsrf_t(:, is_ter, k), start=(/1, k/))
408         ierr = NF90_PUT_VAR(nid, id_FOCE, pctsrf_t(:, is_oce, k), debut)         call NF95_PUT_VAR(nid, id_FLIC, pctsrf_t(:, is_lic, k), start=(/1, k/))
409         ierr = NF90_PUT_VAR (nid, id_FSIC, pctsrf_t(:, is_sic, k), debut)         call NF95_PUT_VAR(nid, id_SST, phy_sst(:, k), start=(/1, k/))
410         ierr = NF90_PUT_VAR (nid, id_FTER, pctsrf_t(:, is_ter, k), debut)         call NF95_PUT_VAR(nid, id_BILS, phy_bil(:, k), start=(/1, k/))
411         ierr = NF90_PUT_VAR (nid, id_FLIC, pctsrf_t(:, is_lic, k), debut)         call NF95_PUT_VAR(nid, id_ALB, phy_alb(:, k), start=(/1, k/))
412         ierr = NF90_PUT_VAR (nid, id_SST, phy_sst(:, k), debut)         call NF95_PUT_VAR(nid, id_RUG, phy_rug(:, k), start=(/1, k/))
        ierr = NF90_PUT_VAR (nid, id_BILS, phy_bil(:, k), debut)  
        ierr = NF90_PUT_VAR (nid, id_ALB, phy_alb(:, k), debut)  
        ierr = NF90_PUT_VAR (nid, id_RUG, phy_rug(:, k), debut)  
413      ENDDO      ENDDO
414    
415      call NF95_CLOSE(nid)      call NF95_CLOSE(nid)
Legend:
Removed from v.76  
changed lines
  Added in v.139
  ViewVC Help
Powered by ViewVC 1.1.21