Context Navigation

phyredem.F @ 1337

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

No idea why or how that line was commented out in this release

Aucune idée de comment cette ligne a pu être commentée

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	!
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
17	IMPLICIT none
18	c======================================================================
19	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
20	c Objet: Ecriture de l'etat de redemarrage pour la physique
21	c======================================================================
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"
30	c======================================================================
31	CHARACTER() fichnom
32
33	c 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)
47	c
48	INTEGER nid, nvarid, idim1, idim2, idim3
49	INTEGER ierr
50	INTEGER length
51	PARAMETER (length=100)
52	REAL tab_cntrl(length)
53	c
54	INTEGER isoil, nsrf
55	CHARACTER (len=7) :: str7
56	CHARACTER (len=2) :: str2
57	INTEGER :: it, iiq
58
59	c======================================================================
60	c
61	c Get variables which will be written to restart file from module
62	c pbl_surface_mod
63	CALL pbl_surface_final(qsol, fder, snow, qsurf,
64	$ evap, frugs, agesno, tsoil)
65
66	c Get a variable calculated in module fonte_neige_mod
67	CALL fonte_neige_final(run_off_lic_0)
68
69	c======================================================================
70
71	CALL open_restartphy(fichnom)
72
73	DO ierr = 1, length
74	tab_cntrl(ierr) = 0.0
75	ENDDO
76	tab_cntrl(1) = dtime
77	tab_cntrl(2) = radpas
78	c 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
94	c co2_ppm0 : initial value of atmospheric CO2
95	tab_cntrl(16) = co2_ppm0
96	c
97	CALL put_var("controle","Parametres de controle",tab_cntrl)
98	c
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
105	c
106	C PB ajout du masque terre/mer
107	C
108	CALL put_field("masque","masque terre mer",zmasq)
109
110	c BP ajout des fraction de chaque sous-surface
111	C
112	C 1. fraction de terre
113	C
114	CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
115	C
116	C 2. Fraction de glace de terre
117	C
118	CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
119	C
120	C 3. fraction ocean
121	C
122	CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
123	C
124	C 4. Fraction glace de mer
125	C
126	CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
127	C
128	C
129	c
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
140	c
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
153	c
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
164	C
165	CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
166	c
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
188	c
189	c
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
201	c
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
213	c
214	CALL put_field("RADS","Rayonnement net a la surface",radsol)
215	c
216	CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
217	c
218	CALL put_field("sollw","Rayonnement IF a la surface",sollw)
219	c
220	CALL put_field("fder","Derive de flux",fder)
221	c
222	CALL put_field("rain_f","precipitation liquide",rain_fall)
223	c
224	CALL put_field("snow_f", "precipitation solide",snow_fall)
225	c
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
236	c
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
248	c
249	CALL put_field("ZMEA","",zmea)
250	c
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))
277	c
278	c run_off_lic_0
279	c
280	CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
281	c
282	c
283	!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
284	c
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 !!!!!!!!!!!!!!!!!!!!!!!!!
299	cIM ajout zmax0, f0, ema_work1, ema_work2
300	cIM 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
310	c 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.

Download in other formats:

Original Format