/[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/libf/dyn3d/limit.f90 revision 25 by guez, Fri Mar 5 16:43:45 2010 UTC trunk/dyn3d/limit.f revision 97 by guez, Fri Apr 25 14:58:31 2014 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    
15        use comgeom, only: rlonu, rlatv
16        use conf_dat2d_m, only: conf_dat2d
17      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
     use indicesol, only: epsfra, nbsrf, is_ter, is_oce, is_lic, is_sic  
18      use dimphy, only: klon, zmasq      use dimphy, only: klon, zmasq
     use comgeom, only: rlonu, rlatv  
19      use etat0_mod, only: pctsrf      use etat0_mod, only: pctsrf
     use start_init_orog_m, only: mask  
     use conf_dat2d_m, only: conf_dat2d  
     use inter_barxy_m, only: inter_barxy  
     use numer_rec, only: spline, splint  
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
22      use netcdf95, only: handle_err, nf95_gw_var, NF95_CLOSE, NF95_DEF_DIM, &      use inter_barxy_m, only: inter_barxy
23           nf95_enddef, NF95_CREATE, nf95_inq_dimid, nf95_inquire_dimension, &      use netcdf95, only: handle_err, NF95_CLOSE, NF95_CREATE, NF95_DEF_DIM, &
24           nf95_inq_varid, NF95_OPEN           nf95_enddef, nf95_get_var, nf95_gw_var, nf95_inq_dimid, &
25      use netcdf, only: NF90_CLOBBER, nf90_def_var, NF90_FLOAT, NF90_GET_VAR, &           nf95_inq_varid, nf95_inquire_dimension, NF95_OPEN
26           NF90_GLOBAL, NF90_NOWRITE, NF90_PUT_ATT, NF90_PUT_VAR, &      use netcdf, only: NF90_CLOBBER, nf90_def_var, NF90_FLOAT, NF90_GLOBAL, &
27           NF90_UNLIMITED           NF90_NOWRITE, NF90_PUT_ATT, NF90_PUT_VAR, NF90_UNLIMITED
28        use numer_rec_95, only: spline, splint
29        use start_init_orog_m, only: mask
30        use unit_nml_m, only: unit_nml
31    
32      ! Variables local to the procedure:      ! Variables local to the procedure:
33    
# Line 80  contains Line 79  contains
79    
80      print *, "Enter namelist 'limit_nml'."      print *, "Enter namelist 'limit_nml'."
81      read (unit=*, nml=limit_nml)      read (unit=*, nml=limit_nml)
82      write(unit=*, nml=limit_nml)      write(unit_nml, nml=limit_nml)
   
     ! Process rugosity:  
83    
84      PRINT *, 'Processing rugosity...'      PRINT *, 'Processing rugosity...'
85    
86      call NF95_OPEN('Rugos.nc', NF90_NOWRITE, ncid)      call NF95_OPEN('Rugos.nc', NF90_NOWRITE, ncid)
87    
88      ! Read coordinate variables:      ! Read coordinate variables:
# Line 108  contains Line 106  contains
106      ! Read the primary variable day by day and regrid horizontally,      ! Read the primary variable day by day and regrid horizontally,
107      ! result in "champtime":      ! result in "champtime":
108      DO  l = 1, lmdep      DO  l = 1, lmdep
109         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)  
   
110         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
111         CALL inter_barxy(dlon, dlat(:jmdep -1), LOG(champ), rlonu(:iim), &         CALL inter_barxy(dlon, dlat(:jmdep -1), LOG(champ), rlonu(:iim), &
112              rlatv, champtime(:, :, l))              rlatv, champtime(:, :, l))
# Line 126  contains Line 122  contains
122      ! Interpolate monthly values to daily values, at each horizontal position:      ! Interpolate monthly values to daily values, at each horizontal position:
123      DO j = 1, jjm + 1      DO j = 1, jjm + 1
124         DO i = 1, iim         DO i = 1, iim
125            yder(:) = SPLINE(timeyear, champtime(i, j, :))            yder = SPLINE(timeyear, champtime(i, j, :))
126            DO k = 1, 360            DO k = 1, 360
127               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &
128                    real(k-1))                    real(k-1))
# Line 152  contains Line 148  contains
148      jmdep = size(dlat_ini)      jmdep = size(dlat_ini)
149    
150      call nf95_inq_dimid(ncid, "time", dimid)      call nf95_inq_dimid(ncid, "time", dimid)
151      call NF95_INQuire_DIMension(ncid, dimid, len=lmdep)      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)
152      print *, 'lmdep = ', lmdep      print *, 'lmdep = ', lmdep
153      ! PM 28/02/2002 : nouvelle coordonnée temporelle, fichiers AMIP      ! Coordonnée temporelle fichiers AMIP pas en jours. Ici on suppose
154      ! pas en jours      ! qu'on a 12 mois (de 30 jours).
155      ! Ici on suppose qu'on a 12 mois (de 30 jours).      IF (lmdep /= 12) then
156      IF (lmdep /= 12) STOP 'Unknown AMIP file: not 12 months?'         print *, 'Unknown AMIP file: not 12 months?'
157           STOP 1
158        end IF
159    
160      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
161      ALLOCATE (dlon(imdep), dlat(jmdep))      ALLOCATE (dlon(imdep), dlat(jmdep))
162      call NF95_INQ_VARID(ncid, 'sicbcs', varid)      call NF95_INQ_VARID(ncid, 'sicbcs', varid)
163      DO l = 1, lmdep      DO l = 1, lmdep
164         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)  
   
