/[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

revision 67 by guez, Fri Apr 20 14:58:43 2012 UTC revision 68 by guez, Wed Nov 14 16:59:30 2012 UTC
# Line 82  contains Line 82  contains
82      read (unit=*, nml=limit_nml)      read (unit=*, nml=limit_nml)
83      write(unit_nml, nml=limit_nml)      write(unit_nml, nml=limit_nml)
84    
     ! Process rugosity:  
   
85      PRINT *, 'Processing rugosity...'      PRINT *, 'Processing rugosity...'
86    
87      call NF95_OPEN('Rugos.nc', NF90_NOWRITE, ncid)      call NF95_OPEN('Rugos.nc', NF90_NOWRITE, ncid)
88    
89      ! Read coordinate variables:      ! Read coordinate variables:
# Line 126  contains Line 125  contains
125      ! Interpolate monthly values to daily values, at each horizontal position:      ! Interpolate monthly values to daily values, at each horizontal position:
126      DO j = 1, jjm + 1      DO j = 1, jjm + 1
127         DO i = 1, iim         DO i = 1, iim
128            yder(:) = SPLINE(timeyear, champtime(i, j, :))            yder = SPLINE(timeyear, champtime(i, j, :))
129            DO k = 1, 360            DO k = 1, 360
130               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &
131                    real(k-1))                    real(k-1))
# Line 154  contains Line 153  contains
153      call nf95_inq_dimid(ncid, "time", dimid)      call nf95_inq_dimid(ncid, "time", dimid)
154      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)
155      print *, 'lmdep = ', lmdep      print *, 'lmdep = ', lmdep
156      ! PM 28/02/2002 : nouvelle coordonnée temporelle, fichiers AMIP      ! Coordonnée temporelle fichiers AMIP pas en jours. Ici on suppose
157      ! pas en jours      ! qu'on a 12 mois (de 30 jours).
158      ! Ici on suppose qu'on a 12 mois (de 30 jours).      IF (lmdep /= 12) then
159      IF (lmdep /= 12) STOP 'Unknown AMIP file: not 12 months?'         print *, 'Unknown AMIP file: not 12 months?'
160           STOP 1
161        end IF
162    
163      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
164      ALLOCATE (dlon(imdep), dlat(jmdep))      ALLOCATE (dlon(imdep), dlat(jmdep))
# Line 179  contains Line 180  contains
180    
181      DO j = 1, jjm + 1      DO j = 1, jjm + 1
182         DO i = 1, iim         DO i = 1, iim
183            yder(:) = SPLINE(tmidmonth, champtime(i, j, :))            yder = SPLINE(tmidmonth, champtime(i, j, :))
184            DO k = 1, 360            DO k = 1, 360
185               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &
186                    real(k-1))                    real(k-1))
# Line 195  contains Line 196  contains
196      champan(iim + 1, :, :) = champan(1, :, :)      champan(iim + 1, :, :) = champan(1, :, :)
197    
198      DO k = 1, 360      DO k = 1, 360
199         phy_ice(:) = pack(champan(:, :, k), dyn_phy)         phy_ice = pack(champan(:, :, k), dyn_phy)
200    
201         ! (utilisation de la sous-maille fractionnelle tandis que l'ancien         ! (utilisation de la sous-maille fractionnelle tandis que l'ancien
202         ! codage utilisait l'indicateur du sol (0, 1, 2, 3))         ! codage utilisait l'indicateur du sol (0, 1, 2, 3))
203         ! PB en attendant de mettre fraction de terre         ! PB en attendant de mettre fraction de terre
204         WHERE(phy_ice(:) < EPSFRA) phy_ice(:) = 0.         WHERE (phy_ice < EPSFRA) phy_ice = 0.
205    
206         pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter)         pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter)
207         pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic)         pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic)
208         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.)
209         ! 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
210         ! pas dans AMIP         ! pas dans AMIP
211         WHERE( 1. - zmasq(:) < EPSFRA)         WHERE (1. - zmasq < EPSFRA)
212            pctsrf_t(:, is_sic, k) = 0.            pctsrf_t(:, is_sic, k) = 0.
213            pctsrf_t(:, is_oce, k) = 0.            pctsrf_t(:, is_oce, k) = 0.
214         elsewhere         elsewhere
215            where (pctsrf_t(:, is_sic, k) >= 1 - zmasq(:))            where (pctsrf_t(:, is_sic, k) >= 1 - zmasq)
216               pctsrf_t(:, is_sic, k) = 1. - zmasq(:)               pctsrf_t(:, is_sic, k) = 1. - zmasq
217               pctsrf_t(:, is_oce, k) = 0.               pctsrf_t(:, is_oce, k) = 0.
218            ELSEwhere            ELSEwhere
219               pctsrf_t(:, is_oce, k) = 1. - zmasq(:) - pctsrf_t(:, is_sic, k)               pctsrf_t(:, is_oce, k) = 1. - zmasq - pctsrf_t(:, is_sic, k)
220               where (pctsrf_t(:, is_oce, k) < EPSFRA)               where (pctsrf_t(:, is_oce, k) < EPSFRA)
221                  pctsrf_t(:, is_oce, k) = 0.                  pctsrf_t(:, is_oce, k) = 0.
222                  pctsrf_t(:, is_sic, k) = 1 - zmasq(:)                  pctsrf_t(:, is_sic, k) = 1 - zmasq
223               end where               end where
224            end where            end where
225         end where         end where
# Line 257  contains Line 258  contains
258      !        Ici on suppose qu'on a 12 mois (de 30 jours).      !        Ici on suppose qu'on a 12 mois (de 30 jours).
259      IF (lmdep /= 12) stop 'Unknown AMIP file: not 12 months?'      IF (lmdep /= 12) stop 'Unknown AMIP file: not 12 months?'
260    
261      ALLOCATE( champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
262      IF( extrap )  THEN      IF(extrap)  THEN
263         ALLOCATE ( work(imdep, jmdep) )         ALLOCATE (work(imdep, jmdep))
264      ENDIF      ENDIF
265      ALLOCATE(   dlon(imdep), dlat(jmdep) )      ALLOCATE(dlon(imdep), dlat(jmdep))
266      call NF95_INQ_VARID(ncid, 'tosbcs', varid)      call NF95_INQ_VARID(ncid, 'tosbcs', varid)
267    
268      DO l = 1, lmdep      DO l = 1, lmdep
# Line 269  contains Line 270  contains
270         call handle_err("NF90_GET_VAR", ierr)         call handle_err("NF90_GET_VAR", ierr)
271    
272         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
273         IF ( extrap ) THEN         IF (extrap) THEN
274            CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)            CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work)
275         ENDIF         ENDIF
276    
277         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
278              champtime(:, :, l) )              champtime(:, :, l))
279      ENDDO      ENDDO
280    
281      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
# Line 285  contains Line 286  contains
286      ! interpolation temporelle      ! interpolation temporelle
287      DO j = 1, jjm + 1      DO j = 1, jjm + 1
288         DO i = 1, iim         DO i = 1, iim
289            yder(:) = SPLINE(tmidmonth, champtime(i, j, :))            yder = SPLINE(tmidmonth, champtime(i, j, :))
290            DO k = 1, 360            DO k = 1, 360
291               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &
292                    real(k-1))                    real(k-1))
# Line 308  contains Line 309  contains
309      ENDDO      ENDDO
310      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)      forall (k = 1:360) phy_sst(:, k) = pack(champan(:, :, k), dyn_phy)
311    
     ! Traitement de l'albedo  
   
