Context Navigation

phyredem.F @ 1201

Last change on this file since 1201 was 1191, checked in by jghattas, 15 years ago

Reecriture de phytrac et les routines concernes (Anthony Jamelot)

les suffix change de F -> F90 (nflxtr.F90,cltracrn.F90,initrrnpb.F90,cvltr.F90,minmaxqfi.F90,cltrac.F90,phytrac.F90)

Traitement d'un nouveau traceur berelium (optionel, toujours pour des
tests)(Anthony Jamelot)

radiornpb.F change du nom pour radio_decay.F90 car il traite maintenant tout les traceurs radioactives
ajoute init_be.F90

Nouveau interface dans phytrac pour serparer les calculs et appels
specifique a INCA avec les traitements des traceurs specifiques au LMDZ
(JG)

ajoute tracinca_mod.F90 pour les appeles a INCA
ajoute traclmdz_mod.F90 pour les calculs des traceurs specifiques a LMDZ
enleve fichier restartrac et ajoute la variable trs dans restartphy.nc

La convergence numerique a etait rompue uniquement pour les traceurs
LMDZ RN et PB.

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

File size: 8.7 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	tab_cntrl(3) = co2_ppm
79	tab_cntrl(4) = solaire
80	tab_cntrl(5) = iflag_con
81	tab_cntrl(6) = nbapp_rad
82
83	IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
84	IF( soil_model ) tab_cntrl( 8 ) = 1.
85	IF( new_oliq ) tab_cntrl( 9 ) = 1.
86	IF( ok_orodr ) tab_cntrl(10 ) = 1.
87	IF( ok_orolf ) tab_cntrl(11 ) = 1.
88
89	tab_cntrl(13) = day_end
90	tab_cntrl(14) = annee_ref
91	tab_cntrl(15) = itau_phy
92	c
93	CALL put_var("controle","Parametres de controle",tab_cntrl)
94	c
95
96	CALL put_field("longitude",
97	. "Longitudes de la grille physique",rlon)
98
99	CALL put_field("latitude","Latitudes de la grille physique",rlat)
100
101	c
102	C PB ajout du masque terre/mer
103	C
104	CALL put_field("masque","masque terre mer",zmasq)
105
106	c BP ajout des fraction de chaque sous-surface
107	C
108	C 1. fraction de terre
109	C
110	CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
111	C
112	C 2. Fraction de glace de terre
113	C
114	CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
115	C
116	C 3. fraction ocean
117	C
118	CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
119	C
120	C 4. Fraction glace de mer
121	C
122	CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
123	C
124	C
125	c
126	DO nsrf = 1, nbsrf
127	IF (nsrf.LE.99) THEN
128	WRITE(str2,'(i2.2)') nsrf
129	CALL put_field("TS"//str2,"Temperature de surface No."//str2,
130	. ftsol(:,nsrf))
131	ELSE
132	PRINT*, "Trop de sous-mailles"
133	CALL abort
134	ENDIF
135	ENDDO
136	c
137	DO nsrf = 1, nbsrf
138	DO isoil=1, nsoilmx
139	IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
140	WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
141	CALL put_field("Tsoil"//str7,"Temperature du sol No."//str7,
142	. tsoil(:,isoil,nsrf))
143	ELSE
144	PRINT*, "Trop de couches"
145	CALL abort
146	ENDIF
147	ENDDO
148	ENDDO
149	c
150	DO nsrf = 1, nbsrf
151	IF (nsrf.LE.99) THEN
152	WRITE(str2,'(i2.2)') nsrf
153	CALL put_field("QS"//str2,"Humidite de surface No."//str2,
154	. qsurf(:,nsrf))
155	ELSE
156	PRINT*, "Trop de sous-mailles"
157	CALL abort
158	ENDIF
159	END DO
160	C
161	CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
162	c
163	DO nsrf = 1, nbsrf
164	IF (nsrf.LE.99) THEN
165	WRITE(str2,'(i2.2)') nsrf
166	CALL put_field("ALBE"//str2,"albedo de surface No."//str2,
167	. falb1(:,nsrf))
168	ELSE
169	PRINT*, "Trop de sous-mailles"
170	CALL abort
171	ENDIF
172	ENDDO
173
174	DO nsrf = 1, nbsrf
175	IF (nsrf.LE.99) THEN
176	WRITE(str2,'(i2.2)') nsrf
177	CALL put_field("ALBLW"//str2,"albedo LW de surface No."//str2,
178	. falb2(:,nsrf))
179	ELSE
180	PRINT*, "Trop de sous-mailles"
181	CALL abort
182	ENDIF
183	ENDDO
184	c
185	c
186	DO nsrf = 1, nbsrf
187	IF (nsrf.LE.99) THEN
188	WRITE(str2,'(i2.2)') nsrf
189	CALL put_field("EVAP"//str2,"Evaporation de surface No."//str2
190	. ,evap(:,nsrf))
191	ELSE
192	PRINT*, "Trop de sous-mailles"
193	CALL abort
194	ENDIF
195	ENDDO
196
197	c
198	DO nsrf = 1, nbsrf
199	IF (nsrf.LE.99) THEN
200	WRITE(str2,'(i2.2)') nsrf
201	CALL put_field("SNOW"//str2,"Neige de surface No."//str2,
202	. snow(:,nsrf))
203	ELSE
204	PRINT*, "Trop de sous-mailles"
205	CALL abort
206	ENDIF
207	ENDDO
208
209	c
210	CALL put_field("RADS","Rayonnement net a la surface",radsol)
211	c
212	CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
213	c
214	CALL put_field("sollw","Rayonnement IF a la surface",sollw)
215	c
216	CALL put_field("fder","Derive de flux",fder)
217	c
218	CALL put_field("rain_f","precipitation liquide",rain_fall)
219	c
220	CALL put_field("snow_f", "precipitation solide",snow_fall)
221	c
222	DO nsrf = 1, nbsrf
223	IF (nsrf.LE.99) THEN
224	WRITE(str2,'(i2.2)') nsrf
225	CALL put_field("RUG"//str2,"rugosite de surface No."//str2,
226	. frugs(:,nsrf))
227	ELSE
228	PRINT*, "Trop de sous-mailles"
229	CALL abort
230	ENDIF
231	ENDDO
232	c
233	DO nsrf = 1, nbsrf
234	IF (nsrf.LE.99) THEN
235	WRITE(str2,'(i2.2)') nsrf
236	CALL put_field("AGESNO"//str2,
237	. "Age de la neige surface No."//str2,
238	. agesno(:,nsrf))
239	ELSE
240	PRINT*, "Trop de sous-mailles"
241	CALL abort
242	ENDIF
243	ENDDO
244	c
245	CALL put_field("ZMEA","",zmea)
246	c
247	CALL put_field("ZSTD","",zstd)
248
249	CALL put_field("ZSIG","",zsig)
250
251	CALL put_field("ZGAM","",zgam)
252
253	CALL put_field("ZTHE","",zthe)
254
255	CALL put_field("ZPIC","",zpic)
256
257	CALL put_field("ZVAL","",zval)
258
259	CALL put_field("RUGSREL","RUGSREL",rugoro)
260
261	CALL put_field("TANCIEN","",t_ancien)
262
263	CALL put_field("QANCIEN","",q_ancien)
264
265	CALL put_field("RUGMER","Longueur de rugosite sur mer",
266	. frugs(:,is_oce))
267
268	CALL put_field("CLWCON","Eau liquide convective",clwcon(:,1))
269
270	CALL put_field("RNEBCON","Nebulosite convective",rnebcon(:,1))
271
272	CALL put_field("RATQS", "Ratqs",ratqs(:,1))
273	c
274	c run_off_lic_0
275	c
276	CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
277	c
278	c
279	!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
280	c
281	IF (iflag_pbl>1) then
282	DO nsrf = 1, nbsrf
283	IF (nsrf.LE.99) THEN
284	WRITE(str2,'(i2.2)') nsrf
285	CALL put_field("TKE"//str2,"Energ. Cineti. Turb."//str2,
286	. pbl_tke(:,1:klev,nsrf))
287	ELSE
288	PRINT*, "Trop de sous-mailles"
289	CALL abort
290	ENDIF
291	ENDDO
292	ENDIF
293
294	!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
295	cIM ajout zmax0, f0, ema_work1, ema_work2
296	cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_fip
297
298	CALL put_field("ZMAX0","",zmax0)
299
300	CALL put_field("F0","",f0)
301
302	CALL put_field("EMA_WORK1","",ema_work1)
303
304	CALL put_field("EMA_WORK2","",ema_work2)
305
306	c wake_deltat
307	CALL put_field("WAKE_DELTAT","",wake_deltat)
308
309	CALL put_field("WAKE_DELTAQ","",wake_deltaq)
310
311	CALL put_field("WAKE_S","",wake_s)
312
313	CALL put_field("WAKE_CSTAR","",wake_cstar)
314
315	CALL put_field("WAKE_FIP","",wake_fip)
316
317
318	! trs from traclmdz_mod
319	IF (type_trac == 'lmdz') THEN
320	CALL traclmdz_to_restart(trs)
321	DO it=1,nbtr
322	iiq=niadv(it+2)
323	CALL put_field("trs_"//tname(iiq),"",trs(:,it))
324	END DO
325	END IF
326
327	CALL close_restartphy
328	!$OMP BARRIER
329	RETURN
330	END

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

Download in other formats:

Original Format