Context Navigation

physdem1.F @ 601

Last change on this file since 601 was 590, checked in by aslmd, 13 years ago
LMDZ.GENERIC: Introduced global1d in callcorrk so that global (using sza) or local (using latitude) 1D simulations can be carried out. Converted all astronomical distances in AU instead of Mkm. This might cause problems with old start files. So added a test in iniorbit. A quite dirty test, but thatll do the job.
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 (AU)
198	tab_cntrl(16) = apoastr ! max. star-planet distance (AU)
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