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

Diff of /trunk/Sources/phylmd/phyredem.f

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

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

Legend:
Removed from v.12  
changed lines
  Added in v.15

  ViewVC Help
Powered by ViewVC 1.1.21