/[lmdze]/trunk/phylmd/phyredem.f
ViewVC logotype

Diff of /trunk/phylmd/phyredem.f

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

revision 13 by guez, Fri Jul 25 19:59:34 2008 UTC revision 72 by guez, Tue Jul 23 13:00:07 2013 UTC
# Line 1  Line 1 
1  SUBROUTINE phyredem(fichnom, rlat,rlon,pctsrf,tsol,tsoil, &  module phyredem_m
      tslab,seaice,qsurf,qsol,snow,albedo,alblw,evap,rain_fall,snow_fall, &  
      solsw,sollw,fder,radsol,frugs,agesno,zmea,zstd,zsig,zgam,zthe,zpic, &  
      zval, t_ancien,q_ancien,rnebcon,ratqs,clwcon,run_off_lic_0)  
   
   ! From phylmd/phyredem.F,v 1.3 2005/05/25 13:10:09  
   ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818  
   ! Objet: Ecriture de l'etat de démarrage ou redémarrage pour la physique  
   
   USE indicesol, ONLY : is_lic, is_oce, is_sic, is_ter, nbsrf  
   USE dimphy, ONLY : klev, klon, zmasq  
   USE dimsoil, ONLY : nsoilmx  
   USE temps, ONLY : itau_phy  
   USE netcdf95, ONLY : nf95_create, nf95_put_att  
   USE netcdf, ONLY : nf90_clobber, nf90_global  
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    INCLUDE 'netcdf.inc'  contains
6    
7    CHARACTER(len=*) fichnom    SUBROUTINE phyredem(fichnom, rlat, rlon, pctsrf, tsol, tsoil, tslab, &
8    REAL, INTENT (IN) :: rlat(klon), rlon(klon)         seaice, qsurf, qsol, snow, albedo, alblw, evap, rain_fall, snow_fall, &
9    REAL :: tsol(klon,nbsrf)         solsw, sollw, fder, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
10    REAL :: tsoil(klon,nsoilmx,nbsrf)         zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
11    !IM "slab" ocean         run_off_lic_0, sig1, w01)
12    REAL :: tslab(klon), seaice(klon) !IM "slab" ocean  
13    REAL :: qsurf(klon,nbsrf)      ! From phylmd/phyredem.F, version 1.3 2005/05/25 13:10:09
14    REAL :: qsol(klon)      ! Author: Z. X. Li (LMD/CNRS)
15    REAL :: snow(klon,nbsrf)      ! Date: 19930818
16    REAL :: albedo(klon,nbsrf)      ! Objet : écriture de l'état de démarrage ou redémarrage pour la physique
17    !IM BEG  
18    REAL :: alblw(klon,nbsrf)      USE dimphy, ONLY: klev, klon, zmasq
19    !IM END      USE dimsoil, ONLY: nsoilmx
20    REAL :: evap(klon,nbsrf)      USE indicesol, ONLY: is_lic, is_oce, is_sic, is_ter, nbsrf
21    REAL :: rain_fall(klon)      USE netcdf, ONLY: nf90_clobber, nf90_global, nf90_float
22    REAL :: snow_fall(klon)      USE netcdf95, ONLY: nf95_create, nf95_put_att, nf95_def_dim, &
23    REAL :: solsw(klon)           nf95_def_var, nf95_enddef, nf95_redef, nf95_put_var, nf95_close
24    REAL :: sollw(klon)      USE temps, ONLY: itau_phy
25    REAL :: fder(klon)  
26    REAL :: radsol(klon)      CHARACTER(len=*) fichnom
27    REAL :: frugs(klon,nbsrf)      REAL, INTENT(IN):: rlat(klon), rlon(klon)
28    REAL :: agesno(klon,nbsrf)      REAL pctsrf(klon, nbsrf)
29    REAL :: zmea(klon)      REAL tsol(klon, nbsrf)
30    REAL, intent(in):: zstd(klon)      REAL tsoil(klon, nsoilmx, nbsrf)
31    REAL, intent(in):: zsig(klon)      REAL tslab(klon), seaice(klon) !IM "slab" ocean
32    REAL :: zgam(klon)      REAL qsurf(klon, nbsrf)
33    REAL :: zthe(klon)      REAL, intent(in):: qsol(klon)
34    REAL :: zpic(klon)      REAL snow(klon, nbsrf)
35    REAL :: zval(klon)      REAL albedo(klon, nbsrf)
36    REAL :: pctsrf(klon,nbsrf)      REAL alblw(klon, nbsrf)
37    REAL :: t_ancien(klon,klev), q_ancien(klon,klev)      REAL evap(klon, nbsrf)
38    REAL :: clwcon(klon,klev), rnebcon(klon,klev), ratqs(klon,klev)      REAL, INTENT(IN):: rain_fall(klon)
39    REAL :: run_off_lic_0(klon)      REAL snow_fall(klon)
40        REAL solsw(klon)
41    INTEGER :: nid, nvarid, idim2, idim3      REAL, INTENT(IN):: sollw(klon)
42    INTEGER :: ierr      REAL fder(klon)
43        REAL radsol(klon)
44    INTEGER :: isoil, nsrf      REAL frugs(klon, nbsrf)
45    CHARACTER (7) :: str7      REAL agesno(klon, nbsrf)
46    CHARACTER (2) :: str2      REAL zmea(klon)
47        REAL, intent(in):: zstd(klon)
48    !------------------------------------------------------------      REAL, intent(in):: zsig(klon)
49        REAL zgam(klon)
50    PRINT *, 'Call sequence information: phyredem'      REAL zthe(klon)
51    CALL nf95_create(fichnom,nf90_clobber,nid)      REAL zpic(klon)
52        REAL zval(klon)
53    call nf95_put_att(nid, nf90_global, 'title', 'Fichier redémarrage physique')      REAL t_ancien(klon, klev), q_ancien(klon, klev)
54    call nf95_put_att(nid, nf90_global, "itau_phy", itau_phy)      REAL rnebcon(klon, klev), ratqs(klon, klev), clwcon(klon, klev)
55        REAL run_off_lic_0(klon)
56    ierr = nf_def_dim(nid,'points_physiques',klon,idim2)      real, intent(in):: sig1(klon, klev) ! section adiabatic updraft
57    ierr = nf_def_dim(nid,'horizon_vertical',klon*klev,idim3)  
58        real, intent(in):: w01(klon, klev)
59    ierr = nf_def_var(nid,'longitude',nf_float,1,idim2,nvarid)      ! vertical velocity within adiabatic updraft
60    ierr = nf_put_att_text(nid,nvarid,'title',32, &  
61         'Longitudes de la grille physique')      ! Local:
62    ierr = nf_enddef(nid)  
63    ierr = nf_put_var_real(nid,nvarid,rlon)      INTEGER ncid, idim2, idim3
64        integer varid, varid_run_off_lic_0, varid_sig1, varid_w01
65    ierr = nf_redef(nid)      INTEGER isoil, nsrf
66    ierr = nf_def_var(nid,'latitude',nf_float,1,idim2,nvarid)      CHARACTER(len=7) str7
67    ierr = nf_put_att_text(nid,nvarid,'title',31, &      CHARACTER(len=2) str2
68         'Latitudes de la grille physique')  
69    ierr = nf_enddef(nid)      !------------------------------------------------------------
70    ierr = nf_put_var_real(nid,nvarid,rlat)  
71        PRINT *, 'Call sequence information: phyredem'
72    ! PB ajout du masque terre/mer      CALL nf95_create(fichnom, nf90_clobber, ncid)
73    
74    ierr = nf_redef(nid)      call nf95_put_att(ncid, nf90_global, 'title', &
75    ierr = nf_def_var(nid,'masque',nf_float,1,idim2,nvarid)           'Fichier redémarrage physique')
76    ierr = nf_put_att_text(nid,nvarid,'title',16,'masque terre mer')      call nf95_put_att(ncid, nf90_global, "itau_phy", itau_phy)
77    ierr = nf_enddef(nid)  
78    ierr = nf_put_var_real(nid,nvarid,zmasq)      call nf95_def_dim(ncid, 'points_physiques', klon, idim2)
79    ! BP ajout des fraction de chaque sous-surface      call nf95_def_dim(ncid, 'klev', klev, idim3)
80    
81    ! 1. fraction de terre      call nf95_def_var(ncid, 'longitude', nf90_float, idim2, varid)
82        call nf95_put_att(ncid, varid, 'title', &
83    ierr = nf_redef(nid)           'Longitudes de la grille physique')
84    ierr = nf_def_var(nid,'FTER',nf_float,1,idim2,nvarid)      call nf95_enddef(ncid)
85    ierr = nf_put_att_text(nid,nvarid,'title',21,'fraction de continent')      call nf95_put_var(ncid, varid, rlon)
86    ierr = nf_enddef(nid)  
87    ierr = nf_put_var_real(nid,nvarid,pctsrf(1:klon,is_ter))      call nf95_redef(ncid)
88        call nf95_def_var(ncid, 'latitude', nf90_float, idim2, varid)
89    ! 2. Fraction de glace de terre      call nf95_put_att(ncid, varid, 'title', &
90             'Latitudes de la grille physique')
91    ierr = nf_redef(nid)      call nf95_enddef(ncid)
92    ierr = nf_def_var(nid,'FLIC',nf_float,1,idim2,nvarid)      call nf95_put_var(ncid, varid, rlat)
93    ierr = nf_put_att_text(nid,nvarid,'title',24,'fraction glace de terre')  
94    ierr = nf_enddef(nid)      ! PB ajout du masque terre/mer
95    ierr = nf_put_var_real(nid,nvarid,pctsrf(1:klon,is_lic))  
96        call nf95_redef(ncid)
97    ! 3. fraction ocean      call nf95_def_var(ncid, 'masque', nf90_float, idim2, varid)
98        call nf95_put_att(ncid, varid, 'title', 'masque terre mer')
99    ierr = nf_redef(nid)      call nf95_enddef(ncid)
100    ierr = nf_def_var(nid,'FOCE',nf_float,1,idim2,nvarid)      call nf95_put_var(ncid, varid, zmasq)
101    ierr = nf_put_att_text(nid,nvarid,'title',14,'fraction ocean')      ! BP ajout des fraction de chaque sous-surface
102    ierr = nf_enddef(nid)  
103    ierr = nf_put_var_real(nid,nvarid,pctsrf(1:klon,is_oce))      ! 1. fraction de terre
104    
105    ! 4. Fraction glace de mer      call nf95_redef(ncid)
106        call nf95_def_var(ncid, 'FTER', nf90_float, idim2, varid)
107    ierr = nf_redef(nid)      call nf95_put_att(ncid, varid, 'title', 'fraction de continent')
108    ierr = nf_def_var(nid,'FSIC',nf_float,1,idim2,nvarid)      call nf95_enddef(ncid)
109    ierr = nf_put_att_text(nid,nvarid,'title',18,'fraction glace mer')      call nf95_put_var(ncid, varid, pctsrf(:, is_ter))
110    ierr = nf_enddef(nid)  
111    ierr = nf_put_var_real(nid,nvarid,pctsrf(1:klon,is_sic))      ! 2. Fraction de glace de terre
112    
113        call nf95_redef(ncid)
114        call nf95_def_var(ncid, 'FLIC', nf90_float, idim2, varid)
115    DO nsrf = 1, nbsrf      call nf95_put_att(ncid, varid, 'title', 'fraction glace de terre')
116       IF (nsrf<=99) THEN      call nf95_enddef(ncid)
117          WRITE (str2,'(i2.2)') nsrf      call nf95_put_var(ncid, varid, pctsrf(:, is_lic))
118          ierr = nf_redef(nid)  
119          ierr = nf_def_var(nid,'TS'//str2,nf_float,1,idim2,nvarid)      ! 3. fraction ocean
120          ierr = nf_put_att_text(nid,nvarid,'title',28, &  
121               'Temperature de surface No.'//str2)      call nf95_redef(ncid)
122          ierr = nf_enddef(nid)      call nf95_def_var(ncid, 'FOCE', nf90_float, idim2, varid)
123       ELSE      call nf95_put_att(ncid, varid, 'title', 'fraction ocean')
124          PRINT *, 'Trop de sous-mailles'      call nf95_enddef(ncid)
125          STOP 1      call nf95_put_var(ncid, varid, pctsrf(:, is_oce))
126       END IF  
127       ierr = nf_put_var_real(nid,nvarid,tsol(1,nsrf))      ! 4. Fraction glace de mer
128    END DO  
129        call nf95_redef(ncid)
130    DO nsrf = 1, nbsrf      call nf95_def_var(ncid, 'FSIC', nf90_float, idim2, varid)
131       DO isoil = 1, nsoilmx      call nf95_put_att(ncid, varid, 'title', 'fraction glace mer')
132          IF (isoil<=99 .AND. nsrf<=99) THEN      call nf95_enddef(ncid)
133             WRITE (str7,'(i2.2,"srf",i2.2)') isoil, nsrf      call nf95_put_var(ncid, varid, pctsrf(:, is_sic))
134             ierr = nf_redef(nid)  
135             ierr = nf_def_var(nid,'Tsoil'//str7,nf_float,1,idim2,nvarid)      DO nsrf = 1, nbsrf
136             ierr = nf_put_att_text(nid,nvarid,'title',29, &         IF (nsrf<=99) THEN
137                  'Temperature du sol No.'//str7)            WRITE (str2, '(i2.2)') nsrf
138             ierr = nf_enddef(nid)            call nf95_redef(ncid)
139          ELSE            call nf95_def_var(ncid, 'TS'//str2, nf90_float, idim2, varid)
140             PRINT *, 'Trop de couches'            call nf95_put_att(ncid, varid, 'title', &
141             STOP 1                 'Temperature de surface No.'//str2)
142          END IF            call nf95_enddef(ncid)
143          ierr = nf_put_var_real(nid,nvarid,tsoil(1,isoil,nsrf))         ELSE
144       END DO            PRINT *, 'Trop de sous-mailles'
145    END DO            STOP 1
146           END IF
147    !IM "slab" ocean         call nf95_put_var(ncid, varid, tsol(:, nsrf))
148    ierr = nf_redef(nid)      END DO
149    ierr = nf_def_var(nid,'TSLAB',nf_float,1,idim2,nvarid)  
150    ierr = nf_put_att_text(nid,nvarid,'title',33, &      DO nsrf = 1, nbsrf
151         'Ecart de la SST (pour slab-ocean)')         DO isoil = 1, nsoilmx
152    ierr = nf_enddef(nid)            IF (isoil<=99 .AND. nsrf<=99) THEN
153    ierr = nf_put_var_real(nid,nvarid,tslab)               WRITE (str7, '(i2.2, "srf", i2.2)') isoil, nsrf
154                 call nf95_redef(ncid)
155    ierr = nf_redef(nid)               call nf95_def_var(ncid, 'Tsoil'//str7, nf90_float, idim2, varid)
156    ierr = nf_def_var(nid,'SEAICE',nf_float,1,idim2,nvarid)               call nf95_put_att(ncid, varid, 'title', &
157    ierr = nf_put_att_text(nid,nvarid,'title',33, &                    'Temperature du sol No.'//str7)
158         'Glace de mer kg/m2 (pour slab-ocean)')               call nf95_enddef(ncid)
159    ierr = nf_enddef(nid)            ELSE
160    ierr = nf_put_var_real(nid,nvarid,seaice)               PRINT *, 'Trop de couches'
161                 STOP 1
162    DO nsrf = 1, nbsrf            END IF
163       IF (nsrf<=99) THEN            call nf95_put_var(ncid, varid, tsoil(:, isoil, nsrf))
164          WRITE (str2,'(i2.2)') nsrf         END DO
165          ierr = nf_redef(nid)      END DO
166          ierr = nf_def_var(nid,'QS'//str2,nf_float,1,idim2,nvarid)  
167          ierr = nf_put_att_text(nid,nvarid,'title',25, &      !IM "slab" ocean
168               'Humidite de surface No.'//str2)      call nf95_redef(ncid)
169          ierr = nf_enddef(nid)      call nf95_def_var(ncid, 'TSLAB', nf90_float, idim2, varid)
170       ELSE      call nf95_put_att(ncid, varid, 'title', &
171          PRINT *, 'Trop de sous-mailles'           'Ecart de la SST (pour slab-ocean)')
172          STOP 1      call nf95_enddef(ncid)
173       END IF      call nf95_put_var(ncid, varid, tslab)
174       ierr = nf_put_var_real(nid,nvarid,qsurf(1,nsrf))  
175    END DO      call nf95_redef(ncid)
176        call nf95_def_var(ncid, 'SEAICE', nf90_float, idim2, varid)
177    ierr = nf_redef(nid)      call nf95_put_att(ncid, varid, 'title', &
178    ierr = nf_def_var(nid,'QSOL',nf_float,1,idim2,nvarid)           'Glace de mer kg/m2 (pour slab-ocean)')
179    ierr = nf_put_att_text(nid,nvarid,'title',20,'Eau dans le sol (mm)')      call nf95_enddef(ncid)
180    ierr = nf_enddef(nid)      call nf95_put_var(ncid, varid, seaice)
181    ierr = nf_put_var_real(nid,nvarid,qsol)  
182        DO nsrf = 1, nbsrf
183    DO nsrf = 1, nbsrf         IF (nsrf<=99) THEN
184       IF (nsrf<=99) THEN            WRITE (str2, '(i2.2)') nsrf
185          WRITE (str2,'(i2.2)') nsrf            call nf95_redef(ncid)
186          ierr = nf_redef(nid)            call nf95_def_var(ncid, 'QS'//str2, nf90_float, idim2, varid)
187          ierr = nf_def_var(nid,'ALBE'//str2,nf_float,1,idim2,nvarid)            call nf95_put_att(ncid, varid, 'title', &
188          ierr = nf_put_att_text(nid,nvarid,'title',23, &                 'Humidite de surface No.'//str2)
189               'albedo de surface No.'//str2)            call nf95_enddef(ncid)
190          ierr = nf_enddef(nid)         ELSE
191       ELSE            PRINT *, 'Trop de sous-mailles'
192          PRINT *, 'Trop de sous-mailles'            STOP 1
193          STOP 1         END IF
194       END IF         call nf95_put_var(ncid, varid, qsurf(:, nsrf))
195       ierr = nf_put_var_real(nid,nvarid,albedo(1,nsrf))      END DO
196    END DO  
197        call nf95_redef(ncid)
198    !IM BEG albedo LW      call nf95_def_var(ncid, 'QSOL', nf90_float, idim2, varid)
199    DO nsrf = 1, nbsrf      call nf95_put_att(ncid, varid, 'title', 'Eau dans le sol (mm)')
200       IF (nsrf<=99) THEN      call nf95_enddef(ncid)
201          WRITE (str2,'(i2.2)') nsrf      call nf95_put_var(ncid, varid, qsol)
202          ierr = nf_redef(nid)  
203          ierr = nf_def_var(nid,'ALBLW'//str2,nf_float,1,idim2,nvarid)      DO nsrf = 1, nbsrf
204          ierr = nf_put_att_text(nid,nvarid,'title',23, &         IF (nsrf<=99) THEN
205               'albedo LW de surface No.'//str2)            WRITE (str2, '(i2.2)') nsrf
206          ierr = nf_enddef(nid)            call nf95_redef(ncid)
207       ELSE            call nf95_def_var(ncid, 'ALBE'//str2, nf90_float, idim2, varid)
208          PRINT *, 'Trop de sous-mailles'            call nf95_put_att(ncid, varid, 'title', &
209          STOP 1                 'albedo de surface No.'//str2)
210       END IF            call nf95_enddef(ncid)
211       ierr = nf_put_var_real(nid,nvarid,alblw(1,nsrf))         ELSE
212    END DO            PRINT *, 'Trop de sous-mailles'
213    !IM END albedo LW            STOP 1
214           END IF
215    DO nsrf = 1, nbsrf         call nf95_put_var(ncid, varid, albedo(:, nsrf))
216       IF (nsrf<=99) THEN      END DO
217          WRITE (str2,'(i2.2)') nsrf  
218          ierr = nf_redef(nid)      !IM BEG albedo LW
219          ierr = nf_def_var(nid,'EVAP'//str2,nf_float,1,idim2,nvarid)      DO nsrf = 1, nbsrf
220          ierr = nf_put_att_text(nid,nvarid,'title',28, &         IF (nsrf<=99) THEN
221               'Evaporation de surface No.'//str2)            WRITE (str2, '(i2.2)') nsrf
222          ierr = nf_enddef(nid)            call nf95_redef(ncid)
223       ELSE            call nf95_def_var(ncid, 'ALBLW'//str2, nf90_float, idim2, varid)
224          PRINT *, 'Trop de sous-mailles'            call nf95_put_att(ncid, varid, 'title', &
225          STOP 1                 'albedo LW de surface No.'//str2)
226       END IF            call nf95_enddef(ncid)
227       ierr = nf_put_var_real(nid,nvarid,evap(1,nsrf))         ELSE
228    END DO            PRINT *, 'Trop de sous-mailles'
229              STOP 1
230           END IF
231    DO nsrf = 1, nbsrf         call nf95_put_var(ncid, varid, alblw(:, nsrf))
232       IF (nsrf<=99) THEN      END DO
233          WRITE (str2,'(i2.2)') nsrf      !IM END albedo LW
234          ierr = nf_redef(nid)  
235          ierr = nf_def_var(nid,'SNOW'//str2,nf_float,1,idim2,nvarid)      DO nsrf = 1, nbsrf
236          ierr = nf_put_att_text(nid,nvarid,'title',22, &         IF (nsrf<=99) THEN
237               'Neige de surface No.'//str2)            WRITE (str2, '(i2.2)') nsrf
238          ierr = nf_enddef(nid)            call nf95_redef(ncid)
239       ELSE            call nf95_def_var(ncid, 'EVAP'//str2, nf90_float, idim2, varid)
240          PRINT *, 'Trop de sous-mailles'            call nf95_put_att(ncid, varid, 'title', &
241          STOP 1                 'Evaporation de surface No.'//str2)
242       END IF            call nf95_enddef(ncid)
243       ierr = nf_put_var_real(nid,nvarid,snow(1,nsrf))         ELSE
244    END DO            PRINT *, 'Trop de sous-mailles'
245              STOP 1
246           END IF
247    ierr = nf_redef(nid)         call nf95_put_var(ncid, varid, evap(:, nsrf))
248    ierr = nf_def_var(nid,'RADS',nf_float,1,idim2,nvarid)      END DO
249    ierr = nf_put_att_text(nid,nvarid,'title',28, &  
250         'Rayonnement net a la surface')      DO nsrf = 1, nbsrf
251    ierr = nf_enddef(nid)         IF (nsrf<=99) THEN
252    ierr = nf_put_var_real(nid,nvarid,radsol)            WRITE (str2, '(i2.2)') nsrf
253              call nf95_redef(ncid)
254    ierr = nf_redef(nid)            call nf95_def_var(ncid, 'SNOW'//str2, nf90_float, idim2, varid)
255    ierr = nf_def_var(nid,'solsw',nf_float,1,idim2,nvarid)            call nf95_put_att(ncid, varid, 'title', &
256    ierr = nf_put_att_text(nid,nvarid,'title',32, &                 'Neige de surface No.'//str2)
257         'Rayonnement solaire a la surface')            call nf95_enddef(ncid)
258    ierr = nf_enddef(nid)         ELSE
259    ierr = nf_put_var_real(nid,nvarid,solsw)            PRINT *, 'Trop de sous-mailles'
260              STOP 1
261    ierr = nf_redef(nid)         END IF
262    ierr = nf_def_var(nid,'sollw',nf_float,1,idim2,nvarid)         call nf95_put_var(ncid, varid, snow(:, nsrf))
263    ierr = nf_put_att_text(nid,nvarid,'title',27, &      END DO
264         'Rayonnement IF a la surface')  
265    ierr = nf_enddef(nid)      call nf95_redef(ncid)
266    ierr = nf_put_var_real(nid,nvarid,sollw)      call nf95_def_var(ncid, 'RADS', nf90_float, idim2, varid)
267        call nf95_put_att(ncid, varid, 'title', &
268    ierr = nf_redef(nid)           'Rayonnement net a la surface')
269    ierr = nf_def_var(nid,'fder',nf_float,1,idim2,nvarid)      call nf95_enddef(ncid)
270    ierr = nf_put_att_text(nid,nvarid,'title',14,'Derive de flux')      call nf95_put_var(ncid, varid, radsol)
271    ierr = nf_enddef(nid)  
272    ierr = nf_put_var_real(nid,nvarid,fder)      call nf95_redef(ncid)
273        call nf95_def_var(ncid, 'solsw', nf90_float, idim2, varid)
274    ierr = nf_redef(nid)      call nf95_put_att(ncid, varid, 'title', &
275    ierr = nf_def_var(nid,'rain_f',nf_float,1,idim2,nvarid)           'Rayonnement solaire a la surface')
276    ierr = nf_put_att_text(nid,nvarid,'title',21,'precipitation liquide')      call nf95_enddef(ncid)
277    ierr = nf_enddef(nid)      call nf95_put_var(ncid, varid, solsw)
278    ierr = nf_put_var_real(nid,nvarid,rain_fall)  
279        call nf95_redef(ncid)
280    ierr = nf_redef(nid)      call nf95_def_var(ncid, 'sollw', nf90_float, idim2, varid)
281    ierr = nf_def_var(nid,'snow_f',nf_float,1,idim2,nvarid)      call nf95_put_att(ncid, varid, 'title', &
282    ierr = nf_put_att_text(nid,nvarid,'title',20,'precipitation solide')           'Rayonnement IF a la surface')
283    ierr = nf_enddef(nid)      call nf95_enddef(ncid)
284    ierr = nf_put_var_real(nid,nvarid,snow_fall)      call nf95_put_var(ncid, varid, sollw)
285    
286    DO nsrf = 1, nbsrf      call nf95_redef(ncid)
287       IF (nsrf<=99) THEN      call nf95_def_var(ncid, 'fder', nf90_float, idim2, varid)
288          WRITE (str2,'(i2.2)') nsrf      call nf95_put_att(ncid, varid, 'title', 'Derive de flux')
289          ierr = nf_redef(nid)      call nf95_enddef(ncid)
290          ierr = nf_def_var(nid,'RUG'//str2,nf_float,1,idim2,nvarid)      call nf95_put_var(ncid, varid, fder)
291          ierr = nf_put_att_text(nid,nvarid,'title',23, &  
292               'rugosite de surface No.'//str2)      call nf95_redef(ncid)
293          ierr = nf_enddef(nid)      call nf95_def_var(ncid, 'rain_f', nf90_float, idim2, varid)
294       ELSE      call nf95_put_att(ncid, varid, 'title', 'precipitation liquide')
295          PRINT *, 'Trop de sous-mailles'      call nf95_enddef(ncid)
296          STOP 1      call nf95_put_var(ncid, varid, rain_fall)
297       END IF  
298       ierr = nf_put_var_real(nid,nvarid,frugs(1,nsrf))      call nf95_redef(ncid)
299    END DO      call nf95_def_var(ncid, 'snow_f', nf90_float, idim2, varid)
300        call nf95_put_att(ncid, varid, 'title', 'precipitation solide')
301    DO nsrf = 1, nbsrf      call nf95_enddef(ncid)
302       IF (nsrf<=99) THEN      call nf95_put_var(ncid, varid, snow_fall)
303          WRITE (str2,'(i2.2)') nsrf  
304          ierr = nf_redef(nid)      DO nsrf = 1, nbsrf
305          ierr = nf_def_var(nid,'AGESNO'//str2,nf_float,1,idim2,nvarid)         IF (nsrf<=99) THEN
306          ierr = nf_put_att_text(nid,nvarid,'title',15, &            WRITE (str2, '(i2.2)') nsrf
307               'Age de la neige surface No.'//str2)            call nf95_redef(ncid)
308          ierr = nf_enddef(nid)            call nf95_def_var(ncid, 'RUG'//str2, nf90_float, idim2, varid)
309       ELSE            call nf95_put_att(ncid, varid, 'title', &
310          PRINT *, 'Trop de sous-mailles'                 'rugosite de surface No.'//str2)
311          STOP 1            call nf95_enddef(ncid)
312       END IF         ELSE
313       ierr = nf_put_var_real(nid,nvarid,agesno(1,nsrf))            PRINT *, 'Trop de sous-mailles'
314    END DO            STOP 1
315           END IF
316    ierr = nf_redef(nid)         call nf95_put_var(ncid, varid, frugs(:, nsrf))
317    ierr = nf_def_var(nid,'ZMEA',nf_float,1,idim2,nvarid)      END DO
318    ierr = nf_enddef(nid)  
319    ierr = nf_put_var_real(nid,nvarid,zmea)      DO nsrf = 1, nbsrf
320           IF (nsrf<=99) THEN
321    ierr = nf_redef(nid)            WRITE (str2, '(i2.2)') nsrf
322    ierr = nf_def_var(nid,'ZSTD',nf_float,1,idim2,nvarid)            call nf95_redef(ncid)
323    ierr = nf_enddef(nid)            call nf95_def_var(ncid, 'AGESNO'//str2, nf90_float, idim2, varid)
324    ierr = nf_put_var_real(nid,nvarid,zstd)            call nf95_put_att(ncid, varid, 'title', &
325    ierr = nf_redef(nid)                 'Age de la neige surface No.'//str2)
326    ierr = nf_def_var(nid,'ZSIG',nf_float,1,idim2,nvarid)            call nf95_enddef(ncid)
327    ierr = nf_enddef(nid)         ELSE
328    ierr = nf_put_var_real(nid,nvarid,zsig)            PRINT *, 'Trop de sous-mailles'
329    ierr = nf_redef(nid)            STOP 1
330    ierr = nf_def_var(nid,'ZGAM',nf_float,1,idim2,nvarid)         END IF
331    ierr = nf_enddef(nid)         call nf95_put_var(ncid, varid, agesno(:, nsrf))
332    ierr = nf_put_var_real(nid,nvarid,zgam)      END DO
333    ierr = nf_redef(nid)  
334    ierr = nf_def_var(nid,'ZTHE',nf_float,1,idim2,nvarid)      call nf95_redef(ncid)
335    ierr = nf_enddef(nid)      call nf95_def_var(ncid, 'ZMEA', nf90_float, idim2, varid)
336    ierr = nf_put_var_real(nid,nvarid,zthe)      call nf95_enddef(ncid)
337    ierr = nf_redef(nid)      call nf95_put_var(ncid, varid, zmea)
338    ierr = nf_def_var(nid,'ZPIC',nf_float,1,idim2,nvarid)  
339    ierr = nf_enddef(nid)      call nf95_redef(ncid)
340    ierr = nf_put_var_real(nid,nvarid,zpic)      call nf95_def_var(ncid, 'ZSTD', nf90_float, idim2, varid)
341    ierr = nf_redef(nid)      call nf95_enddef(ncid)
342    ierr = nf_def_var(nid,'ZVAL',nf_float,1,idim2,nvarid)      call nf95_put_var(ncid, varid, zstd)
343    ierr = nf_enddef(nid)      call nf95_redef(ncid)
344    ierr = nf_put_var_real(nid,nvarid,zval)      call nf95_def_var(ncid, 'ZSIG', nf90_float, idim2, varid)
345        call nf95_enddef(ncid)
346    ierr = nf_redef(nid)      call nf95_put_var(ncid, varid, zsig)
347    ierr = nf_def_var(nid,'TANCIEN',nf_float,1,idim3,nvarid)      call nf95_redef(ncid)
348    ierr = nf_enddef(nid)      call nf95_def_var(ncid, 'ZGAM', nf90_float, idim2, varid)
349    ierr = nf_put_var_real(nid,nvarid,t_ancien)      call nf95_enddef(ncid)
350        call nf95_put_var(ncid, varid, zgam)
351    ierr = nf_redef(nid)      call nf95_redef(ncid)
352    ierr = nf_def_var(nid,'QANCIEN',nf_float,1,idim3,nvarid)      call nf95_def_var(ncid, 'ZTHE', nf90_float, idim2, varid)
353    ierr = nf_enddef(nid)      call nf95_enddef(ncid)
354    ierr = nf_put_var_real(nid,nvarid,q_ancien)      call nf95_put_var(ncid, varid, zthe)
355        call nf95_redef(ncid)
356    ierr = nf_redef(nid)      call nf95_def_var(ncid, 'ZPIC', nf90_float, idim2, varid)
357    ierr = nf_def_var(nid,'RUGMER',nf_float,1,idim2,nvarid)      call nf95_enddef(ncid)
358    ierr = nf_put_att_text(nid,nvarid,'title',28, &      call nf95_put_var(ncid, varid, zpic)
359         'Longueur de rugosite sur mer')      call nf95_redef(ncid)
360    ierr = nf_enddef(nid)      call nf95_def_var(ncid, 'ZVAL', nf90_float, idim2, varid)
361    ierr = nf_put_var_real(nid,nvarid,frugs(1,is_oce))      call nf95_enddef(ncid)
362        call nf95_put_var(ncid, varid, zval)
363    ierr = nf_redef(nid)  
364    ierr = nf_def_var(nid,'CLWCON',nf_float,1,idim2,nvarid)      call nf95_redef(ncid)
365    ierr = nf_put_att_text(nid,nvarid,'title',28,'Eau liquide convective')      call nf95_def_var(ncid, 'TANCIEN', nf90_float, (/idim2, idim3/), varid)
366    ierr = nf_enddef(nid)      call nf95_enddef(ncid)
367    ierr = nf_put_var_real(nid,nvarid,clwcon)      call nf95_put_var(ncid, varid, t_ancien)
368    
369    ierr = nf_redef(nid)      call nf95_redef(ncid)
370    ierr = nf_def_var(nid,'RNEBCON',nf_float,1,idim2,nvarid)      call nf95_def_var(ncid, 'QANCIEN', nf90_float, (/idim2, idim3/), varid)
371    ierr = nf_put_att_text(nid,nvarid,'title',28,'Nebulosite convective')      call nf95_enddef(ncid)
372    ierr = nf_enddef(nid)      call nf95_put_var(ncid, varid, q_ancien)
373    ierr = nf_put_var_real(nid,nvarid,rnebcon)  
374        call nf95_redef(ncid)
375    ierr = nf_redef(nid)      call nf95_def_var(ncid, 'RUGMER', nf90_float, idim2, varid)
376    ierr = nf_def_var(nid,'RATQS',nf_float,1,idim2,nvarid)      call nf95_put_att(ncid, varid, 'title', &
377    ierr = nf_put_att_text(nid,nvarid,'title',5,'Ratqs')           'Longueur de rugosite sur mer')
378    ierr = nf_enddef(nid)      call nf95_enddef(ncid)
379    ierr = nf_put_var_real(nid,nvarid,ratqs)      call nf95_put_var(ncid, varid, frugs(:, is_oce))
380    
381    ! run_off_lic_0      call nf95_redef(ncid)
382        call nf95_def_var(ncid, 'CLWCON', nf90_float, idim2, varid)
383    ierr = nf_redef(nid)      call nf95_put_att(ncid, varid, 'title', 'Eau liquide convective')
384    ierr = nf_def_var(nid,'RUNOFFLIC0',nf_float,1,idim2,nvarid)      call nf95_enddef(ncid)
385    ierr = nf_put_att_text(nid,nvarid,'title',10,'Runofflic0')      call nf95_put_var(ncid, varid, clwcon(:, 1))
386    ierr = nf_enddef(nid)  
387    ierr = nf_put_var_real(nid,nvarid,run_off_lic_0)      call nf95_redef(ncid)
388        call nf95_def_var(ncid, 'RNEBCON', nf90_float, idim2, varid)
389        call nf95_put_att(ncid, varid, 'title', 'Nebulosite convective')
390        call nf95_enddef(ncid)
391        call nf95_put_var(ncid, varid, rnebcon(:, 1))
392    
393        call nf95_redef(ncid)
394        call nf95_def_var(ncid, 'RATQS', nf90_float, idim2, varid)
395        call nf95_put_att(ncid, varid, 'title', 'Ratqs')
396        call nf95_enddef(ncid)
397        call nf95_put_var(ncid, varid, ratqs(:, 1))
398    
399        call nf95_redef(ncid)
400        call nf95_def_var(ncid, 'RUNOFFLIC0', nf90_float, idim2, &
401             varid_run_off_lic_0)
402        call nf95_put_att(ncid, varid_run_off_lic_0, 'title', 'Runofflic0')
403    
404        call nf95_def_var(ncid, 'sig1', nf90_float, (/idim2, idim3/), varid_sig1)
405        call nf95_put_att(ncid, varid_sig1, 'long_name', &
406             'section adiabatic updraft')
407    
408        call nf95_def_var(ncid, 'w01', nf90_float, (/idim2, idim3/), varid_w01)
409        call nf95_put_att(ncid, varid_w01, 'long_name', &
410             'vertical velocity within adiabatic updraft')
411    
412        call nf95_enddef(ncid)
413    
414        call nf95_put_var(ncid, varid_run_off_lic_0, run_off_lic_0)
415        call nf95_put_var(ncid, varid_sig1, sig1)
416        call nf95_put_var(ncid, varid_w01, w01)
417    
418        call nf95_close(ncid)
419    
420    ierr = nf_close(nid)    END SUBROUTINE phyredem
421    
422  END SUBROUTINE phyredem  end module phyredem_m

Legend:
Removed from v.13  
changed lines
  Added in v.72

  ViewVC Help
Powered by ViewVC 1.1.21