165         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
166         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
167              champtime(:, :, l))              champtime(:, :, l))
# Line 179  contains Line 175  contains
175    
176      DO j = 1, jjm + 1      DO j = 1, jjm + 1
177         DO i = 1, iim         DO i = 1, iim
178            yder(:) = SPLINE(tmidmonth, champtime(i, j, :))            yder = SPLINE(tmidmonth, champtime(i, j, :))
179            DO k = 1, 360            DO k = 1, 360
180               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &
181                    real(k-1))                    real(k-1))
# Line 195  contains Line 191  contains
191      champan(iim + 1, :, :) = champan(1, :, :)      champan(iim + 1, :, :) = champan(1, :, :)
192    
193      DO k = 1, 360      DO k = 1, 360
194         phy_ice(:) = pack(champan(:, :, k), dyn_phy)         phy_ice = pack(champan(:, :, k), dyn_phy)
195    
196         ! (utilisation de la sous-maille fractionnelle tandis que l'ancien         ! (utilisation de la sous-maille fractionnelle tandis que l'ancien
197         ! codage utilisait l'indicateur du sol (0, 1, 2, 3))         ! codage utilisait l'indicateur du sol (0, 1, 2, 3))
198         ! PB en attendant de mettre fraction de terre         ! PB en attendant de mettre fraction de terre
199         WHERE(phy_ice(:) < EPSFRA) phy_ice(:) = 0.         WHERE (phy_ice < EPSFRA) phy_ice = 0.
200    
201         pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter)         pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter)
202         pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic)         pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic)
203         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.)
204         ! Il y a des cas où il y a de la glace dans landiceref et         ! Il y a des cas où il y a de la glace dans landiceref et
205         ! pas dans AMIP         ! pas dans AMIP
206         WHERE( 1. - zmasq(:) < EPSFRA)         WHERE (1. - zmasq < EPSFRA)
207            pctsrf_t(:, is_sic, k) = 0.            pctsrf_t(:, is_sic, k) = 0.
208            pctsrf_t(:, is_oce, k) = 0.            pctsrf_t(:, is_oce, k) = 0.
209         elsewhere         elsewhere
210            where (pctsrf_t(:, is_sic, k) >= 1 - zmasq(:))            where (pctsrf_t(:, is_sic, k) >= 1 - zmasq)
211               pctsrf_t(:, is_sic, k) = 1. - zmasq(:)               pctsrf_t(:, is_sic, k) = 1. - zmasq
212               pctsrf_t(:, is_oce, k) = 0.               pctsrf_t(:, is_oce, k) = 0.
213            ELSEwhere            ELSEwhere
214               pctsrf_t(:, is_oce, k) = 1. - zmasq(:) - pctsrf_t(:, is_sic, k)               pctsrf_t(:, is_oce, k) = 1. - zmasq - pctsrf_t(:, is_sic, k)
215               where (pctsrf_t(:, is_oce, k) < EPSFRA)               where (pctsrf_t(:, is_oce, k) < EPSFRA)
216                  pctsrf_t(:, is_oce, k) = 0.                  pctsrf_t(:, is_oce, k) = 0.
217                  pctsrf_t(:, is_sic, k) = 1 - zmasq(:)                  pctsrf_t(:, is_sic, k) = 1 - zmasq
218               end where               end where
219            end where            end where
220         end where         end where
# Line 251  contains Line 247  contains
247      jmdep = size(dlat_ini)      jmdep = size(dlat_ini)
248    
249      call nf95_inq_dimid(ncid, "time", dimid)      call nf95_inq_dimid(ncid, "time", dimid)
250      call NF95_INQuire_DIMension(ncid, dimid, len=lmdep)      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)
251      print *, 'lmdep = ', lmdep      print *, 'lmdep = ', lmdep
252      !PM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours      !PM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
253      !        Ici on suppose qu'on a 12 mois (de 30 jours).      !        Ici on suppose qu'on a 12 mois (de 30 jours).
254      IF (lmdep /= 12) stop 'Unknown AMIP file: not 12 months?'      IF (lmdep /= 12) stop 'Unknown AMIP file: not 12 months?'
255    
256      ALLOCATE( champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
257      IF( extrap )  THEN      IF(extrap)  THEN
258         ALLOCATE ( work(imdep, jmdep) )         ALLOCATE (work(imdep, jmdep))
259      ENDIF      ENDIF
260      ALLOCATE(   dlon(imdep), dlat(jmdep) )      ALLOCATE(dlon(imdep), dlat(jmdep))
261      call NF95_INQ_VARID(ncid, 'tosbcs', varid)      call NF95_INQ_VARID(ncid, 'tosbcs', varid)
262    
263      DO l = 1, lmdep      DO l = 1, lmdep
264         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)  
   