312      PRINT *, 'Traitement de l albedo'      PRINT *, 'Traitement de l albedo'
313      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)
314    
# Line 325  contains Line 324  contains
324      call nf95_gw_var(ncid, varid, timeyear)      call nf95_gw_var(ncid, varid, timeyear)
325      lmdep = size(timeyear)      lmdep = size(timeyear)
326    
327      ALLOCATE ( champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE (champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
328      ALLOCATE (   dlon(imdep), dlat(jmdep) )      ALLOCATE (dlon(imdep), dlat(jmdep))
329      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)
330    
331      DO l = 1, lmdep      DO l = 1, lmdep
# Line 336  contains Line 335  contains
335    
336         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
337         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &
338              champtime(:, :, l) )              champtime(:, :, l))
339      ENDDO      ENDDO
340    
341      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
# Line 347  contains Line 346  contains
346      ! interpolation temporelle      ! interpolation temporelle
347      DO j = 1, jjm + 1      DO j = 1, jjm + 1
348         DO i = 1, iim         DO i = 1, iim
349            yder(:) = SPLINE(timeyear, champtime(i, j, :))            yder = SPLINE(timeyear, champtime(i, j, :))
350            DO k = 1, 360            DO k = 1, 360
351               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &
352                    real(k-1))                    real(k-1))
# Line 378  contains Line 377  contains
377      dims(2) = ntim      dims(2) = ntim
378    
379      ierr = NF90_DEF_VAR (nid, "TEMPS", NF90_FLOAT, ntim, id_tim)      ierr = NF90_DEF_VAR (nid, "TEMPS", NF90_FLOAT, ntim, id_tim)
380      ierr = NF90_PUT_ATT (nid, id_tim, "title",  &      ierr = NF90_PUT_ATT (nid, id_tim, "title", "Jour dans l annee")
          "Jour dans l annee")  
