Context Navigation

physdem1.F @ 1145

Last change on this file since 1145 was 993, checked in by emillour, 11 years ago

Generic GCM:

Some more cleanup in dynamics:
- Moved "start2archive" (and auxilliary routines) to phystd
- removed unused (obsolete) testharm.F , para_netcdf.h , readhead_NC.F , angtot.h from dyn3d
- removed obsolete addit.F (and change corresponding lines in gcm)
- remove unused "description.h" (and many places where it was "included")

File size: 22.5 KB

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

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

Download in other formats:

Original Format