Context Navigation

physdem1.F @ 220

Last change on this file since 220 was 135, checked in by aslmd, 14 years ago
CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET
File size: 20.6 KB

Line
1	subroutine physdem1(filename,lonfi,latfi,nsoil,nq,
2	. phystep,day_ini,
3	. time,tsurf,tsoil,emis,q2,qsurf,
4	. airefi,alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
5
6
7
8	use radcommon_h, only: tauvis
9
10	implicit none
11	c-------------------------------------------------------------
12	c
13	c create physics (re-)start data file "restartfi.nc"
14	c
15	c
16	c
17	#include "dimensions.h"
18	#include "paramet.h"
19	c-----------------------------------------------------------------------
20	#include "comvert.h"
21	#include "comgeom2.h"
22	#include "control.h"
23	#include "comdissnew.h"
24	#include "logic.h"
25	#include "ener.h"
26	#include "netcdf.inc"
27	#include "dimphys.h"
28	#include"advtrac.h"
29	#include"callkeys.h"
30
31	INTEGER nid,iq
32	INTEGER, parameter :: ivap=1
33	REAL, parameter :: qsolmax= 150.0
34	character (len=*) :: filename
35	character (len=7) :: str7
36
37	REAL day_ini
38	INTEGER nsoil,nq
39	integer ierr,idim1,idim2,idim3,idim4,idim5,nvarid
40
41	c
42	REAL phystep,time
43	REAL latfi(ngridmx), lonfi(ngridmx)
44	! REAL champhys(ngridmx)
45	REAL tsurf(ngridmx)
46	INTEGER length
47	PARAMETER (length=100)
48	REAL tab_cntrl(length)
49
50	c
51
52	! EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
53	! EXTERNAL exner_hyb , SSUM
54	c
55	#include "serre.h"
56	#include "clesph0.h"
57	#include "fxyprim.h"
58	#include "comgeomfi.h"
59	#include "surfdat.h"
60	#include "comsoil.h"
61	#include "planete.h"
62	#include "comcstfi.h"
63
64	real tsoil(ngridmx,nsoil),emis(ngridmx)
65	real q2(ngridmx, llm+1),qsurf(ngridmx,nq)
66	real airefi(ngridmx)
67	real alb(ngridmx),ith(ngridmx,nsoil)
68	real pzmea(ngridmx),pzstd(ngridmx)
69	real pzsig(ngridmx),pzgam(ngridmx),pzthe(ngridmx)
70	integer ig
71	INTEGER lnblnk
72	EXTERNAL lnblnk
73
74	! flag which identifies if we are using old tracer names (qsurf01,...)
75	logical :: oldtracernames=.false.
76	integer :: count
77	character(len=30) :: txt ! to store some text
78	! indexes of water vapour & water ice tracers (if any):
79	integer :: i_h2o_vap=0
80	integer :: i_h2o_ice=0
81	c-----------------------------------------------------------------------
82
83	! copy airefi(:) to area(:)
84	CALL SCOPY(ngridmx,airefi,1,area,1)
85	! note: area() is defined in comgeomfi.h
86
87	DO ig=1,ngridmx
88	albedodat(ig)=alb(ig) ! note: albedodat() is defined in surfdat.h
89	zmea(ig)=pzmea(ig) ! note: zmea() is defined in surfdat.h
90	zstd(ig)=pzstd(ig) ! note: zstd() is defined in surfdat.h
91	zsig(ig)=pzsig(ig) ! note: zsig() is defined in surfdat.h
92	zgam(ig)=pzgam(ig) ! note: zgam() is defined in surfdat.h
93	zthe(ig)=pzthe(ig) ! note: zthe() is defined in surfdat.h
94	ENDDO
95
96	inertiedat(:,:)=ith(:,:) ! note inertiedat() is defined in comsoil.h
97	c
98	c things to store in the physics start file:
99	c
100	ierr = NF_CREATE(adjustl(filename),NF_CLOBBER, nid)
101	IF (ierr.NE.NF_NOERR) THEN
102	WRITE(6,*)'physdem1: Problem creating file ',adjustl(filename)
103	write(6,*) NF_STRERROR(ierr)
104	CALL ABORT
105	ENDIF
106	c
107	print*,'we got this far'
108
109	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
110	. "Physics start file")
111	c
112	ierr = NF_DEF_DIM (nid,"index",length,idim1)
113	if (ierr.ne.NF_NOERR) then
114	WRITE(6,*)'physdem1: Problem defining index dimension'
115	write(6,*) NF_STRERROR(ierr)
116	call abort
117	endif
118	c
119	ierr = NF_DEF_DIM (nid,"physical_points",ngridmx,idim2)
120	if (ierr.ne.NF_NOERR) then
121	WRITE(6,*)'physdem1: Problem defining physical_points dimension'
122	write(6,*) NF_STRERROR(ierr)
123	call abort
124	endif
125	c
126	ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoil,idim3)
127	if (ierr.ne.NF_NOERR) then
128	WRITE(6,*)'physdem1: Problem defining subsurface_layers dimension'
129	write(6,*) NF_STRERROR(ierr)
130	call abort
131	endif
132	c
133	! ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
134	ierr = NF_DEF_DIM (nid,"nlayer_plus_1",llm+1,idim4)
135	if (ierr.ne.NF_NOERR) then
136	WRITE(6,*)'physdem1: Problem defining nlayer+1 dimension'
137	write(6,*) NF_STRERROR(ierr)
138	call abort
139	endif
140	c
141	ierr = NF_DEF_DIM (nid,"number_of_advected_fields",nq,idim5)
142	if (ierr.ne.NF_NOERR) then
143	WRITE(6,*)'physdem1: Problem defining advected fields dimension'
144	WRITE(6,*)' nq = ',nq,' and ierr = ', ierr
145	write(6,*) NF_STRERROR(ierr)
146	endif
147
148	ierr = NF_ENDDEF(nid) ! exit NetCDF define mode
149
150	c clear tab_cntrl(:) array
151	DO ierr = 1, length
152	tab_cntrl(ierr) = 0.0
153	ENDDO
154
155	write(,) "physdem1: ngridmx: ",ngridmx
156
157	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
158	c Fill control array tab_cntrl(:) with paramleters for this run
159	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
160	c Informations on the physics grid
161	tab_cntrl(1) = float(ngridmx) ! number of nodes on physics grid
162	tab_cntrl(2) = float(nlayermx) ! number of atmospheric layers
163	tab_cntrl(3) = day_ini + int(time) ! initial day
164	tab_cntrl(4) = time -int(time) ! initiale time of day
165
166	c Informations about Mars, used by dynamics and physics
167	tab_cntrl(5) = rad ! radius of Mars (m) ~3397200
168	tab_cntrl(6) = omeg ! rotation rate (rad.s-1)
169	tab_cntrl(7) = g ! gravity (m.s-2) ~3.72
170	tab_cntrl(8) = mugaz ! Molar mass of the atmosphere (g.mol-1) ~43.49
171	tab_cntrl(9) = rcp ! = r/cp ~0.256793 (=kappa dans dynamique)
172	tab_cntrl(10) = daysec ! length of a sol (s) ~88775
173
174	tab_cntrl(11) = phystep ! time step in the physics
175	tab_cntrl(12) = 0.
176	tab_cntrl(13) = 0.
177
178	c Informations about Mars, only for physics
179	tab_cntrl(14) = year_day ! length of year (sols) ~668.6
180	tab_cntrl(15) = periheli ! min. Sun-Mars distance (Mkm) ~206.66
181	tab_cntrl(16) = aphelie ! max. SUn-Mars distance (Mkm) ~249.22
182	tab_cntrl(17) = peri_day ! date of perihelion (sols since N. spring)
183	tab_cntrl(18) = obliquit ! Obliquity of the planet (deg) ~23.98
184
185	c Boundary layer and turbulence
186	tab_cntrl(19) = z0 ! surface roughness (m) ~0.01
187	tab_cntrl(20) = lmixmin ! mixing length ~100
188	tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
189
190	c Optical properties of polar caps and ground emissivity
191	tab_cntrl(22) = albedice(1) ! Albedo of northern cap ~0.5
192	tab_cntrl(23) = albedice(2) ! Albedo of southern cap ~0.5
193	tab_cntrl(24) = emisice(1) ! Emissivity of northern cap ~0.95
194	tab_cntrl(25) = emisice(2) ! Emissivity of southern cap ~0.95
195	tab_cntrl(26) = emissiv ! Emissivity of martian soil ~.95
196	tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
197	tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
198	tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
199	tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
200
201	c dust aerosol properties
202	tab_cntrl(27) = tauvis ! mean visible optical depth
203
204	tab_cntrl(28) = 0.
205	tab_cntrl(29) = 0.
206	tab_cntrl(30) = 0.
207
208	! Soil properties:
209	tab_cntrl(35) = volcapa ! soil volumetric heat capacity
210
211
212	! write(,) "physdem1: tab_cntrl():",tab_cntrl
213
214	ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
215	IF (ierr.NE.NF_NOERR) THEN
216	PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
217	CALL abort
218	ENDIF
219	! define variable
220	#ifdef NC_DOUBLE
221	ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
222	#else
223	ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
224	#endif
225	IF (ierr.NE.NF_NOERR) THEN
226	PRINT*, 'physdem1: Failed to define controle'
227	CALL abort
228	ENDIF
229	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
230	. "Control parameters")
231	IF (ierr.NE.NF_NOERR) THEN
232	PRINT*, 'physdem1: Failed to define controle title attribute'
233	CALL abort
234	ENDIF
235	ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
236	IF (ierr.NE.NF_NOERR) THEN
237	PRINT*, 'physdem1: Failed to swich out of NetCDF define mode'
238	CALL abort
239	ENDIF
240	! write variable
241	#ifdef NC_DOUBLE
242	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
243	#else
244	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
245	#endif
246	IF (ierr.NE.NF_NOERR) THEN
247	PRINT*, 'physdem1: Failed to write controle data'
248	CALL abort
249	ENDIF
250
251	! write mid-layer depths mlayer() !known from comsoil.h
252
253	ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
254	! define variable
255	#ifdef NC_DOUBLE
256	ierr = NF_DEF_VAR (nid,"soildepth",NF_DOUBLE,1,idim3,nvarid)
257	#else
258	ierr = NF_DEF_VAR (nid,"soildepth",NF_FLOAT,1,idim3,nvarid)
259	#endif
260	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
261	. "Soil mid-layer depth")
262	ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
263	! write variable
264	#ifdef NC_DOUBLE
265	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
266	#else
267	ierr = NF_PUT_VAR_REAL (nid,nvarid,mlayer)
268	#endif
269
270	c
271
272	ierr = NF_REDEF (nid)
273	#ifdef NC_DOUBLE
274	ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
275	#else
276	ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
277	#endif
278	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 26,
279	. "Longitudes of physics grid")
280	ierr = NF_ENDDEF(nid)
281
282	#ifdef NC_DOUBLE
283	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
284	#else
285	ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
286	#endif
287
288	c
289
290	ierr = NF_REDEF (nid)
291	#ifdef NC_DOUBLE
292	ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
293	#else
294	ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
295	#endif
296	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
297	. "Latitudes of physics grid")
298	ierr = NF_ENDDEF(nid)
299	#ifdef NC_DOUBLE
300	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
301	#else
302	ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
303	#endif
304
305	c
306
307	ierr = NF_REDEF (nid)
308	#ifdef NC_DOUBLE
309	ierr = NF_DEF_VAR (nid, "area", NF_DOUBLE, 1, idim2,nvarid)
310	#else
311	ierr = NF_DEF_VAR (nid, "area", NF_FLOAT, 1, idim2,nvarid)
312	#endif
313	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
314	. "Mesh area")
315	ierr = NF_ENDDEF(nid)
316	#ifdef NC_DOUBLE
317	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
318	#else
319	ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
320	#endif
321
322	c
323
324	ierr = NF_REDEF (nid)
325	#ifdef NC_DOUBLE
326	ierr = NF_DEF_VAR (nid, "phisfi", NF_DOUBLE, 1, idim2,nvarid)
327	#else
328	ierr = NF_DEF_VAR (nid, "phisfi", NF_FLOAT, 1, idim2,nvarid)
329	#endif
330	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
331	. "Geopotential at the surface")
332	ierr = NF_ENDDEF(nid)
333	#ifdef NC_DOUBLE
334	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phisfi)
335	#else
336	ierr = NF_PUT_VAR_REAL (nid,nvarid,phisfi)
337	#endif
338
339	c
340
341	ierr = NF_REDEF (nid)
342	#ifdef NC_DOUBLE
343	ierr = NF_DEF_VAR (nid, "albedodat", NF_DOUBLE, 1, idim2,nvarid)
344	#else
345	ierr = NF_DEF_VAR (nid, "albedodat", NF_FLOAT, 1, idim2,nvarid)
346	#endif
347	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 21,
348	. "Albedo of bare ground")
349	ierr = NF_ENDDEF(nid)
350	#ifdef NC_DOUBLE
351	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedodat)
352	#else
353	ierr = NF_PUT_VAR_REAL (nid,nvarid,albedodat)
354	#endif
355
356	c
357	c some data for Francois Lott's programs
358	c
359
360	ierr = NF_REDEF (nid)
361	#ifdef NC_DOUBLE
362	ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
363	#else
364	ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
365	#endif
366	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
367	. "Relief: mean relief")
368	ierr = NF_ENDDEF(nid)
369	#ifdef NC_DOUBLE
370	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
371	#else
372	ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
373	#endif
374	c
375	ierr = NF_REDEF (nid)
376	#ifdef NC_DOUBLE
377	ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
378	#else
379	ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
380	#endif
381	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
382	. "Relief: standard deviation")
383	ierr = NF_ENDDEF(nid)
384	#ifdef NC_DOUBLE
385	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
386	#else
387	ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
388	#endif
389	c
390	ierr = NF_REDEF (nid)
391	#ifdef NC_DOUBLE
392	ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
393	#else
394	ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
395	#endif
396	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
397	. "Relief: sigma parameter")
398	ierr = NF_ENDDEF(nid)
399	#ifdef NC_DOUBLE
400	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
401	#else
402	ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
403	#endif
404	c
405	ierr = NF_REDEF (nid)
406	#ifdef NC_DOUBLE
407	ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
408	#else
409	ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
410	#endif
411	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
412	. "Relief: gamma parameter")
413	ierr = NF_ENDDEF(nid)
414	#ifdef NC_DOUBLE
415	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
416	#else
417	ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
418	#endif
419	c
420	ierr = NF_REDEF (nid)
421	#ifdef NC_DOUBLE
422	ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
423	#else
424	ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
425	#endif
426	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
427	. "Relief: theta parameter")
428	ierr = NF_ENDDEF(nid)
429	#ifdef NC_DOUBLE
430	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
431	#else
432	ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
433	#endif
434
435	c Write the physical fields
436
437	! CO2 Ice Cover
438	!
439	! ierr = NF_REDEF (nid)
440	!#ifdef NC_DOUBLE
441	! ierr = NF_DEF_VAR (nid, "co2ice", NF_DOUBLE, 1, idim2,nvarid)
442	!#else
443	! ierr = NF_DEF_VAR (nid, "co2ice", NF_FLOAT, 1, idim2,nvarid)
444	!#endif
445	! ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 13,
446	! . "CO2 ice cover")
447	! ierr = NF_ENDDEF(nid)
448	!#ifdef NC_DOUBLE
449	! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,co2ice)
450	!#else
451	! ierr = NF_PUT_VAR_REAL (nid,nvarid,co2ice)
452	!#endif
453
454	! Soil Thermal inertia
455
456	ierr = NF_REDEF (nid)
457	#ifdef NC_DOUBLE
458	ierr = NF_DEF_VAR (nid,"inertiedat",NF_DOUBLE,
459	& 2,(/idim2,idim3/),nvarid)
460	#else
461	ierr = NF_DEF_VAR (nid,"inertiedat",NF_FLOAT,
462	& 2,(/idim2,idim3/),nvarid)
463	#endif
464	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 20,
465	. "Soil thermal inertia")
466	ierr = NF_ENDDEF(nid)
467	#ifdef NC_DOUBLE
468	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
469	#else
470	ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
471	#endif
472
473	! Surface temperature
474
475	ierr = NF_REDEF (nid)
476	#ifdef NC_DOUBLE
477	ierr = NF_DEF_VAR (nid, "tsurf", NF_DOUBLE, 1, idim2,nvarid)
478	#else
479	ierr = NF_DEF_VAR (nid, "tsurf", NF_FLOAT, 1, idim2,nvarid)
480	#endif
481	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
482	. "Surface temperature")
483	ierr = NF_ENDDEF(nid)
484	#ifdef NC_DOUBLE
485	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsurf)
486	#else
487	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsurf)
488	#endif
489
490	! Soil temperature
491
492	ierr = NF_REDEF (nid)
493	#ifdef NC_DOUBLE
494	ierr = NF_DEF_VAR (nid,"tsoil",NF_DOUBLE,2,(/idim2,idim3/),nvarid)
495	#else
496	! ierr = NF_DEF_VAR (nid, "tsoil", NF_FLOAT, 2, idim2,nvarid)
497	ierr = NF_DEF_VAR (nid,"tsoil",NF_FLOAT,2,(/idim2,idim3/),nvarid)
498	#endif
499	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
500	. "Soil temperature")
501	ierr = NF_ENDDEF(nid)
502	#ifdef NC_DOUBLE
503	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil)
504	#else
505	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil)
506	#endif
507
508	c emissivity
509
510	ierr = NF_REDEF (nid)
511	#ifdef NC_DOUBLE
512	ierr = NF_DEF_VAR (nid, "emis", NF_DOUBLE, 1, idim2,nvarid)
513	#else
514	ierr = NF_DEF_VAR (nid, "emis", NF_FLOAT, 1, idim2,nvarid)
515	#endif
516	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
517	. "Surface emissivity")
518	ierr = NF_ENDDEF(nid)
519	#ifdef NC_DOUBLE
520	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,emis)
521	#else
522	ierr = NF_PUT_VAR_REAL (nid,nvarid,emis)
523	#endif
524
525	c planetary boundary layer
526
527	ierr = NF_REDEF (nid)
528	#ifdef NC_DOUBLE
529	ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 2, (/idim2,idim4/),nvarid)
530	#else
531	ierr = NF_DEF_VAR (nid, "q2", NF_FLOAT, 2,(/idim2,idim4/),nvarid)
532	#endif
533	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
534	. "pbl wind variance")
535	ierr = NF_ENDDEF(nid)
536	#ifdef NC_DOUBLE
537	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q2)
538	#else
539	ierr = NF_PUT_VAR_REAL (nid,nvarid,q2)
540	#endif
541	IF (ierr.NE.NF_NOERR) THEN
542	PRINT*, 'physdem1: Failed to write q2'
543	CALL abort
544	ENDIF
545
546	c tracers
547
548	! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
549	! qsurf02, ...)
550	count=0
551	do iq=1,nqmx
552	txt= " "
553	write(txt,'(a1,i2.2)')'q',iq
554	if (txt.ne.tnom(iq)) then ! use tracer names stored in dynamics
555	! did not find old tracer name
556	exit ! might as well stop here
557	else
558	! found old tracer name
559	count=count+1
560	endif
561	enddo
562	if (count.eq.nqmx) then
563	write(,) "physdem1:tracers seem to follow old naming ",
564	& "convention (qsurf01,qsurf02,...)"
565
566	call abort
567	!write(,) " => will work for now ... "
568	!write(,) " but you should run newstart to rename them"
569	!oldtracernames=.true.
570	! Moreover, if computing water cycle with ice, move surface ice
571	! back to qsurf(nqmx)
572	!IF (iceparty) THEN
573	! write(,)'physdem1: moving surface water ice to index ',nqmx
574	! qsurf(1:ngridmx,nqmx)=qsurf(1:ngridmx,nqmx-1)
575	! qsurf(1:ngridmx,nqmx-1)=0
576	!ENDIF
577	endif ! of if (count.eq.nqmx)
578
579	IF(nq.GE.1) THEN
580	! preliminary stuff: look for water vapour & water ice tracers (if any)
581	if (.not.oldtracernames) then
582	do iq=1,nq
583	if (tnom(iq).eq."h2o_vap") then
584	i_h2o_vap=iq
585	endif
586	if (tnom(iq).eq."h2o_ice") then
587	i_h2o_ice=iq
588	endif
589	enddo ! of iq=1,nq
590	! handle special case of only water vapour tracer (no ice)
591	if ((i_h2o_vap.ne.0).and.(i_h2o_ice.eq.0)) then
592	! then the index of (surface) ice is i_h2o_vap
593	i_h2o_ice=i_h2o_vap
594	endif
595	endif ! of if (.not.oldtracernames)
596
597	DO iq=1,nq
598	IF (oldtracernames) THEN
599	txt=" "
600	write(txt,'(a5,i2.2)')'qsurf',iq
601	ELSE
602	txt=tnom(iq)
603	! Exception: there is no water vapour surface tracer
604	if (txt.eq."h2o_vap") then
605	write(,)"physdem1: skipping water vapour tracer"
606	if (i_h2o_ice.eq.i_h2o_vap) then
607	! then there is no "water ice" tracer; but still
608	! there is some water ice on the surface
609	write(,)" writting water ice instead"
610	txt="h2o_ice"
611	else
612	! there is a "water ice" tracer which has been / will be
613	! delt with in due time
614	cycle
615	endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
616	endif ! of if (txt.eq."h2o_vap")
617	ENDIF ! of IF (oldtracernames)
618
619	ierr=NF_REDEF(nid)
620	IF (ierr.NE.NF_NOERR) THEN
621	PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
622	CALL abort
623	ENDIF
624	#ifdef NC_DOUBLE
625	ierr=NF_DEF_VAR(nid,txt,NF_DOUBLE,1,idim2,nvarid)
626	#else
627	ierr=NF_DEF_VAR(nid,txt,NF_FLOAT,1,idim2,nvarid)
628	#endif
629	IF (ierr.NE.NF_NOERR) THEN
630	PRINT*, 'physdem1: Failed to define ',trim(txt)
631	CALL abort
632	ENDIF
633	ierr=NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
634	& "tracer on surface")
635	IF (ierr.NE.NF_NOERR) THEN
636	PRINT*, 'physdem1: Failed to define ',trim(txt),
637	& ' title attribute'
638	CALL abort
639	ENDIF
640	ierr=NF_ENDDEF(nid)
641	IF (ierr.NE.NF_NOERR) THEN
642	PRINT*, 'physdem1: Failed to swich out of define mode'
643	CALL abort
644	ENDIF
645
646	#ifdef NC_DOUBLE
647	ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
648	#else
649	ierr=NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
650	#endif
651	IF (ierr.NE.NF_NOERR) THEN
652	PRINT*, 'physdem1: Failed to write ',trim(txt)
653	CALL abort
654	ENDIF
655	ENDDO ! of DO iq=1,nq
656	ENDIF ! of IF(nq.GE.1)
657
658	c close file
659	ierr = NF_CLOSE(nid)
660
661	RETURN
662
663	END

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

Download in other formats:

Original Format