source: trunk/LMDZ.GENERIC/libf/phystd/physdem1.F @ 634

Last change on this file since 634 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
RevLine 
[135]1      subroutine physdem1(filename,lonfi,latfi,nsoil,nq,
2     .                   phystep,day_ini,
3     .                   time,tsurf,tsoil,emis,q2,qsurf,
[253]4     .                   airefi,alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe,
5     .                   cloudfrac,totcloudfrac,hice)
[135]6
[253]7      use radcommon_h, only: tauvis
8 
9      implicit none
[135]10
[253]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!==================================================================
[135]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
[588]50      integer ierr,idim1,idim2,idim3,idim4,idim5,idim6,nvarid
[135]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
[253]60!     added by BC
61      REAL hice(ngridmx),cloudfrac(ngridmx,nlayermx)
62      REAL totcloudfrac(ngridmx)
[135]63
[253]64
[135]65!      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
66!      EXTERNAL exner_hyb , SSUM
[253]67
[135]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
92c-----------------------------------------------------------------------
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
108c
109c  things to store in the physics start file:
110c
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
117c
118      print*,'we got this far'
119
120      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
121     .                       "Physics start file")
122c
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
129c
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
136c
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
143c
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
150c
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
[588]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
[135]165      ierr = NF_ENDDEF(nid) ! exit NetCDF define mode
166
167c clear tab_cntrl(:) array
168      DO ierr = 1, length
169         tab_cntrl(ierr) = 0.0
170      ENDDO
171
172      write(*,*) "physdem1: ngridmx: ",ngridmx
173
174ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
175c Fill control array tab_cntrl(:) with paramleters for this run
176ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
177c 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
183c 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
195c Informations about Mars, only for physics
196      tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
[590]197      tab_cntrl(15) = periastr  ! min. star-planet distance (AU)
198      tab_cntrl(16) = apoastr   ! max. star-planet distance (AU)
[253]199      tab_cntrl(17) = peri_day  ! date of periastron (sols since N. spring)
[135]200      tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
201
202c 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
207c 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
218c 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
287c
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
305c
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
322c
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
339c
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
356c
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
373c
374c   some data for Francois Lott's programs
375c
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
391c
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
406c
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
421c
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
436c
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
452c 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
[253]474
475
476
[135]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
512c 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
529c planetary boundary layer
530
531      ierr = NF_REDEF (nid)
532#ifdef NC_DOUBLE
[253]533      ierr = NF_DEF_VAR (nid,"q2", NF_DOUBLE, 2, (/idim2,idim4/),nvarid)
[135]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
[253]550
551
552
553
554
555
556c cloud fraction (added by BC 2010)
557
558      ierr = NF_REDEF (nid)
559#ifdef NC_DOUBLE
[588]560      ierr = NF_DEF_VAR (nid, "cloudfrac", NF_DOUBLE, 2,
561     & (/idim2,idim6/),nvarid)
[253]562#else
[588]563      ierr = NF_DEF_VAR (nid, "cloudfrac", NF_FLOAT, 2,
564     & (/idim2,idim6/),nvarid)
[253]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
575c 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
592c 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
[135]619c 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
[253]666            print*,'water vapour but no water ice, WTF?'
667            call abort
668            i_h2o_ice=i_h2o_vap
[135]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)
[253]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
[135]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
742c close file
743      ierr = NF_CLOSE(nid)
744
745      RETURN
746
747      END
Note: See TracBrowser for help on using the repository browser.