Context Navigation

phyredem.F @ 1361

Last change on this file since 1361 was 1322, checked in by Laurent Fairhead, 15 years ago

Improvements concerning wake parametrisation (from JYG, NR, IT, with more to come).
Alp_offset is read in form physiq.def file

Améliorations à la paramétrisation des poches froides (de JYG, NR, IT, d'autres
sont à venir)
Alp_offset est rajouté à la liste des paramètres lus dans physiq.def

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 9.2 KB

Line
1	!
2	! $Id: phyredem.F 1322 2010-03-12 10:54:11Z emillour $
3	!
4	c
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
18
19	IMPLICIT none
20	c======================================================================
21	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
22	c Objet: Ecriture de l'etat de redemarrage pour la physique
23	c======================================================================
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"
31	c======================================================================
32	CHARACTER() fichnom
33
34	c 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)
48	c
49	INTEGER nid, nvarid, idim1, idim2, idim3
50	INTEGER ierr
51	INTEGER length
52	PARAMETER (length=100)
53	REAL tab_cntrl(length)
54	c
55	INTEGER isoil, nsrf
56	CHARACTER (len=7) :: str7
57	CHARACTER (len=2) :: str2
58	INTEGER :: it, iiq
59
60	c======================================================================
61	c
62	c Get variables which will be written to restart file from module
63	c pbl_surface_mod
64	CALL pbl_surface_final(qsol, fder, snow, qsurf,
65	$ evap, frugs, agesno, tsoil)
66
67	c Get a variable calculated in module fonte_neige_mod
68	CALL fonte_neige_final(run_off_lic_0)
69
70	c======================================================================
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
79	c 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
95	c co2_ppm0 : initial value of atmospheric CO2
96	tab_cntrl(16) = co2_ppm0
97	c
98	CALL put_var("controle","Parametres de controle",tab_cntrl)
99	c
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
106	c
107	C PB ajout du masque terre/mer
108	C
109	CALL put_field("masque","masque terre mer",zmasq)
110
111	c BP ajout des fraction de chaque sous-surface
112	C
113	C 1. fraction de terre
114	C
115	CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
116	C
117	C 2. Fraction de glace de terre
118	C
119	CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
120	C
121	C 3. fraction ocean
122	C
123	CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
124	C
125	C 4. Fraction glace de mer
126	C
127	CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
128	C
129	C
130	c
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
141	c
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
154	c
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
165	C
166	CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
167	c
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
189	c
190	c
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
202	c
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
214	c
215	CALL put_field("RADS","Rayonnement net a la surface",radsol)
216	c
217	CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
218	c
219	CALL put_field("sollw","Rayonnement IF a la surface",sollw)
220	c
221	CALL put_field("fder","Derive de flux",fder)
222	c
223	CALL put_field("rain_f","precipitation liquide",rain_fall)
224	c
225	CALL put_field("snow_f", "precipitation solide",snow_fall)
226	c
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
237	c
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
249	c
250	CALL put_field("ZMEA","ZMEA",zmea)
251	c
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))
278	c
279	c run_off_lic_0
280	c
281	CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
282	c
283	c
284	!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
285	c
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 !!!!!!!!!!!!!!!!!!!!!!!!!
300	cIM ajout zmax0, f0, ema_work1, ema_work2
301	cIM 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
311	c 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
324	c 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	END IF
340
341	CALL close_restartphy
342	!$OMP BARRIER
343	RETURN
344	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format