source: LMDZ4/branches/LMDZ4-dev-20091210/libf/phylmd/phyredem.F @ 4104

Last change on this file since 4104 was 1227, checked in by jghattas, 15 years ago
  • Inclusion d'un premier version du cycle de carbon dans LMDZ. Attention

!! Il s'agit d'un version ou les nouveaux cles cycle_carbon_tr et
cycle_carbon_cpl ne sont pas teste. Avec les ancinenes parametres le
modele donne les memes resultats qu'avant. L'interface avec ORCHIDEE n'a
pas encore etait modifie.

  • physiq.F, phys_cal_mod.F90 : ajout d'un nouveau module qui contient qq parametres pour le calendrier et le pas de temps acutelle de la physiq. Ce module pourrait etre elargie plus tard / LF + JG


  • infotrac.F90 : les noms du traceurs peut prendre un nom plus long (15 caracteres) dans traceur.def
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.8 KB
Line 
1!
2! $Header$
3!
4c
5      SUBROUTINE phyredem (fichnom)
6
7      USE dimphy
8      USE mod_grid_phy_lmdz
9      USE mod_phys_lmdz_para
10      USE fonte_neige_mod,  ONLY : fonte_neige_final
11      USE pbl_surface_mod,  ONLY : pbl_surface_final
12      USE phys_state_var_mod
13      USE iostart
14      USE traclmdz_mod, ONLY : traclmdz_to_restart
15      USE infotrac
16
17      IMPLICIT none
18c======================================================================
19c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
20c Objet: Ecriture de l'etat de redemarrage pour la physique
21c======================================================================
22#include "netcdf.inc"
23#include "indicesol.h"
24#include "dimsoil.h"
25#include "clesphys.h"
26#include "control.h"
27#include "temps.h"
28#include "thermcell.h"
29#include "compbl.h"
30c======================================================================
31      CHARACTER*(*) fichnom
32
33c les variables globales ecrites dans le fichier restart
34
35     
36      REAL tsoil(klon,nsoilmx,nbsrf)
37      REAL tslab(klon), seaice(klon)
38      REAL qsurf(klon,nbsrf)
39      REAL qsol(klon)
40      REAL snow(klon,nbsrf)
41      REAL evap(klon,nbsrf)
42      real fder(klon)
43      REAL frugs(klon,nbsrf)
44      REAL agesno(klon,nbsrf)
45      REAL run_off_lic_0(klon)
46      REAL trs(klon,nbtr)
47c
48      INTEGER nid, nvarid, idim1, idim2, idim3
49      INTEGER ierr
50      INTEGER length
51      PARAMETER (length=100)
52      REAL tab_cntrl(length)
53c
54      INTEGER isoil, nsrf
55      CHARACTER (len=7) :: str7
56      CHARACTER (len=2) :: str2
57      INTEGER           :: it, iiq
58     
59c======================================================================
60c
61c Get variables which will be written to restart file from module
62c pbl_surface_mod
63      CALL pbl_surface_final(qsol, fder, snow, qsurf,
64     $     evap, frugs, agesno, tsoil)
65
66c Get a variable calculated in module fonte_neige_mod
67      CALL fonte_neige_final(run_off_lic_0)
68
69c======================================================================
70
71      CALL open_restartphy(fichnom)
72     
73      DO ierr = 1, length
74         tab_cntrl(ierr) = 0.0
75      ENDDO
76CC      tab_cntrl(1) = dtime
77      tab_cntrl(2) = radpas
78c co2_ppm : current value of atmospheric CO2
79      tab_cntrl(3) = co2_ppm
80      tab_cntrl(4) = solaire
81      tab_cntrl(5) = iflag_con
82      tab_cntrl(6) = nbapp_rad
83
84      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
85      IF(   soil_model ) tab_cntrl( 8 ) = 1.
86      IF(     new_oliq ) tab_cntrl( 9 ) = 1.
87      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
88      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
89
90      tab_cntrl(13) = day_end
91      tab_cntrl(14) = annee_ref
92      tab_cntrl(15) = itau_phy
93
94c co2_ppm0 : initial value of atmospheric CO2
95      tab_cntrl(16) = co2_ppm0
96c
97      CALL put_var("controle","Parametres de controle",tab_cntrl)
98c
99
100      CALL put_field("longitude",
101     .               "Longitudes de la grille physique",rlon)
102     
103      CALL put_field("latitude","Latitudes de la grille physique",rlat)
104
105c
106C PB ajout du masque terre/mer
107C
108      CALL put_field("masque","masque terre mer",zmasq)
109
110c BP ajout des fraction de chaque sous-surface
111C
112C 1. fraction de terre
113C
114      CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
115C
116C 2. Fraction de glace de terre
117C
118      CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
119C
120C 3. fraction ocean
121C
122      CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
123C
124C 4. Fraction glace de mer
125C
126      CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
127C
128C
129c
130      DO nsrf = 1, nbsrf
131        IF (nsrf.LE.99) THEN
132          WRITE(str2,'(i2.2)') nsrf
133          CALL put_field("TS"//str2,"Temperature de surface No."//str2,
134     .                    ftsol(:,nsrf))
135        ELSE
136          PRINT*, "Trop de sous-mailles"
137          CALL abort
138        ENDIF
139      ENDDO
140c
141      DO nsrf = 1, nbsrf
142        DO isoil=1, nsoilmx
143          IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
144            WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
145            CALL put_field("Tsoil"//str7,"Temperature du sol No."//str7,
146     .                     tsoil(:,isoil,nsrf))
147          ELSE
148            PRINT*, "Trop de couches"
149            CALL abort
150          ENDIF
151        ENDDO
152      ENDDO
153c
154      DO nsrf = 1, nbsrf
155        IF (nsrf.LE.99) THEN
156          WRITE(str2,'(i2.2)') nsrf
157          CALL put_field("QS"//str2,"Humidite de surface No."//str2,
158     .                   qsurf(:,nsrf))
159        ELSE
160          PRINT*, "Trop de sous-mailles"
161          CALL abort
162        ENDIF
163      END DO
164C
165      CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
166c
167      DO nsrf = 1, nbsrf
168        IF (nsrf.LE.99) THEN
169          WRITE(str2,'(i2.2)') nsrf
170          CALL put_field("ALBE"//str2,"albedo de surface No."//str2,
171     .                   falb1(:,nsrf))
172        ELSE
173          PRINT*, "Trop de sous-mailles"
174          CALL abort
175        ENDIF
176      ENDDO
177
178      DO nsrf = 1, nbsrf
179        IF (nsrf.LE.99) THEN
180          WRITE(str2,'(i2.2)') nsrf
181          CALL put_field("ALBLW"//str2,"albedo LW de surface No."//str2,
182     .                   falb2(:,nsrf))
183        ELSE
184          PRINT*, "Trop de sous-mailles"
185          CALL abort
186        ENDIF
187      ENDDO
188c
189c
190      DO nsrf = 1, nbsrf
191        IF (nsrf.LE.99) THEN
192          WRITE(str2,'(i2.2)') nsrf
193          CALL put_field("EVAP"//str2,"Evaporation de surface No."//str2
194     .                   ,evap(:,nsrf))
195        ELSE
196          PRINT*, "Trop de sous-mailles"
197          CALL abort
198        ENDIF
199      ENDDO
200
201c
202      DO nsrf = 1, nbsrf
203        IF (nsrf.LE.99) THEN
204          WRITE(str2,'(i2.2)') nsrf
205          CALL put_field("SNOW"//str2,"Neige de surface No."//str2,
206     .                   snow(:,nsrf))
207        ELSE
208          PRINT*, "Trop de sous-mailles"
209          CALL abort
210        ENDIF
211      ENDDO
212
213c
214      CALL put_field("RADS","Rayonnement net a la surface",radsol)
215c
216      CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
217c
218      CALL put_field("sollw","Rayonnement IF a la surface",sollw)
219c
220      CALL put_field("fder","Derive de flux",fder)
221c
222      CALL put_field("rain_f","precipitation liquide",rain_fall)
223c
224      CALL put_field("snow_f", "precipitation solide",snow_fall)
225c
226      DO nsrf = 1, nbsrf
227        IF (nsrf.LE.99) THEN
228        WRITE(str2,'(i2.2)') nsrf
229          CALL put_field("RUG"//str2,"rugosite de surface No."//str2,
230     .         frugs(:,nsrf))
231        ELSE
232          PRINT*, "Trop de sous-mailles"
233          CALL abort
234        ENDIF
235      ENDDO
236c
237      DO nsrf = 1, nbsrf
238        IF (nsrf.LE.99) THEN
239            WRITE(str2,'(i2.2)') nsrf
240            CALL put_field("AGESNO"//str2,
241     .                     "Age de la neige surface No."//str2,
242     .                     agesno(:,nsrf))
243        ELSE
244            PRINT*, "Trop de sous-mailles"
245            CALL abort
246        ENDIF
247      ENDDO
248c
249      CALL put_field("ZMEA","",zmea)
250c
251      CALL put_field("ZSTD","",zstd)
252     
253      CALL put_field("ZSIG","",zsig)
254     
255      CALL put_field("ZGAM","",zgam)
256     
257      CALL put_field("ZTHE","",zthe)
258     
259      CALL put_field("ZPIC","",zpic)
260     
261      CALL put_field("ZVAL","",zval)
262     
263      CALL put_field("RUGSREL","RUGSREL",rugoro)
264     
265      CALL put_field("TANCIEN","",t_ancien)
266     
267      CALL put_field("QANCIEN","",q_ancien)
268     
269      CALL put_field("RUGMER","Longueur de rugosite sur mer",
270     .               frugs(:,is_oce))
271     
272      CALL put_field("CLWCON","Eau liquide convective",clwcon(:,1))
273     
274      CALL put_field("RNEBCON","Nebulosite convective",rnebcon(:,1))
275     
276      CALL put_field("RATQS", "Ratqs",ratqs(:,1))
277c
278c run_off_lic_0
279c
280      CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
281c
282c
283!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
284c
285      IF (iflag_pbl>1) then
286        DO nsrf = 1, nbsrf
287          IF (nsrf.LE.99) THEN
288            WRITE(str2,'(i2.2)') nsrf
289            CALL put_field("TKE"//str2,"Energ. Cineti. Turb."//str2,
290     .                     pbl_tke(:,1:klev,nsrf))
291          ELSE
292            PRINT*, "Trop de sous-mailles"
293            CALL abort
294          ENDIF
295        ENDDO
296      ENDIF
297
298!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
299cIM ajout zmax0, f0, ema_work1, ema_work2
300cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_fip
301     
302      CALL put_field("ZMAX0","",zmax0)
303     
304      CALL put_field("F0","",f0)
305     
306      CALL put_field("EMA_WORK1","",ema_work1)
307     
308      CALL put_field("EMA_WORK2","",ema_work2)
309     
310c wake_deltat
311      CALL put_field("WAKE_DELTAT","",wake_deltat)
312
313      CALL put_field("WAKE_DELTAQ","",wake_deltaq)
314     
315      CALL put_field("WAKE_S","",wake_s)
316     
317      CALL put_field("WAKE_CSTAR","",wake_cstar)
318     
319      CALL put_field("WAKE_FIP","",wake_fip)
320
321
322! trs from traclmdz_mod
323      IF (type_trac == 'lmdz') THEN
324         CALL traclmdz_to_restart(trs)
325         DO it=1,nbtr
326            iiq=niadv(it+2)
327            CALL put_field("trs_"//tname(iiq),"",trs(:,it))
328         END DO
329      END IF
330
331      CALL close_restartphy
332!$OMP BARRIER
333      RETURN
334      END
Note: See TracBrowser for help on using the repository browser.