source: trunk/LMDZ.GENERIC/libf/phystd/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
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
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
[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      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
94c-----------------------------------------------------------------------
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
110c
111c  things to store in the physics start file:
112c
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
119c
120      print*,'we got this far'
121
122      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
123     .                       "Physics start file")
124c
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
131c
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
138c
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
145c
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
153c
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
163c clear tab_cntrl(:) array
164      DO ierr = 1, length
165         tab_cntrl(ierr) = 0.0
166      ENDDO
167
168      write(*,*) "physdem1: ngridmx: ",ngridmx
169
170ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
171c Fill control array tab_cntrl(:) with paramleters for this run
172ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
173c 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
179c 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
191c Informations about Mars, only for physics
192      tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
[253]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)
[135]196      tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
197
198c 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
203c 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
214c 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
283c
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
301c
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
318c
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
335c
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
352c
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
369c
370c   some data for Francois Lott's programs
371c
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
387c
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
402c
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
417c
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
432c
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
448c 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
[253]467
468
469
470
[135]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
[253]490
491
492
[135]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
528c 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
545c planetary boundary layer
546
547      ierr = NF_REDEF (nid)
548#ifdef NC_DOUBLE
[253]549      ierr = NF_DEF_VAR (nid,"q2", NF_DOUBLE, 2, (/idim2,idim4/),nvarid)
[135]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
[253]566
567
568
569
570
571
572c 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
589c 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
606c 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
[135]633c 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
[253]680            print*,'water vapour but no water ice, WTF?'
681            call abort
682            i_h2o_ice=i_h2o_vap
[135]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)
[253]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
[135]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
756c close file
757      ierr = NF_CLOSE(nid)
758
759      RETURN
760
761      END
Note: See TracBrowser for help on using the repository browser.