265         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
266         IF ( extrap ) THEN         IF (extrap) THEN
267            CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)            CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)
268         ENDIF         ENDIF
269    
270         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
271              champtime(:, :, l) )              champtime(:, :, l))
272      ENDDO      ENDDO
273    
274      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
# Line 285  contains Line 279  contains
279      ! interpolation temporelle      ! interpolation temporelle
280      DO j = 1, jjm + 1      DO j = 1, jjm + 1
281         DO i = 1, iim         DO i = 1, iim
282            yder(:) = SPLINE(tmidmonth, champtime(i, j, :))            yder = SPLINE(tmidmonth, champtime(i, j, :))
283            DO k = 1, 360            DO k = 1, 360
284               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &
285                    real(k-1))                    real(k-1))
# Line 308  contains Line 302  contains
302      ENDDO      ENDDO
303      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)
304    
305      ! Traitement de l'albedo      PRINT *, "Traitement de l'albedo..."
   
     PRINT *, 'Traitement de l albedo'  
306      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)
307    
308      call nf95_inq_varid(ncid, "longitude", varid)      call nf95_inq_varid(ncid, "longitude", varid)
# Line 325  contains Line 317  contains
317      call nf95_gw_var(ncid, varid, timeyear)      call nf95_gw_var(ncid, varid, timeyear)
318      lmdep = size(timeyear)      lmdep = size(timeyear)
319    
320      ALLOCATE ( champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE (champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
321      ALLOCATE (   dlon(imdep), dlat(jmdep) )      ALLOCATE (dlon(imdep), dlat(jmdep))
322      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)
323    
324      DO l = 1, lmdep      DO l = 1, lmdep
325         PRINT *, 'Lecture temporelle et int. horizontale ', l, timeyear(l)         PRINT *, "timeyear(", l, ") =", timeyear(l)
326         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)  
   
327         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
328         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &
329              champtime(:, :, l) )              champtime(:, :, l))
330      ENDDO      ENDDO
331    
332      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
# Line 347  contains Line 337  contains
337      ! interpolation temporelle      ! interpolation temporelle
338      DO j = 1, jjm + 1      DO j = 1, jjm + 1
339         DO i = 1, iim         DO i = 1, iim
340            yder(:) = SPLINE(timeyear, champtime(i, j, :))            yder = SPLINE(timeyear, champtime(i, j, :))
341            DO k = 1, 360            DO k = 1, 360
342               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &
343                    real(k-1))                    real(k-1))
# Line 378  contains Line 368  contains
368      dims(2) = ntim      dims(2) = ntim
369    
370      ierr = NF90_DEF_VAR (nid, "TEMPS", NF90_FLOAT, ntim, id_tim)      ierr = NF90_DEF_VAR (nid, "TEMPS", NF90_FLOAT, ntim, id_tim)
371      ierr = NF90_PUT_ATT (nid, id_tim, "title",  &      ierr = NF90_PUT_ATT (nid, id_tim, "title", "Jour dans l annee")
          "Jour dans l annee")  
