/[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/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    
15        use conf_dat2d_m, only: conf_dat2d
16      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  
17      use dimphy, only: klon, zmasq      use dimphy, only: klon, zmasq
18      use comgeom, only: rlonu, rlatv      use dynetat0_m, 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: NF95_CLOSE, NF95_CREATE, NF95_DEF_DIM, nf95_def_var, &
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, NF95_PUT_ATT, &
26           NF90_GLOBAL, NF90_NOWRITE, NF90_PUT_ATT, NF90_PUT_VAR, &           NF95_PUT_VAR
27        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
31        use start_init_orog_m, only: mask
32        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    
60      ! Pour l'inteprolation verticale :      ! Pour l'inteprolation verticale :
61      REAL, allocatable:: yder(:)      REAL, allocatable:: yder(:)
62    
     INTEGER ierr  
   
63      INTEGER nid, ndim, ntim      INTEGER nid, ndim, ntim
     INTEGER dims(2), debut(2)  
64      INTEGER id_tim      INTEGER id_tim
65      INTEGER id_SST, id_BILS, id_RUG, id_ALB      INTEGER id_SST, id_BILS, id_RUG, id_ALB
66      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
# Line 79  contains Line 77  contains
77      print *, "Call sequence information: limit"      print *, "Call sequence information: limit"
78    
79      print *, "Enter namelist 'limit_nml'."      print *, "Enter namelist 'limit_nml'."
80      read (unit=*, nml=limit_nml)      read(unit=*, nml=limit_nml)
81      write(unit=*, nml=limit_nml)      write(unit_nml, nml=limit_nml)
   
     ! Process rugosity:  
82    
83      PRINT *, 'Processing rugosity...'      PRINT *, 'Processing rugosity...'
84    
85      call NF95_OPEN('Rugos.nc', NF90_NOWRITE, ncid)      call NF95_OPEN('Rugos.nc', NF90_NOWRITE, ncid)
86    
87      ! Read coordinate variables:      ! Read coordinate variables:
# Line 108  contains Line 105  contains
105      ! Read the primary variable day by day and regrid horizontally,      ! Read the primary variable day by day and regrid horizontally,
106      ! result in "champtime":      ! result in "champtime":
107      DO  l = 1, lmdep      DO  l = 1, lmdep
108         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)  
   
109         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
110         CALL inter_barxy(dlon, dlat(:jmdep -1), LOG(champ), rlonu(:iim), &         CALL inter_barxy(dlon, dlat(:jmdep -1), LOG(champ), rlonu(:iim), &
111              rlatv, champtime(:, :, l))              rlatv, champtime(:, :, l))
# Line 120  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:
122      DO j = 1, jjm + 1      DO j = 1, jjm + 1
123         DO i = 1, iim         DO i = 1, iim
124            yder(:) = SPLINE(timeyear, champtime(i, j, :))            yder = SPLINE(timeyear, champtime(i, j, :))
125            DO k = 1, 360            DO k = 1, 360
126               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &
127                    real(k-1))                    real(k-1))
# Line 134  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 152  contains Line 147  contains
147      jmdep = size(dlat_ini)      jmdep = size(dlat_ini)
148    
149      call nf95_inq_dimid(ncid, "time", dimid)      call nf95_inq_dimid(ncid, "time", dimid)
150      call NF95_INQuire_DIMension(ncid, dimid, len=lmdep)      call NF95_INQuire_DIMension(ncid, dimid, nclen=lmdep)
151      print *, 'lmdep = ', lmdep      print *, 'lmdep = ', lmdep
152      ! PM 28/02/2002 : nouvelle coordonnée temporelle, fichiers AMIP      ! Coordonn\'ee temporelle fichiers AMIP pas en jours. Ici on suppose
153      ! pas en jours      ! qu'on a 12 mois (de 30 jours).
154      ! Ici on suppose qu'on a 12 mois (de 30 jours).      IF (lmdep /= 12) then
155      IF (lmdep /= 12) STOP 'Unknown AMIP file: not 12 months?'         print *, 'Unknown AMIP file: not 12 months?'
156           STOP 1
157        end IF
158    
159      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
160      ALLOCATE (dlon(imdep), dlat(jmdep))      ALLOCATE(dlon(imdep), dlat(jmdep))
161      call NF95_INQ_VARID(ncid, 'sicbcs', varid)      call NF95_INQ_VARID(ncid, 'sicbcs', varid)
162      DO l = 1, lmdep      DO l = 1, lmdep
163         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)  
   
