Context Navigation

physdem1.F @ 588

Last change on this file since 588 was 588, checked in by emillour, 13 years ago

Generic GCM:
Some cleanup and bug fixing:

"cloudfrac" was not well written to restartfi (wrong size).
missing save attribute for "reffrad" in physiq.F90.
cleanup recomputation of surface pressure in newstart and change loop order in interp_horiz (which "fixes" an odd behaviour which fills some arrays with zeros, but only when using some versions of ifort!)

File size: 22.4 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	. cloudfrac,totcloudfrac,hice)
6
7	use radcommon_h, only: tauvis
8
9	implicit none
10
11	!==================================================================
12	!
13	! Purpose
14	! -------
15	! Create physics (re-)start data file "restartfi.nc"
16	!
17	! Called by
18	! ---------
19	! rcm1d.F90
20	! physiq.F90
21	! newstart.F
22	!
23	! Calls
24	! -----
25	! none
26	!
27	!==================================================================
28
29	#include "dimensions.h"
30	#include "paramet.h"
31	#include "comvert.h"
32	#include "comgeom2.h"
33	#include "control.h"
34	#include "comdissnew.h"
35	#include "logic.h"
36	#include "ener.h"
37	#include "netcdf.inc"
38	#include "dimphys.h"
39	#include"advtrac.h"
40	#include"callkeys.h"
41
42	INTEGER nid,iq
43	INTEGER, parameter :: ivap=1
44	REAL, parameter :: qsolmax= 150.0
45	character (len=*) :: filename
46	character (len=7) :: str7
47
48	REAL day_ini
49	INTEGER nsoil,nq
50	integer ierr,idim1,idim2,idim3,idim4,idim5,idim6,nvarid
51
52	REAL phystep,time
53	REAL latfi(ngridmx), lonfi(ngridmx)
54	! REAL champhys(ngridmx)
55	REAL tsurf(ngridmx)
56	INTEGER length
57	PARAMETER (length=100)
58	REAL tab_cntrl(length)
59
60	! added by BC
61	REAL hice(ngridmx),cloudfrac(ngridmx,nlayermx)
62	REAL totcloudfrac(ngridmx)
63
64
65	! EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
66	! EXTERNAL exner_hyb , SSUM
67
68	#include "serre.h"
69	#include "clesph0.h"
70	#include "fxyprim.h"
71	#include "comgeomfi.h"
72	#include "surfdat.h"
73	#include "comsoil.h"
74	#include "planete.h"
75	#include "comcstfi.h"
76
77	real tsoil(ngridmx,nsoil),emis(ngridmx)
78	real q2(ngridmx, llm+1),qsurf(ngridmx,nq)
79	real airefi(ngridmx)
80	real alb(ngridmx),ith(ngridmx,nsoil)
81	real pzmea(ngridmx),pzstd(ngridmx)
82	real pzsig(ngridmx),pzgam(ngridmx),pzthe(ngridmx)
83	integer ig
84
85	! flag which identifies if we are using old tracer names (qsurf01,...)
86	logical :: oldtracernames=.false.
87	integer :: count
88	character(len=30) :: txt ! to store some text
89	! indexes of water vapour & water ice tracers (if any):
90	integer :: i_h2o_vap=0
91	integer :: i_h2o_ice=0
92	c-----------------------------------------------------------------------
93
94	! copy airefi(:) to area(:)
95	CALL SCOPY(ngridmx,airefi,1,area,1)
96	! note: area() is defined in comgeomfi.h
97
98	DO ig=1,ngridmx
99	albedodat(ig)=alb(ig) ! note: albedodat() is defined in surfdat.h
100	zmea(ig)=pzmea(ig) ! note: zmea() is defined in surfdat.h
101	zstd(ig)=pzstd(ig) ! note: zstd() is defined in surfdat.h
102	zsig(ig)=pzsig(ig) ! note: zsig() is defined in surfdat.h
103	zgam(ig)=pzgam(ig) ! note: zgam() is defined in surfdat.h
104	zthe(ig)=pzthe(ig) ! note: zthe() is defined in surfdat.h
105	ENDDO
106
107	inertiedat(:,:)=ith(:,:) ! note inertiedat() is defined in comsoil.h
108	c
109	c things to store in the physics start file:
110	c
111	ierr = NF_CREATE(adjustl(filename),NF_CLOBBER, nid)
112	IF (ierr.NE.NF_NOERR) THEN
113	WRITE(6,*)'physdem1: Problem creating file ',adjustl(filename)
114	write(6,*) NF_STRERROR(ierr)
115	CALL ABORT
116	ENDIF
117	c
118	print*,'we got this far'
119
120	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
121	. "Physics start file")
122	c
123	ierr = NF_DEF_DIM (nid,"index",length,idim1)
124	if (ierr.ne.NF_NOERR) then
125	WRITE(6,*)'physdem1: Problem defining index dimension'
126	write(6,*) NF_STRERROR(ierr)
127	call abort
128	endif
129	c
130	ierr = NF_DEF_DIM (nid,"physical_points",ngridmx,idim2)
131	if (ierr.ne.NF_NOERR) then
132	WRITE(6,*)'physdem1: Problem defining physical_points dimension'
133	write(6,*) NF_STRERROR(ierr)
134	call abort
135	endif
136	c
137	ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoil,idim3)
138	if (ierr.ne.NF_NOERR) then
139	WRITE(6,*)'physdem1: Problem defining subsurface_layers dimension'
140	write(6,*) NF_STRERROR(ierr)
141	call abort
142	endif
143	c
144	ierr = NF_DEF_DIM (nid,"nlayer_plus_1",llm+1,idim4)
145	if (ierr.ne.NF_NOERR) then
146	WRITE(6,*)'physdem1: Problem defining nlayer+1 dimension'
147	write(6,*) NF_STRERROR(ierr)
148	call abort
149	endif
150	c
151	ierr = NF_DEF_DIM (nid,"number_of_advected_fields",nq,idim5)
152	if (ierr.ne.NF_NOERR) then
153	WRITE(6,*)'physdem1: Problem defining advected fields dimension'
154	WRITE(6,*)' nq = ',nq,' and ierr = ', ierr
155	write(6,*) NF_STRERROR(ierr)
156	endif
157
158	ierr = NF_DEF_DIM (nid,"nlayer",llm,idim6)
159	if (ierr.ne.NF_NOERR) then
160	WRITE(6,*)'physdem1: Problem defining nlayer dimension'
161	write(6,*) NF_STRERROR(ierr)
162	call abort
163	endif
164
165	ierr = NF_ENDDEF(nid) ! exit NetCDF define mode
166
167	c clear tab_cntrl(:) array
168	DO ierr = 1, length
169	tab_cntrl(ierr) = 0.0
170	ENDDO
171
172	write(,) "physdem1: ngridmx: ",ngridmx
173
174	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
175	c Fill control array tab_cntrl(:) with paramleters for this run
176	ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
177	c Informations on the physics grid
178	tab_cntrl(1) = float(ngridmx) ! number of nodes on physics grid
179	tab_cntrl(2) = float(nlayermx) ! number of atmospheric layers
180	tab_cntrl(3) = day_ini + int(time) ! initial day
181	tab_cntrl(4) = time -int(time) ! initiale time of day
182
183	c Informations about Mars, used by dynamics and physics
184	tab_cntrl(5) = rad ! radius of Mars (m) ~3397200
185	tab_cntrl(6) = omeg ! rotation rate (rad.s-1)
186	tab_cntrl(7) = g ! gravity (m.s-2) ~3.72
187	tab_cntrl(8) = mugaz ! Molar mass of the atmosphere (g.mol-1) ~43.49
188	tab_cntrl(9) = rcp ! = r/cp ~0.256793 (=kappa dans dynamique)
189	tab_cntrl(10) = daysec ! length of a sol (s) ~88775
190
191	tab_cntrl(11) = phystep ! time step in the physics
192	tab_cntrl(12) = 0.
193	tab_cntrl(13) = 0.
194
195	c Informations about Mars, only for physics
196	tab_cntrl(14) = year_day ! length of year (sols) ~668.6
197	tab_cntrl(15) = periastr ! min. star-planet distance (Mkm) ~206.66
198	tab_cntrl(16) = apoastr ! max. star-planet distance (Mkm) ~249.22
199	tab_cntrl(17) = peri_day ! date of periastron (sols since N. spring)
200	tab_cntrl(18) = obliquit ! Obliquity of the planet (deg) ~23.98
201
202	c Boundary layer and turbulence
203	tab_cntrl(19) = z0 ! surface roughness (m) ~0.01
204	tab_cntrl(20) = lmixmin ! mixing length ~100
205	tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
206
207	c Optical properties of polar caps and ground emissivity
208	tab_cntrl(22) = albedice(1) ! Albedo of northern cap ~0.5
209	tab_cntrl(23) = albedice(2) ! Albedo of southern cap ~0.5
210	tab_cntrl(24) = emisice(1) ! Emissivity of northern cap ~0.95
211	tab_cntrl(25) = emisice(2) ! Emissivity of southern cap ~0.95
212	tab_cntrl(26) = emissiv ! Emissivity of martian soil ~.95
213	tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
214	tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
215	tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
216	tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
217
218	c dust aerosol properties
219	tab_cntrl(27) = tauvis ! mean visible optical depth
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	! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
622	! qsurf02, ...)
623	count=0
624	do iq=1,nqmx
625	txt= " "
626	write(txt,'(a1,i2.2)')'q',iq
627	if (txt.ne.tnom(iq)) then ! use tracer names stored in dynamics
628	! did not find old tracer name
629	exit ! might as well stop here
630	else
631	! found old tracer name
632	count=count+1
633	endif
634	enddo
635	if (count.eq.nqmx) then
636	write(,) "physdem1:tracers seem to follow old naming ",
637	& "convention (qsurf01,qsurf02,...)"
638
639	call abort
640	!write(,) " => will work for now ... "
641	!write(,) " but you should run newstart to rename them"
642	!oldtracernames=.true.
643	! Moreover, if computing water cycle with ice, move surface ice
644	! back to qsurf(nqmx)
645	!IF (iceparty) THEN
646	! write(,)'physdem1: moving surface water ice to index ',nqmx
647	! qsurf(1:ngridmx,nqmx)=qsurf(1:ngridmx,nqmx-1)
648	! qsurf(1:ngridmx,nqmx-1)=0
649	!ENDIF
650	endif ! of if (count.eq.nqmx)
651
652	IF(nq.GE.1) THEN
653	! preliminary stuff: look for water vapour & water ice tracers (if any)
654	if (.not.oldtracernames) then
655	do iq=1,nq
656	if (tnom(iq).eq."h2o_vap") then
657	i_h2o_vap=iq
658	endif
659	if (tnom(iq).eq."h2o_ice") then
660	i_h2o_ice=iq
661	endif
662	enddo ! of iq=1,nq
663	! handle special case of only water vapour tracer (no ice)
664	if ((i_h2o_vap.ne.0).and.(i_h2o_ice.eq.0)) then
665	! then the index of (surface) ice is i_h2o_vap
666	print*,'water vapour but no water ice, WTF?'
667	call abort
668	i_h2o_ice=i_h2o_vap
669	endif
670	endif ! of if (.not.oldtracernames)
671
672	DO iq=1,nq
673	IF (oldtracernames) THEN
674	txt=" "
675	write(txt,'(a5,i2.2)')'qsurf',iq
676	ELSE
677	txt=tnom(iq)
678
679
680	! in new version, h2o_vap acts as liquid surface tracer
681	! so the section below is now redundant
682	! ------------------------------------------------------------------
683	! ! Exception: there is no water vapour surface tracer
684	! if (txt.eq."h2o_vap") then
685	! write(,)"physdem1: skipping water vapour tracer"
686	! if (i_h2o_ice.eq.i_h2o_vap) then
687	! ! then there is no "water ice" tracer; but still
688	! ! there is some water ice on the surface
689	! write(,)" writting water ice instead"
690	! txt="h2o_ice"
691	! else
692	! ! there is a "water ice" tracer which has been / will be
693	! ! delt with in due time
694	! cycle
695	! endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
696	! endif ! of if (txt.eq."h2o_vap")
697	! ------------------------------------------------------------------
698
699
700
701	ENDIF ! of IF (oldtracernames)
702
703	ierr=NF_REDEF(nid)
704	IF (ierr.NE.NF_NOERR) THEN
705	PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
706	CALL abort
707	ENDIF
708	#ifdef NC_DOUBLE
709	ierr=NF_DEF_VAR(nid,txt,NF_DOUBLE,1,idim2,nvarid)
710	#else
711	ierr=NF_DEF_VAR(nid,txt,NF_FLOAT,1,idim2,nvarid)
712	#endif
713	IF (ierr.NE.NF_NOERR) THEN
714	PRINT*, 'physdem1: Failed to define ',trim(txt)
715	CALL abort
716	ENDIF
717	ierr=NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
718	& "tracer on surface")
719	IF (ierr.NE.NF_NOERR) THEN
720	PRINT*, 'physdem1: Failed to define ',trim(txt),
721	& ' title attribute'
722	CALL abort
723	ENDIF
724	ierr=NF_ENDDEF(nid)
725	IF (ierr.NE.NF_NOERR) THEN
726	PRINT*, 'physdem1: Failed to swich out of define mode'
727	CALL abort
728	ENDIF
729
730	#ifdef NC_DOUBLE
731	ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
732	#else
733	ierr=NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
734	#endif
735	IF (ierr.NE.NF_NOERR) THEN
736	PRINT*, 'physdem1: Failed to write ',trim(txt)
737	CALL abort
738	ENDIF
739	ENDDO ! of DO iq=1,nq
740	ENDIF ! of IF(nq.GE.1)
741
742	c close file
743	ierr = NF_CLOSE(nid)
744
745	RETURN
746
747	END

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

Download in other formats:

Original Format