Context Navigation

physdem1.F @ 537

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

Generic GCM

Massive update to version 0.7

EM+RW

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

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

Download in other formats:

Original Format