372      ierr = NF90_DEF_VAR (nid, "FOCE", NF90_FLOAT, dims, id_FOCE)      ierr = NF90_DEF_VAR (nid, "FOCE", NF90_FLOAT, dims, id_FOCE)
373      ierr = NF90_PUT_ATT (nid, id_FOCE, "title", &      ierr = NF90_PUT_ATT (nid, id_FOCE, "title", "Fraction ocean")
          "Fraction ocean")  
374    
375      ierr = NF90_DEF_VAR (nid, "FSIC", NF90_FLOAT, dims, id_FSIC)      ierr = NF90_DEF_VAR (nid, "FSIC", NF90_FLOAT, dims, id_FSIC)
376      ierr = NF90_PUT_ATT (nid, id_FSIC, "title", &      ierr = NF90_PUT_ATT (nid, id_FSIC, "title", "Fraction glace de mer")
          "Fraction glace de mer")  
377    
378      ierr = NF90_DEF_VAR (nid, "FTER", NF90_FLOAT, dims, id_FTER)      ierr = NF90_DEF_VAR (nid, "FTER", NF90_FLOAT, dims, id_FTER)
379      ierr = NF90_PUT_ATT (nid, id_FTER, "title", &      ierr = NF90_PUT_ATT (nid, id_FTER, "title", "Fraction terre")
          "Fraction terre")  
380    
381      ierr = NF90_DEF_VAR (nid, "FLIC", NF90_FLOAT, dims, id_FLIC)      ierr = NF90_DEF_VAR (nid, "FLIC", NF90_FLOAT, dims, id_FLIC)
382      ierr = NF90_PUT_ATT (nid, id_FLIC, "title", &      ierr = NF90_PUT_ATT (nid, id_FLIC, "title", "Fraction land ice")
          "Fraction land ice")  
383    
384      ierr = NF90_DEF_VAR (nid, "SST", NF90_FLOAT, dims, id_SST)      ierr = NF90_DEF_VAR (nid, "SST", NF90_FLOAT, dims, id_SST)
385      ierr = NF90_PUT_ATT (nid, id_SST, "title",  &      ierr = NF90_PUT_ATT (nid, id_SST, "title",  &
# Line 403  contains Line 388  contains
388      ierr = NF90_PUT_ATT (nid, id_BILS, "title", &      ierr = NF90_PUT_ATT (nid, id_BILS, "title", &
389           "Reference flux de chaleur au sol")           "Reference flux de chaleur au sol")
390      ierr = NF90_DEF_VAR (nid, "ALB", NF90_FLOAT, dims, id_ALB)      ierr = NF90_DEF_VAR (nid, "ALB", NF90_FLOAT, dims, id_ALB)
391      ierr = NF90_PUT_ATT (nid, id_ALB, "title", &      ierr = NF90_PUT_ATT (nid, id_ALB, "title", "Albedo a la surface")
          "Albedo a la surface")  
392      ierr = NF90_DEF_VAR (nid, "RUG", NF90_FLOAT, dims, id_RUG)      ierr = NF90_DEF_VAR (nid, "RUG", NF90_FLOAT, dims, id_RUG)
393      ierr = NF90_PUT_ATT (nid, id_RUG, "title", &      ierr = NF90_PUT_ATT (nid, id_RUG, "title", "Rugosite")
          "Rugosite")  
394    
395      call NF95_ENDDEF(nid)      call NF95_ENDDEF(nid)
396    
# Line 415  contains Line 398  contains
398         debut(1) = 1         debut(1) = 1
399         debut(2) = k         debut(2) = k
400    
401         ierr = NF90_PUT_VAR(nid, id_tim, FLOAT(k), (/k/))         ierr = NF90_PUT_VAR(nid, id_tim, REAL(k), (/k/))
402         ierr = NF90_PUT_VAR(nid, id_FOCE, pctsrf_t(:, is_oce, k), debut)         ierr = NF90_PUT_VAR(nid, id_FOCE, pctsrf_t(:, is_oce, k), debut)
403         ierr = NF90_PUT_VAR (nid, id_FSIC, pctsrf_t(:, is_sic, k), debut)         ierr = NF90_PUT_VAR (nid, id_FSIC, pctsrf_t(:, is_sic, k), debut)
404         ierr = NF90_PUT_VAR (nid, id_FTER, pctsrf_t(:, is_ter, k), debut)         ierr = NF90_PUT_VAR (nid, id_FTER, pctsrf_t(:, is_ter, k), debut)
Legend:
Removed from v.25  
changed lines
  Added in v.97
  ViewVC Help
Powered by ViewVC 1.1.21