164         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
165         CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
166              champtime(:, :, l))              champtime(:, :, l))
167      ENDDO      ENDDO
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    
175      DO j = 1, jjm + 1      DO j = 1, jjm + 1
176         DO i = 1, iim         DO i = 1, iim
177            yder(:) = SPLINE(tmidmonth, champtime(i, j, :))            yder = SPLINE(tmidmonth, champtime(i, j, :))
178            DO k = 1, 360            DO k = 1, 360
179               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &
180                    real(k-1))                    real(k-1))
# Line 195  contains Line 190  contains
190      champan(iim + 1, :, :) = champan(1, :, :)      champan(iim + 1, :, :) = champan(1, :, :)
191    
192      DO k = 1, 360      DO k = 1, 360
193         phy_ice(:) = pack(champan(:, :, k), dyn_phy)         phy_ice = pack(champan(:, :, k), dyn_phy)
194    
195         ! (utilisation de la sous-maille fractionnelle tandis que l'ancien         ! (utilisation de la sous-maille fractionnelle tandis que l'ancien
196         ! codage utilisait l'indicateur du sol (0, 1, 2, 3))         ! codage utilisait l'indicateur du sol (0, 1, 2, 3))
197         ! PB en attendant de mettre fraction de terre         ! PB en attendant de mettre fraction de terre
198         WHERE(phy_ice(:) < EPSFRA) phy_ice(:) = 0.         WHERE (phy_ice < EPSFRA) phy_ice = 0.
199    
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.
207            pctsrf_t(:, is_oce, k) = 0.            pctsrf_t(:, is_oce, k) = 0.
208         elsewhere         elsewhere
209            where (pctsrf_t(:, is_sic, k) >= 1 - zmasq(:))            where (pctsrf_t(:, is_sic, k) >= 1 - zmasq)
210               pctsrf_t(:, is_sic, k) = 1. - zmasq(:)               pctsrf_t(:, is_sic, k) = 1. - zmasq
211               pctsrf_t(:, is_oce, k) = 0.               pctsrf_t(:, is_oce, k) = 0.
212            ELSEwhere            ELSEwhere
213               pctsrf_t(:, is_oce, k) = 1. - zmasq(:) - pctsrf_t(:, is_sic, k)               pctsrf_t(:, is_oce, k) = 1. - zmasq - pctsrf_t(:, is_sic, k)
214               where (pctsrf_t(:, is_oce, k) < EPSFRA)               where (pctsrf_t(:, is_oce, k) < EPSFRA)
215                  pctsrf_t(:, is_oce, k) = 0.                  pctsrf_t(:, is_oce, k) = 0.
216                  pctsrf_t(:, is_sic, k) = 1 - zmasq(:)                  pctsrf_t(:, is_sic, k) = 1 - zmasq
217               end where               end where
218            end where            end where
219         end where         end where
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 251  contains Line 246  contains
246      jmdep = size(dlat_ini)      jmdep = size(dlat_ini)
247    
248      call nf95_inq_dimid(ncid, "time", dimid)      call nf95_inq_dimid(ncid, "time", dimid)
249      call NF95_INQuire_DIMension(ncid, dimid, len=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')
253      IF (lmdep /= 12) stop 'Unknown AMIP file: not 12 months?'  
254        ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
255      ALLOCATE( champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      IF (extrap) ALLOCATE(work(imdep, jmdep))
256      IF( extrap )  THEN      ALLOCATE(dlon(imdep), dlat(jmdep))
        ALLOCATE ( work(imdep, jmdep) )  
     ENDIF  
     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         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)  
   
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)
264         ENDIF         CALL inter_barxy(dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &
265                champtime(:, :, l))
        CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim), rlatv, &  
             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