381      ierr = NF90_DEF_VAR (nid, "FOCE", NF90_FLOAT, dims, id_FOCE)      ierr = NF90_DEF_VAR (nid, "FOCE", NF90_FLOAT, dims, id_FOCE)
382      ierr = NF90_PUT_ATT (nid, id_FOCE, "title", &      ierr = NF90_PUT_ATT (nid, id_FOCE, "title", "Fraction ocean")
          "Fraction ocean")  
383    
384      ierr = NF90_DEF_VAR (nid, "FSIC", NF90_FLOAT, dims, id_FSIC)      ierr = NF90_DEF_VAR (nid, "FSIC", NF90_FLOAT, dims, id_FSIC)
385      ierr = NF90_PUT_ATT (nid, id_FSIC, "title", &      ierr = NF90_PUT_ATT (nid, id_FSIC, "title", "Fraction glace de mer")
          "Fraction glace de mer")  
386    
387      ierr = NF90_DEF_VAR (nid, "FTER", NF90_FLOAT, dims, id_FTER)      ierr = NF90_DEF_VAR (nid, "FTER", NF90_FLOAT, dims, id_FTER)
388      ierr = NF90_PUT_ATT (nid, id_FTER, "title", &      ierr = NF90_PUT_ATT (nid, id_FTER, "title", "Fraction terre")
          "Fraction terre")  
389    
390      ierr = NF90_DEF_VAR (nid, "FLIC", NF90_FLOAT, dims, id_FLIC)      ierr = NF90_DEF_VAR (nid, "FLIC", NF90_FLOAT, dims, id_FLIC)
391      ierr = NF90_PUT_ATT (nid, id_FLIC, "title", &      ierr = NF90_PUT_ATT (nid, id_FLIC, "title", "Fraction land ice")
          "Fraction land ice")  
392    
393      ierr = NF90_DEF_VAR (nid, "SST", NF90_FLOAT, dims, id_SST)      ierr = NF90_DEF_VAR (nid, "SST", NF90_FLOAT, dims, id_SST)
394      ierr = NF90_PUT_ATT (nid, id_SST, "title",  &      ierr = NF90_PUT_ATT (nid, id_SST, "title",  &
# Line 403  contains Line 397  contains
397      ierr = NF90_PUT_ATT (nid, id_BILS, "title", &      ierr = NF90_PUT_ATT (nid, id_BILS, "title", &
398           "Reference flux de chaleur au sol")           "Reference flux de chaleur au sol")
399      ierr = NF90_DEF_VAR (nid, "ALB", NF90_FLOAT, dims, id_ALB)      ierr = NF90_DEF_VAR (nid, "ALB", NF90_FLOAT, dims, id_ALB)
400      ierr = NF90_PUT_ATT (nid, id_ALB, "title", &      ierr = NF90_PUT_ATT (nid, id_ALB, "title", "Albedo a la surface")
          "Albedo a la surface")  
401      ierr = NF90_DEF_VAR (nid, "RUG", NF90_FLOAT, dims, id_RUG)      ierr = NF90_DEF_VAR (nid, "RUG", NF90_FLOAT, dims, id_RUG)
402      ierr = NF90_PUT_ATT (nid, id_RUG, "title", &      ierr = NF90_PUT_ATT (nid, id_RUG, "title", "Rugosite")
          "Rugosite")  
403    
404      call NF95_ENDDEF(nid)      call NF95_ENDDEF(nid)
405    
# Line 415  contains Line 407  contains
407         debut(1) = 1         debut(1) = 1
408         debut(2) = k         debut(2) = k
409    
410         ierr = NF90_PUT_VAR(nid, id_tim, FLOAT(k), (/k/))         ierr = NF90_PUT_VAR(nid, id_tim, REAL(k), (/k/))
411         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)
412         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)
413         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.67  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.21