source: trunk/mars/libf/phymars/physdem1.F @ 80

Last change on this file since 80 was 38, checked in by emillour, 14 years ago

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