273      DO j = 1, jjm + 1      DO j = 1, jjm + 1
274         DO i = 1, iim         DO i = 1, iim
275            yder(:) = SPLINE(tmidmonth, champtime(i, j, :))            yder = SPLINE(tmidmonth, champtime(i, j, :))
276            DO k = 1, 360            DO k = 1, 360
277               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(tmidmonth, champtime(i, j, :), yder, &
278                    real(k-1))                    real(k-1))
# Line 297  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      ! Traitement de l'albedo      PRINT *, "Traitement de l'albedo..."
   
     PRINT *, 'Traitement de l albedo'  
302      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)      call NF95_OPEN('Albedo.nc', NF90_NOWRITE, ncid)
303    
304      call nf95_inq_varid(ncid, "longitude", varid)      call nf95_inq_varid(ncid, "longitude", varid)
# Line 325  contains Line 313  contains
313      call nf95_gw_var(ncid, varid, timeyear)      call nf95_gw_var(ncid, varid, timeyear)
314      lmdep = size(timeyear)      lmdep = size(timeyear)
315    
316      ALLOCATE ( champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))      ALLOCATE(champ(imdep, jmdep), champtime(iim, jjm + 1, lmdep))
317      ALLOCATE (   dlon(imdep), dlat(jmdep) )      ALLOCATE(dlon(imdep), dlat(jmdep))
318      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)      call NF95_INQ_VARID(ncid, 'ALBEDO', varid)
319    
320      DO l = 1, lmdep      DO l = 1, lmdep
321         PRINT *, 'Lecture temporelle et int. horizontale ', l, timeyear(l)         PRINT *, "timeyear(", l, ") =", timeyear(l)
322         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)  
   
