source: LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/phyredem.F @ 3707

Last change on this file since 3707 was 1444, checked in by jghattas, 14 years ago

Modifications for carbon tracers :

  • add possibility to read source at different frequency
  • add dynamic varaiable to send fluxes in interface between ORCHIDEE and LMDZ : this is still under developpment under cpp key ORCH_NEW. No compatible official ORCHIDEE version does yet exist.
  • add variable co2_send in restart file.
  • clean up and bug fixes.


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