source: trunk/LMDZ.PLUTO.old/libf/phypluto/physdem1.F @ 3436

Last change on this file since 3436 was 3175, checked in by emillour, 11 months ago

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