323         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)         CALL conf_dat2d(dlon_ini, dlat_ini, dlon, dlat, champ)
324         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &         CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), rlatv, &
325              champtime(:, :, l) )              champtime(:, :, l))
326      ENDDO      ENDDO
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
333      DO j = 1, jjm + 1      DO j = 1, jjm + 1
334         DO i = 1, iim         DO i = 1, iim
335            yder(:) = SPLINE(timeyear, champtime(i, j, :))            yder = SPLINE(timeyear, champtime(i, j, :))
336            DO k = 1, 360            DO k = 1, 360
337               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &               champan(i, j, k) = SPLINT(timeyear, champtime(i, j, :), yder, &
338                    real(k-1))                    real(k-1))
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)
# Line 365  contains Line 349  contains
349         ENDDO         ENDDO
350      ENDDO      ENDDO
351    
352      PRINT *, 'Ecriture du fichier limit'      PRINT *, 'Ecriture du fichier limit.nc...'
353    
354      call NF95_CREATE("limit.nc", NF90_CLOBBER, nid)      call NF95_CREATE("limit.nc", NF90_CLOBBER, nid)
355    
356      ierr = NF90_PUT_ATT(nid, NF90_GLOBAL, "title", &      call NF95_PUT_ATT(nid, NF90_GLOBAL, "title", &
357           "Fichier conditions aux limites")           "Fichier conditions aux limites")
358      call NF95_DEF_DIM (nid, "points_physiques", klon, ndim)      call NF95_DEF_DIM(nid, "points_physiques", klon, ndim)
359      call NF95_DEF_DIM (nid, "time", NF90_UNLIMITED, ntim)      call NF95_DEF_DIM(nid, "time", NF90_UNLIMITED, ntim)
360    
361      dims(1) = ndim      call NF95_DEF_VAR(nid, "TEMPS", NF90_FLOAT, ntim, id_tim)
362      dims(2) = ntim      call NF95_PUT_ATT(nid, id_tim, "title", "Jour dans l annee")
363    
364      ierr = NF90_DEF_VAR (nid, "TEMPS", NF90_FLOAT, ntim, id_tim)      call NF95_DEF_VAR(nid, "FOCE", NF90_FLOAT, dimids=(/ndim, ntim/), &
365      ierr = NF90_PUT_ATT (nid, id_tim, "title",  &           varid=id_foce)
366           "Jour dans l annee")      call NF95_PUT_ATT(nid, id_FOCE, "title", "Fraction ocean")
367      ierr = NF90_DEF_VAR (nid, "FOCE", NF90_FLOAT, dims, id_FOCE)  
368      ierr = NF90_PUT_ATT (nid, id_FOCE, "title", &      call NF95_DEF_VAR(nid, "FSIC", NF90_FLOAT, dimids=(/ndim, ntim/), &
369           "Fraction ocean")           varid=id_FSIC)
370        call NF95_PUT_ATT(nid, id_FSIC, "title", "Fraction glace de mer")
371      ierr = NF90_DEF_VAR (nid, "FSIC", NF90_FLOAT, dims, id_FSIC)  
372      ierr = NF90_PUT_ATT (nid, id_FSIC, "title", &      call NF95_DEF_VAR(nid, "FTER", NF90_FLOAT, dimids=(/ndim, ntim/), &
373           "Fraction glace de mer")           varid=id_FTER)
374        call NF95_PUT_ATT(nid, id_FTER, "title", "Fraction terre")
375      ierr = NF90_DEF_VAR (nid, "FTER", NF90_FLOAT, dims, id_FTER)  
376      ierr = NF90_PUT_ATT (nid, id_FTER, "title", &      call NF95_DEF_VAR(nid, "FLIC", NF90_FLOAT, dimids=(/ndim, ntim/), &
377           "Fraction terre")           varid=id_FLIC)
378        call NF95_PUT_ATT(nid, id_FLIC, "title", "Fraction land ice")
379      ierr = NF90_DEF_VAR (nid, "FLIC", NF90_FLOAT, dims, id_FLIC)  
380      ierr = NF90_PUT_ATT (nid, id_FLIC, "title", &      call NF95_DEF_VAR(nid, "SST", NF90_FLOAT, dimids=(/ndim, ntim/), &
381           "Fraction land ice")           varid=id_SST)
382        call NF95_PUT_ATT(nid, id_SST, "title",  &
     ierr = NF90_DEF_VAR (nid, "SST", NF90_FLOAT, dims, id_SST)  
     ierr = NF90_PUT_ATT (nid, id_SST, "title",  &  
383           "Temperature superficielle de la mer")           "Temperature superficielle de la mer")
384      ierr = NF90_DEF_VAR (nid, "BILS", NF90_FLOAT, dims, id_BILS)  
385      ierr = NF90_PUT_ATT (nid, id_BILS, "title", &      call NF95_DEF_VAR(nid, "BILS", NF90_FLOAT, dimids=(/ndim, ntim/), &
386           "Reference flux de chaleur au sol")           varid=id_BILS)
387      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")
388      ierr = NF90_PUT_ATT (nid, id_ALB, "title", &  
389           "Albedo a la surface")      call NF95_DEF_VAR(nid, "ALB", NF90_FLOAT, dimids=(/ndim, ntim/), &
390      ierr = NF90_DEF_VAR (nid, "RUG", NF90_FLOAT, dims, id_RUG)           varid=id_ALB)
391      ierr = NF90_PUT_ATT (nid, id_RUG, "title", &      call NF95_PUT_ATT(nid, id_ALB, "title", "Albedo a la surface")
392           "Rugosite")  
393        call NF95_DEF_VAR(nid, "RUG", NF90_FLOAT, dimids=(/ndim, ntim/), &
394             varid=id_RUG)
395        call NF95_PUT_ATT(nid, id_RUG, "title", "Rugosite")
396    
397      call NF95_ENDDEF(nid)      call NF95_ENDDEF(nid)
398    
399      DO k = 1, 360      DO k = 1, 360
400         debut(1) = 1         call NF95_PUT_VAR(nid, id_tim, REAL(k), (/k/))
401         debut(2) = k         call NF95_PUT_VAR(nid, id_FOCE, pctsrf_t(:, is_oce, k), start=(/1, k/))
402           call NF95_PUT_VAR(nid, id_FSIC, pctsrf_t(:, is_sic, k), start=(/1, k/))
403         ierr = NF90_PUT_VAR(nid, id_tim, FLOAT(k), (/k/))         call NF95_PUT_VAR(nid, id_FTER, pctsrf_t(:, is_ter, k), start=(/1, k/))
404         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/))
405         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/))
406         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/))
407         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/))
408         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)  
409      ENDDO      ENDDO
410    
411      call NF95_CLOSE(nid)      call NF95_CLOSE(nid)
Legend:
Removed from v.25  
changed lines
  Added in v.247
  ViewVC Help
Powered by ViewVC 1.1.21