Context Navigation

physdem1.F @ 848

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

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

Download in other formats:

Original Format