Subversion Repositories pvinversion.ecmwf

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
3 michaesp 1
      subroutine clscdf (cdfid, error)
2
c-----------------------------------------------------------------------
3
c     Purpose:
4
c        This routine closes an open netCDF file.
5
c     Aguments :
6
c        cdfid  int  input   the id of the file to be closed.
7
c        error  int  output  indicates possible errors found in this
8
c                            routine.
9
c                            error = 0   no errors detected.
10
c                            error = 1   error detected.
11
c     History:
12
c        Nov. 91  PPM  UW  Created.
13
c-----------------------------------------------------------------------
14
 
15
      include "netcdf.inc"
16
 
17
c     Argument declarations.
18
      integer      cdfid, error
19
 
20
c     Local variable declarations.
21
      integer      ncopts
22
 
23
c     Get current value of error options.
24
      call ncgopt (ncopts)
25
 
26
c     Make sure netCDF errors do not abort execution.
27
      call ncpopt (NCVERBOS)
28
 
29
c     Close requested file.
30
      call ncclos (cdfid, error)
31
 
32
c     Reset error options.
33
      call ncpopt (ncopts)
34
 
35
      end
36
 
37
 
38
      subroutine cdfwopn(filnam,cdfid,ierr)
39
C------------------------------------------------------------------------
40
 
41
C     Opens the NetCDF file 'filnam' and returns its identifier cdfid.
42
 
43
C     filnam    char    input   name of NetCDF file to open
44
C     cdfid     int     output  identifier of NetCDF file
45
C     ierr      int     output  error flag
46
C------------------------------------------------------------------------
47
 
48
      include 'netcdf.inc'
49
 
50
      integer   cdfid,ierr
51
      character*(*) filnam
52
 
53
      integer   strend
54
 
55
      call ncpopt(NCVERBOS)
56
      cdfid=ncopn(filnam(1:strend(filnam)),NCWRITE,ierr)
57
 
58
      return
59
      end
60
 
61
 
62
      subroutine cdfopn(filnam,cdfid,ierr)
63
C------------------------------------------------------------------------
64
 
65
C     Opens the NetCDF file 'filnam' and returns its identifier cdfid.
66
 
67
C     filnam    char    input   name of NetCDF file to open
68
C     cdfid     int     output  identifier of NetCDF file
69
C     ierr	int	output  error flag
70
C------------------------------------------------------------------------
71
 
72
      include 'netcdf.inc'
73
 
74
      integer 	cdfid,ierr
75
      character*(*) filnam
76
 
77
      integer   strend
78
 
79
      call ncpopt(NCVERBOS)
80
      cdfid=ncopn(filnam(1:strend(filnam)),NCNOWRIT,ierr)
81
 
82
      return
83
      end
84
 
85
 
86
      subroutine crecdf (filnam, cdfid, phymin, phymax, ndim, cfn, 
87
     &                   error) 
88
c-----------------------------------------------------------------------
89
c     Purpose:
90
c        This routine is called to create a netCDF file for use with 
91
c        the UWGAP plotting package.
92
c           Any netCDF file written to must be closed with the call
93
c        'call clscdf(cdfid,error)', where cdfid and error are
94
c        as in the argumentlist below. 
95
c     Arguments:
96
c        filnam  char  input   the user-supplied netCDF file name.
97
c        cdfid   int   output  the file-identifier
98
c        phymin  real  input   the minimum physical dimension of the
99
c                              entire physical domain along each axis.
100
c                              phymin is dimensioned (ndim)
101
c        phymax  real  input   the maximum physical dimension of the
102
c                              entire physical domain along each axis.
103
c                              phymax is dimensioned (ndim)
104
c        ndim    int   input   the number of dimensions in the file
105
c                              (i.e. number of elements in phymin,
106
c                              phymax)
107
c        cfn     char  input   constants file name 
108
c                              ('0' = no constants file).
109
c        error   int   output  indicates possible errors found in this
110
c                              routine.
111
c                              error = 0   no errors detected.
112
c                              error = 1   error detected.
113
c     History:
114
c        Nov. 91  PPM  UW  Created cr3df.
115
c        Jan. 92  CS   UW  Created crecdf.
116
c-----------------------------------------------------------------------
117
 
118
      include "netcdf.inc"
119
 
120
c     Argument declarations.
121
      integer        MAXDIM
122
      parameter      (MAXDIM=4)
123
      integer        ndim, error
124
      character *(*) filnam,cfn
125
      real           phymin(*), phymax(*)
126
 
127
c     Local variable declarations.
128
      character *(20) attnam
129
      character *(1)  chrid(MAXDIM)
130
      integer         cdfid, k, ibeg, iend, lenfil, ncopts
131
      data            chrid/'x','y','z','a'/
132
 
133
c     Get current value of error options, and make sure netCDF-errors do
134
c     not abort execution
135
      call ncgopt (ncopts)
136
      call ncpopt(NCVERBOS)
137
 
138
c     Initially set error to indicate no errors.
139
      error = 0
140
 
141
c     create the netCDF file
142
      cdfid = nccre (trim(filnam), NCCLOB, error)
143
      if (error.ne.0) go to 920
144
 
145
c     define global attributes
146
      do k=1,ndim
147
        attnam(1:3)='dom'
148
        attnam(4:4)=chrid(k)
149
        attnam(5:7)='min'
150
        attnam=attnam(1:7)
151
        call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymin(k),error)
152
        if (error.gt.0) goto 920
153
 
154
        attnam(1:3)='dom'
155
        attnam(4:4)=chrid(k)
156
        attnam(5:7)='max'
157
        attnam=attnam(1:7)
158
        call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymax(k),error)
159
        if (error.gt.0) goto 920
160
      enddo
161
 
162
c     define constants file name
163
      if (cfn.ne.'0') then
164
        call ncaptc (cdfid, NCGLOBAL, 'constants_file_name',
165
c    &             NCCHAR, len_trim(cfn)+1, cfn // char(0) , error)
166
     &             NCCHAR, len_trim(cfn), cfn , error)
167
        if (error.gt.0) goto 920
168
      endif
169
 
170
c     End variable definitions.
171
      call ncendf (cdfid, error)
172
      if (error.gt.0) goto 920
173
 
174
c     normal exit
175
      call ncpopt (ncopts)
176
      return
177
 
178
c     error exit
179
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
180
     &             'create the data file in subroutine crecdf.'
181
      call ncpopt (ncopts)
182
      call ncclos (cdfid, error)
183
      end
184
 
185
      subroutine opncdf(filnam, cdfid,
186
     &                 phymin, phymax, ndim, varnam, nvar, cfn, error) 
187
c-----------------------------------------------------------------------
188
c     Purpose:
189
c        This routine is called to open a netCDF file for read and write
190
c        with the UWGAP plotting package. 
191
c     Arguments:
192
c        filnam  char  input   the user-supplied netCDF file name.
193
c        cdfid   int   output  the file-identifier
194
c        phymin  real  output  the minimum physical dimension of the
195
c                              entire physical domain along each axis.
196
c                              phymin is dimensioned (ndim)
197
c        phymax  real  output  the maximum physical dimension of the
198
c                              entire physical domain along each axis.
199
c                              phymax is dimensioned (ndim)
200
c        ndim    int   output  the number of dimensions in the file
201
c                              (i.e. number of elements in phymin,
202
c                              phymax)
203
c        varnam  char  output  an array containing the variable names.
204
c                              varnam is dimensioned (nvar).
205
c        nvar    int   output  the number of variables in the file
206
c        cfn     char  output  constants file name 
207
c                              ('0'=no constants file).
208
c        error   int   output  indicates possible errors found in this
209
c                              routine.
210
c                              error = 0   no errors detected.
211
c                              error = 1   error detected.
212
c     History:
213
c        Nov. 91  PPM  UW  Created cr3df.
214
c        Jan. 92  CS   UW  Created opncdf.
215
c-----------------------------------------------------------------------
216
 
217
      include "netcdf.inc"
218
 
219
c     Argument declarations.
220
      integer        MAXDIM
221
      parameter      (MAXDIM=4)
222
      integer        ndim, nvar, error
223
      character *(*) filnam, varnam(*),cfn
224
      real           phymin(*), phymax(*)
225
 
226
c     Local variable declarations.
227
      character *(20) attnam,vnam
228
      character *(1)  chrid(MAXDIM)
229
      integer         cdfid, i,k
230
      integer         ncopts, ndims,ngatts,recdim
231
      integer         nvdims,vartyp,nvatts,vardim(MAXDIM)
232
      real            attval
233
      integer         lenstr
234
      data            chrid/'x','y','z','a'/
235
      data            lenstr/80/
236
 
237
c     Get current value of error options and make sure netCDF-errors do 
238
c     not abort execution
239
      call ncgopt (ncopts)
240
      call ncpopt(NCVERBOS)
241
 
242
c     Initially set error to indicate no errors.
243
      error = 0
244
 
245
c     open the netCDF file for write
246
      cdfid = ncopn (trim(filnam), NCWRITE, error)
247
      if (error.ne.0) then
248
c       try to open the netCDF file for read
249
        cdfid = ncopn (trim(filnam), NCNOWRIT, error)
250
        if (error.ne.0) go to 920
251
      endif
252
 
253
c     inquire for number of variables
254
      call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)
255
      if (error.eq.1) goto 920
256
 
257
c     read the variables
258
      do i=1,nvar
259
        call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,
260
     &                         nvatts,error)
261
        if (vartyp.ne.NCFLOAT) error=1
262
        if (error.gt.0) goto 920
263
      enddo
264
 
265
c     get global attributes
266
      k=0
267
  100 continue
268
        k=k+1
269
        attnam(1:3)='dom'
270
        attnam(4:4)=chrid(k)
271
        attnam(5:7)='min'
272
        attnam=attnam(1:7)
273
 
274
c       switch off error message
275
        call ncpopt(0)
276
 
277
c       check whether dimension k is present
278
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
279
        if (error.gt.0) goto 110
280
        phymin(k)=attval
281
 
282
        attnam(1:3)='dom'
283
        attnam(4:4)=chrid(k)
284
        attnam(5:7)='max'
285
        attnam=attnam(1:7)
286
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
287
        if (error.gt.0) goto 920
288
        phymax(k)=attval
289
      if (k.lt.3) goto 100
290
      k=k+1
291
 
292
c     define ndim-parameter
293
 110  continue
294
      ndim=k-1
295
      error=0
296
 
297
c     switch on error messages
298
      call ncpopt(NCVERBOS)
299
 
300
c     get constants file name
301
c      call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)
302
c     ! chrigel
303
      call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)
304
      if (error.gt.0) cfn='0'
305
 
306
c     normal exit
307
      call ncpopt (ncopts)
308
      return
309
 
310
c     error exit
311
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
312
     &             'read the data file in subroutine opncdf.'
313
      call ncclos (cdfid, error)
314
      call ncpopt (ncopts)
315
      end
316
 
317
 
318
      subroutine readcdf(filnam, cdfid,
319
     &                 phymin, phymax, ndim, varnam, nvar, cfn, error) 
320
c-----------------------------------------------------------------------
321
c     Purpose:
322
c        This routine is called to open a netCDF file for read 
323
c        with the UWGAP plotting package. 
324
c     Arguments:
325
c        filnam  char  input   the user-supplied netCDF file name.
326
c        cdfid   int   output  the file-identifier
327
c        phymin  real  output  the minimum physical dimension of the
328
c                              entire physical domain along each axis.
329
c                              phymin is dimensioned (ndim)
330
c        phymax  real  output  the maximum physical dimension of the
331
c                              entire physical domain along each axis.
332
c                              phymax is dimensioned (ndim)
333
c        ndim    int   output  the number of dimensions in the file
334
c                              (i.e. number of elements in phymin,
335
c                              phymax)
336
c        varnam  char  output  an array containing the variable names.
337
c                              varnam is dimensioned (nvar).
338
c        nvar    int   output  the number of variables in the file
339
c        cfn     char  output  constants file name 
340
c                              ('0'=no constants file).
341
c        error   int   output  indicates possible errors found in this
342
c                              routine.
343
c                              error = 0   no errors detected.
344
c                              error = 1   error detected.
345
c     History:
346
c        Nov. 91  PPM  UW  Created cr3df.
347
c        Jan. 92  CS   UW  Created opncdf.
348
c-----------------------------------------------------------------------
349
 
350
      include "netcdf.inc"
351
 
352
c     Argument declarations.
353
      integer        MAXDIM
354
      parameter      (MAXDIM=4)
355
      integer        ndim, nvar, error
356
      character *(*) filnam, varnam(*),cfn
357
      real           phymin(*), phymax(*)
358
 
359
 
360
c     Local variable declarations.
361
      character *(20) attnam
362
      character *(1)  chrid(MAXDIM)
363
      integer         cdfid, i,k
364
      integer         ncopts, ndims,ngatts,recdim
365
      integer         nvdims,vartyp,nvatts,vardim(MAXDIM)
366
      real            attval
367
      integer         lenstr
368
      data            chrid/'x','y','z','a'/
369
      data            lenstr/80/
370
 
371
c     Get current value of error options.
372
      call ncgopt (ncopts)
373
 
374
c     make sure netCDF-errors do not abort execution
375
      call ncpopt(NCVERBOS)
376
 
377
c     Initially set error to indicate no errors.
378
      error = 0
379
 
380
c     open the netCDF file for read
381
      cdfid = ncopn (trim(filnam), NCNOWRIT, error)
382
      if (error.ne.0) go to 920
383
 
384
c     inquire for number of variables
385
      call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)
386
      if (error.eq.1) goto 920
387
 
388
c     read the variables
389
      do i=1,nvar
390
        call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,
391
     &                         nvatts,error)
392
        if (vartyp.ne.NCFLOAT) error=1
393
c       print *,varnam(i),nvdims,nvatts
394
        if (error.gt.0) goto 920
395
      enddo
396
 
397
c     get global attributes
398
      k=0
399
  100 continue
400
        k=k+1
401
        attnam(1:3)='dom'
402
        attnam(4:4)=chrid(k)
403
        attnam(5:7)='min'
404
        attnam=attnam(1:7)
405
 
406
c       switch off error message
407
        call ncpopt(0)
408
 
409
c       check whether dimension k is present
410
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
411
        if (error.gt.0) goto 110
412
        phymin(k)=attval
413
 
414
        attnam(1:3)='dom'
415
        attnam(4:4)=chrid(k)
416
        attnam(5:7)='max'
417
        attnam=attnam(1:7)
418
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
419
        if (error.gt.0) goto 920
420
        phymax(k)=attval
421
      if (k.lt.4) goto 100
422
      k=k+1
423
 
424
c     define ndim-parameter
425
 110  continue
426
      ndim=k-1
427
      error=0
428
 
429
c     switch on error messages
430
      call ncpopt(NCVERBOS)
431
 
432
c     get constants file name
433
c      call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)
434
c     ! chrigel
435
      call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)
436
      if (error.gt.0) cfn='0'
437
c     print *,cfn
438
 
439
c     normal exit
440
      call ncpopt (ncopts)
441
      return
442
 
443
c     error exit
444
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
445
     &             'read the data file in subroutine opncdf.'
446
      call ncclos (cdfid, error)
447
      call ncpopt (ncopts)
448
      end
449
 
450
 
451
 
452
      subroutine getcdf (cdfid, varnam, ndim, misdat, 
453
     &                       vardim, varmin, varmax, stag, dat, error)
454
c-----------------------------------------------------------------------
455
c     Purpose:
456
c        This routine is called to get a variable and its attributes
457
c        from a netCDF file for use with the UWGAP plotting package. 
458
c        It is assumed that the data is floating-point data. Prior to
459
c        calling this routine, the file must be opened with a call to
460
c        opncdf.
461
c     Arguments:
462
c        cdfid   int   input   file-identifier
463
c                              (can be obtained by calling routine 
464
c                              opncdf)
465
c        varnam  char  input   the user-supplied variable name.
466
c                              (can be obtained by calling routine 
467
c                              opncdf)
468
c        ndim    int   output  the number of dimensions (ndim<=4)
469
c        misdat  real  output  missing data value for the variable. 
470
c        vardim  int   output  the dimensions of the variable.
471
c                              is dimensioned at least (ndim). 
472
c        varmin  real  output  the location in physical space of the
473
c                              origin of each variable.
474
c                              is dimensioned at least Min(ndim,3). 
475
c        varmax  real  output  the extent of each variable in physical
476
c                              space.
477
c                              is dimensioned at least Min(ndim,3). 
478
c        stag    real  output  the grid staggering for each variable.
479
c                              is dimensioned at least Min(ndim,3). 
480
c        dat     real  output  data-array dimensioned suffiecently 
481
c                              large, at least 
482
c                              vardim(1)* ... vardim(ndim)
483
c        error   int   output  indicates possible errors found in this
484
c                              routine.
485
c                              error = 0   no errors detected.
486
c                              error = 1   error detected.
487
c     History:
488
c        Nov. 91  PPM  UW  Created cr3df.
489
c        Jan. 92  CS   UW  Created getcdf.
490
c-----------------------------------------------------------------------
491
 
492
      include "netcdf.inc"
493
 
494
c     Argument declarations.
495
      integer        MAXDIM
496
      parameter      (MAXDIM=4)
497
      character *(*) varnam
498
      integer        vardim(*), ndim, error, cdfid
499
      real           misdat,  stag(*), varmin(*), varmax(*), dat(*)
500
 
501
c     Local variable declarations.
502
      character *(20) dimnam(100),attnam
503
      character *(1)  chrid(MAXDIM)
504
      integer         id,i,k,corner(MAXDIM)
505
      integer         ndims,nvars,ngatts,recdim,dimsiz(100)
506
      integer         vartyp,nvatts, ncopts
507
      data            chrid/'x','y','z','a'/
508
      data            corner/1,1,1,1/
509
 
510
c     Get current value of error options, and make sure netCDF-errors do 
511
c     not abort execution 
512
      call ncgopt (ncopts)
513
      call ncpopt(NCVERBOS)
514
 
515
c     Initially set error to indicate no errors.
516
      error = 0
517
 
518
c     inquire for number of dimensions
519
      call ncinq(cdfid,ndims,nvars,ngatts,recdim,error)
520
      if (error.eq.1) goto 920
521
 
522
c     read dimension-table
523
      do i=1,ndims 
524
        call ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)
525
        if (error.gt.0) goto 920
526
      enddo
527
 
528
c     get id of the variable
529
      id=ncvid(cdfid,varnam,error)
530
      if (error.eq.1) goto 910
531
 
532
c     inquire about variable
533
      call ncvinq(cdfid,id,varnam,vartyp,ndim,vardim,nvatts,error)
534
      if (vartyp.ne.NCFLOAT) error=1
535
      if (error.gt.0) goto 920
536
 
537
c     Make sure ndim <= MAXDIM.
538
      if (ndim.gt.MAXDIM) then
539
         error = 1
540
         go to 900
541
      endif
542
 
543
c     get dimensions from dimension-table
544
      do k=1,ndim 
545
        vardim(k)=dimsiz(vardim(k))
546
      enddo
547
 
548
c     get attributes
549
      do k=1,min0(ndim,3)
550
c       get staggering
551
        attnam(1:1)=chrid(k)
552
        attnam(2:5)='stag'
553
        attnam=attnam(1:5)
554
        call ncagt(cdfid,id,attnam,stag(k),error)
555
        if (error.gt.0) goto 920
556
c       get min postion
557
        attnam(1:1)=chrid(k)
558
        attnam(2:4)='min'
559
        attnam=attnam(1:4)
560
        call ncagt(cdfid,id,attnam,varmin(k),error)
561
        if (error.gt.0) goto 920
562
c       get max position     
563
        attnam(1:1)=chrid(k)
564
        attnam(2:4)='max'
565
        attnam=attnam(1:4)
566
        call ncagt(cdfid,id,attnam,varmax(k),error)
567
        if (error.gt.0) goto 920     
568
      enddo
569
 
570
c     get missing data value
571
      call ncagt(cdfid,id,'missing_data',misdat,error)
572
      if (error.gt.0) goto 920     
573
 
574
c     get data
575
      call ncvgt(cdfid,id,corner,vardim,dat,error)
576
      if (error.gt.0) goto 920
577
 
578
c     normal exit
579
      call ncpopt (ncopts)
580
      return
581
 
582
 
583
c     Error exits.
584
 900  write (6, *) 'ERROR: When calling getcdf, the number of ',
585
     &             'variable dimensions must be less or equal 4.'
586
      call ncpopt (ncopts)
587
      call ncclos (cdfid, error)
588
      return
589
 
590
 910  write (6, *) 'ERROR: The selected variable could not be found ',       
591
     &             'in the file by getcdf.'
592
      call ncpopt (ncopts)
593
      call ncclos (cdfid, error)
594
      return
595
 
596
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
597
     &             'read the data file in subroutine getcdf.'
598
      call ncpopt (ncopts)
599
      call ncclos (cdfid, error)
600
      return
601
 
602
      end
603
 
604
 
605
      subroutine putcdf (cdfid, varnam, ndim, misdat, 
606
     &                       vardim, varmin, varmax, stag, dat, error)
607
c-----------------------------------------------------------------------
608
c     Purpose:
609
c        This routine is called to put a variable and its attributes
610
c        onto a netCDF file for use with the UWGAP plotting package. 
611
c        It is assumed that the data is floating-point data. Prior to 
612
c        calling this routine, the file must be created (crecdf) or
613
c        opened (opncdf). 
614
c           Any netCDF file written to must be closed with the call
615
c        call ncclos(cdfid,error), where cdfid and error are
616
c        as in the argumentlist below.
617
c     Arguments:
618
c        cdfid   int   input   file-identifier
619
c                              (can be obtained by calling routine 
620
c                              opncdf)
621
c        varnam  char  input   the user-supplied variable name.
622
c                              (can be obtained by calling routine 
623
c                              opncdf)
624
c        ndim    int   input   the number of dimensions (ndim<=4)
625
c        misdat  real  input   missing data value for the variable. 
626
c        vardim  int   input   the dimensions of the variable.
627
c                              is dimensioned at least (ndim). 
628
c        varmin  real  input   the location in physical space of the
629
c                              origin of each variable.
630
c                              is dimensioned at least Min(ndim,3). 
631
c        varmax  real  input   the extent of each variable in physical
632
c                              space.
633
c                              is dimensioned at least Min(ndim,3).  
634
c        stag    real  input   the grid staggering for each variable.
635
c                              is dimensioned at least Min(ndim,3).  
636
c        dat     real  input   data-array dimensioned suffiecently 
637
c                              large, at least 
638
c                              vardim(1)* ... vardim(ndim)
639
c        error   int   output  indicates possible errors found in this
640
c                              routine.
641
c                              error = 0   no errors detected.
642
c                              error = 1   error detected.
643
c     History:
644
c        Nov. 91  PPM  UW  Created cr3df, wr3df.
645
c        Jan. 92  CS   UW  Created putcdf.
646
c-----------------------------------------------------------------------
647
 
648
      include "netcdf.inc"
649
 
650
c     Argument declarations.
651
      integer        MAXDIM
652
      parameter      (MAXDIM=4)
653
      character *(*) varnam
654
      integer        vardim(*), ndim, error, cdfid
655
      real           misdat,  stag(*), varmin(*), varmax(*), dat(*)
656
 
657
c     Local variable declarations.
658
      character *(20) dimnam,attnam,dimchk
659
      character *(1)  chrid(MAXDIM)
660
      character *(20) dimnams(MAXNCDIM)
661
      integer         dimvals(MAXNCDIM)
662
      integer         numdims,numvars,numgats,dimulim
663
      integer         id,did(MAXDIM),i,k,corner(MAXDIM)
664
      integer         ncopts
665
      integer         ibeg,iend
666
      data            chrid/'x','y','z','t'/
667
      data            corner/1,1,1,1/
668
 
669
c     Get current value of error options.
670
      call ncgopt (ncopts)
671
 
672
c     make sure netCDF-errors do not abort execution
673
      call ncpopt(NCVERBOS)
674
 
675
c     Initially set error to indicate no errors.
676
      error = 0
677
 
678
c     Make sure ndim <= MAXDIM.
679
      if (ndim.gt.MAXDIM) then
680
         error = 1
681
         go to 900
682
      endif
683
 
684
c     Read existing dimensions-declarations from the file
685
      call ncinq(cdfid,numdims,numvars,numgats,dimulim,error)
686
      if (error.ne.0) numdims=0
687
      if (numdims.gt.0) then
688
        do i=1,numdims
689
          call ncdinq(cdfid,i,dimnams(i),dimvals(i),error)
690
c          print *,dimnams(i),dimvals(i)
691
        enddo
692
      endif
693
 
694
c     put file into define mode
695
      call ncredf(cdfid,error)
696
      if (error.ne.0) goto 920
697
 
698
c     define the dimension
699
      do k=1,ndim
700
c       define the dimension-name
701
        dimnam(1:3)='dim'
702
        dimnam(4:4)=chrid(k)
703
        dimnam(5:5)='_'
704
        dimnam(6:5+len_trim(varnam))=trim(varnam)
705
        dimnam=dimnam(1:5+len_trim(varnam))
706
        did(k)=-1
707
        if (numdims.gt.0) then
708
c         check if an existing dimension-declaration can be used
709
c         instead of defining a nuw dimension
710
          do i=1,numdims
711
            dimchk=dimnams(i)
712
            if ((vardim(k).eq.dimvals(i)).and.
713
     &        (dimnam(1:4).eq.dimchk(1:4))) then 
714
              did(k)=i
715
              goto 100
716
            endif
717
          enddo
718
 100      continue
719
        endif
720
        if (did(k).lt.0) then
721
c         define the dimension
722
          did(k)=ncddef(cdfid,dimnam,vardim(k),error)
723
          if (error.ne.0) goto 920
724
        endif
725
      enddo
726
 
727
c     define variable
728
      id=ncvdef(cdfid,varnam,NCFLOAT,ndim,did,error)
729
      if (error.ne.0) goto 920
730
 
731
c     define attributes
732
      do k=1,min0(ndim,3)
733
c       staggering
734
        attnam(1:1)=chrid(k)
735
        attnam(2:5)='stag'
736
        attnam=attnam(1:5)
737
        call ncapt(cdfid,id,attnam,NCFLOAT,1,stag(k),error)
738
        if (error.gt.0) goto 920
739
c       min postion
740
        attnam(1:1)=chrid(k)
741
        attnam(2:4)='min'
742
        attnam=attnam(1:4)
743
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmin(k),error)
744
        if (error.gt.0) goto 920
745
c       max position     
746
        attnam(1:1)=chrid(k)
747
        attnam(2:4)='max'
748
        attnam=attnam(1:4)
749
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmax(k),error)
750
        if (error.gt.0) goto 920     
751
      enddo
752
 
753
c     define missing data value
754
      call ncapt(cdfid,id,'missing_data',NCFLOAT,1,misdat,error)
755
      if (error.gt.0) goto 920     
756
 
757
c     leave define mode
758
      call ncendf(cdfid,error)
759
      if (error.gt.0) goto 920     
760
 
761
c     define data
762
      call ncvpt(cdfid,id,corner,vardim,dat,error)
763
      if (error.gt.0) goto 920
764
 
765
c     synchronyse output to disk and exit
766
      call ncsnc (cdfid,error)
767
      call ncpopt (ncopts)
768
      return
769
 
770
c     Error exits.
771
 900  write (6, *) 'ERROR: When calling putcdf, the number of ',
772
     &             'variable dimensions must be less or equal 4.'
773
      call ncpopt (ncopts)
774
      call ncclos (cdfid, error)
775
      return
776
 
777
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
778
     &             'write the data file in subroutine putcdf.'
779
      call ncpopt (ncopts)
780
      call ncclos (cdfid, error)
781
      return
782
      end
783
c
784
c
785
      subroutine getdef (cdfid, varnam, ndim, misdat, 
786
     &                              vardim, varmin, varmax, stag, error)
787
c-----------------------------------------------------------------------
788
c     Purpose:
789
c        This routine is called to get the dimensions and attributes of 
790
c        a variable from an IVE-NetCDF file for use with the IVE plotting
791
c        package. Prior to calling this routine, the file must be opened
792
c        with a call to opncdf.
793
c     Arguments:
794
c        cdfid   int   input   file-identifier
795
c                              (can be obtained by calling routine 
796
c                              opncdf)
797
c        varnam  char  input   the user-supplied variable name.
798
c                              (can be obtained by calling routine 
799
c                              opncdf)
800
c        ndim    int   output  the number of dimensions (ndim<=4)
801
c        misdat  real  output  missing data value for the variable. 
802
c        vardim  int   output  the dimensions of the variable.
803
c                              Is dimensioned at least (ndim). 
804
c        varmin  real  output  the location in physical space of the
805
c                              origin of each variable. 
806
c                              Is dimensioned at least Min(3,ndim). 
807
c        varmax  real  output  the extend of each variable in physical
808
c                              space.
809
c                              Is dimensioned at least Min(3,ndim). 
810
c        stag    real  output  the grid staggering for each variable.
811
c                              Is dimensioned at least Min(3,ndim). 
812
c        error   int   output  indicates possible errors found in this
813
c                              routine.
814
c                              error = 0   no errors detected.
815
c                              error = 1   the variable is not on the file.
816
c                              error =10   other errors.
817
c     History:
818
c       Apr. 93    Christoph Schaer (ETHZ)     Created.
819
c-----------------------------------------------------------------------
820
 
821
      include "netcdf.inc"
822
 
823
c     Argument declarations.
824
      integer        MAXDIM
825
      parameter      (MAXDIM=4)
826
      character *(*) varnam
827
      integer        vardim(*), ndim, error, cdfid
828
      real           misdat,  stag(*), varmin(*), varmax(*)
829
 
830
c     Local variable declarations.
831
      character *(20) dimnam(MAXNCDIM),attnam,vnam
832
      character *(1)  chrid(MAXDIM)
833
      integer         id,i,k
834
      integer         ndims,nvars,ngatts,recdim,dimsiz(MAXNCDIM)
835
      integer         vartyp,nvatts, ncopts
836
      data            chrid/'x','y','z','t'/
837
 
838
c     Get current value of error options.
839
      call ncgopt (ncopts)
840
 
841
c     make sure NetCDF-errors do not abort execution
842
      call ncpopt(NCVERBOS)
843
 
844
c     Initially set error to indicate no errors.
845
      error = 0
846
 
847
c     inquire for number of dimensions
848
      call ncinq(cdfid,ndims,nvars,ngatts,recdim,error)
849
      if (error.eq.1) goto 920
850
 
851
c     read dimension-table
852
      do i=1,ndims 
853
        call ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)
854
        if (error.gt.0) goto 920
855
      enddo
856
 
857
c     get id of the variable
858
      id=ncvid(cdfid,varnam,error)
859
      if (error.eq.1) goto 910
860
 
861
c     inquire about variable
862
      call ncvinq(cdfid,id,vnam,vartyp,ndim,vardim,nvatts,error)
863
      if (vartyp.ne.NCFLOAT) error=1
864
      if (error.gt.0) goto 920
865
 
866
c     Make sure ndim <= MAXDIM.
867
      if (ndim.gt.MAXDIM) then
868
         error = 1
869
         go to 900
870
      endif
871
 
872
c     get dimensions from dimension-table
873
      do k=1,ndim 
874
        vardim(k)=dimsiz(vardim(k))
875
      enddo
876
 
877
c     get attributes
878
      do k=1,min0(3,ndim)
879
c       get min postion
880
        attnam(1:1)=chrid(k)
881
        attnam(2:4)='min'
882
        attnam=attnam(1:4)
883
        call ncagt(cdfid,id,attnam,varmin(k),error)
884
        if (error.gt.0) goto 920
885
c       get max position     
886
        attnam(1:1)=chrid(k)
887
        attnam(2:4)='max'
888
        attnam=attnam(1:4)
889
        call ncagt(cdfid,id,attnam,varmax(k),error)
890
        if (error.gt.0) goto 920     
891
c       get staggering
892
        attnam(1:1)=chrid(k)
893
        attnam(2:5)='stag'
894
        attnam=attnam(1:5)
895
        call ncagt(cdfid,id,attnam,stag(k),error)
896
        if (error.gt.0) goto 920
897
      enddo
898
 
899
c     get missing data value
900
      call ncagt(cdfid,id,'missing_data',misdat,error)
901
      if (error.gt.0) goto 920     
902
 
903
c     normal exit
904
      call ncpopt (ncopts)
905
      return
906
 
907
c     Error exits.
908
 900  write (6, *) '*ERROR*: When calling getcdf, the number of ',
909
     &             'variable dimensions must be less or equal 4.'
910
      call ncpopt (ncopts)
911
      call ncclos (cdfid, error)
912
      return
913
 
914
 910  write (6, *) '*ERROR*: The selected variable could not be found ',       
915
     &             'in the file by getcdf.'
916
      call ncpopt (ncopts)
917
      call ncclos (cdfid, error)
918
      return
919
 
920
 920  write (6, *) '*ERROR*: An error occurred while attempting to ',
921
     &             'read the data file in subroutine getcdf.'
922
      call ncpopt (ncopts)
923
      call ncclos (cdfid, error)
924
      end
925
 
926
 
927
 
928
      subroutine getdat(cdfid, varnam, time, level, dat, error)
929
c-----------------------------------------------------------------------
930
c     Purpose:
931
c        This routine is called to read the data of a variable
932
c        from an IVE-NetCDF file for use with the IVE plotting package. 
933
c        Prior to calling this routine, the file must be opened with 
934
c        a call to opncdf (for extension) or crecdf (for creation) or
935
c        readcdf (for readonly).
936
c     Arguments:
937
c        cdfid   int   input   file-identifier
938
c                              (must be obtained by calling routine 
939
c                              opncdf,readcdf  or crecdf)
940
c        varnam  char  input   the user-supplied variable name (must 
941
c                              previously be defined with a call to
942
c                              putdef)
943
c        time    real  input   the user-supplied time-level of the
944
c                              data to be read from the file (the time-
945
c                              levels stored in the file can be obtained
946
c                              with a call to gettimes). 
947
c        level   int   input   the horizontal level(s) to be read 
948
c                              to the NetCDF file. Suppose that the
949
c                              variable is defined as (nx,ny,nz,nt).
950
c                              level>0: the call reads the subdomain
951
c                                       (1:nx,1:ny,level,itimes)
952
c                              level=0: the call reads the subdomain
953
c                                       (1:nx,1:ny,1:nz,itimes)
954
c                              Here itimes is the time-index corresponding
955
c                              to the value of 'time'. 
956
c        dat     real  output  data-array dimensioned sufficiently 
957
c                              large. The dimensions (nx,ny,nz)
958
c                              of the variable must previously be defined
959
c                              with a call to putdef. No previous 
960
c                              definition of the time-dimension is
961
c                              required.
962
c        error   int   output  indicates possible errors found in this
963
c                              routine.
964
c                              error = 0   no errors detected.
965
c                              error = 1   the variable is not present on
966
c                                          the file.
967
c                              error = 2   the value of 'time' is not
968
c                                          known.to the file.
969
c                              error = 3   inconsistent value of level
970
c                              error =10   another error.
971
c     History:
972
c       March 93    Heini Wernli (ETHZ)      Created wr2cdf.
973
c       April 93    Bettina Messmer (ETHZ)   Created putdat.
974
c       June  93    Christoph Schaer (ETHZ)  Created getdat
975
c-----------------------------------------------------------------------
976
 
977
      include "netcdf.inc"
978
 
979
C     Declaration of local variables
980
      character*(*) varnam
981
      character*(20) chars
982
      integer cdfid
983
 
984
      real        dat(*)
985
      real        misdat,varmin(4),varmax(4),stag(4)
986
      real        time, timeval
987
 
988
      integer     corner(4),edgeln(4),didtim,vardim(4),ndims
989
      integer     error, ierr
990
      integer     level,ntime
991
      integer     idtime,idvar,iflag
992
      integer     i
993
 
994
      call ncpopt(NCVERBOS)
995
 
996
c     access the variable
997
      call getdef (cdfid, trim(varnam), ndims, misdat, 
998
     &                           vardim, varmin, varmax, stag, ierr)
999
      if (ierr.ne.0) then
1000
        print *,'*ERROR* in getdef in getdat'
1001
        error=1
1002
        return
1003
      endif
1004
      idvar=ncvid(cdfid,trim(varnam),ierr)
1005
      if (ierr.ne.0) then
1006
        print *,'*ERROR* in ncvid in getdat'
1007
        error=1
1008
        return
1009
      endif
1010
 
1011
C     Get times-array
1012
      didtim=ncdid(cdfid,'time',ierr)
1013
      if (ierr.ne.0) then
1014
        print *,'*ERROR* didtim in getdat'
1015
        error=10
1016
        return
1017
      endif
1018
      call ncdinq(cdfid,didtim,chars,ntime,ierr)
1019
      if (ierr.ne.0) then
1020
        print *,'*ERROR* in ncdinq in getdat'
1021
        error=10
1022
        return
1023
      endif
1024
      idtime=ncvid(cdfid,'time',ierr)
1025
      if (ierr.ne.0) then
1026
        print *,'*ERROR* in ncvid for time in getdat'
1027
        error=10
1028
        return
1029
      endif
1030
c     find appropriate time-index
1031
      iflag=0
1032
      do i=1,ntime
1033
        call ncvgt1(cdfid,idtime,i,timeval,ierr)
1034
        if (ierr.ne.0) print *,'*ERROR* in ncvgt1 in getdat'
1035
        if (time.eq.timeval) iflag=i
1036
      enddo
1037
      if (iflag.eq.0) then
1038
        error=2
1039
        print *,'Error: Unknown time in getdat'
1040
        return
1041
      endif
1042
 
1043
C     Define data volume to be written (index space)
1044
      corner(1)=1
1045
      corner(2)=1
1046
      edgeln(1)=vardim(1)
1047
      edgeln(2)=vardim(2)
1048
      if (level.eq.0) then
1049
        corner(3)=1
1050
        edgeln(3)=vardim(3)
1051
      else if ((level.le.vardim(3)).and.(level.ge.1)) then
1052
        corner(3)=level
1053
        edgeln(3)=1
1054
      else
1055
        error=3
1056
        return
1057
      endif
1058
      corner(4)=iflag
1059
      edgeln(4)=1
1060
 
1061
C     Read data from NetCDF file
1062
c      print *,'getdat vor Aufruf ncvgt'
1063
c      print *,'cdfid ',cdfid
1064
c      print *,'idvar ',idvar
1065
c      print *,'corner ',corner
1066
c      print *,'edgeln ',edgeln
1067
 
1068
      call ncvgt(cdfid,idvar,corner,edgeln,dat,error)
1069
      if (error.ne.0) then
1070
        print *, '*ERROR* in ncvgt in getdat'
1071
        error=10
1072
      endif
1073
      end
1074
 
1075
 
1076
 
1077
      subroutine putdat(cdfid, varnam, time, level, dat, error)
1078
c-----------------------------------------------------------------------
1079
c     Purpose:
1080
c        This routine is called to write the data of a variable
1081
c        to an IVE-NetCDF file for use with the IVE plotting package. 
1082
c        Prior to calling this routine, the file must be opened with 
1083
c        a call to opncdf (for extension) or crecdf (for creation), the 
1084
c        variable must be defined with a call to putdef.
1085
c     Arguments:
1086
c        cdfid   int   input   file-identifier
1087
c                              (must be obtained by calling routine 
1088
c                              opncdf or crecdf)
1089
c        varnam  char  input   the user-supplied variable name (must 
1090
c                              previously be defined with a call to
1091
c                              putdef)
1092
c        time    real  input   the user-supplied time-level of the
1093
c                              data to be written to the file (the time-
1094
c                              levels stored in the file can be obtained
1095
c                              with a call to gettimes). If 'time' is not
1096
c                              yet known to the file, a knew time-level is
1097
c                              allocated and appended to the times-array.
1098
c        level   int input     the horizontal level(s) to be written 
1099
c                              to the NetCDF file. Suppose that the
1100
c                              variable is defined as (nx,ny,nz,nt).
1101
c                              level>0: the call writes the subdomain
1102
c                                       (1:nx,1:ny,level,itimes)
1103
c                              level=0: the call writes the subdomain
1104
c                                       (1:nx,1:ny,1:nz,itimes)
1105
c                              Here itimes is the time-index corresponding
1106
c                              to the value of 'time'. 
1107
c        dat     real  output  data-array dimensioned sufficiently 
1108
c                              large. The dimensions (nx,ny,nz)
1109
c                              of the variable must previously be defined
1110
c                              with a call to putdef. No previous 
1111
c                              definition of the time-dimension is
1112
c                              required.
1113
c        error   int output    indicates possible errors found in this
1114
c                              routine.
1115
c                              error = 0   no errors detected.
1116
c                              error = 1   the variable is not present on
1117
c                                          the file.
1118
c                              error = 2   the value of 'time' is new, but
1119
c                                          appending it would yield a non
1120
c                                          ascending times-array.
1121
c                              error = 3   inconsistent value of level
1122
c                              error =10   another error.
1123
c     History:
1124
c       March 93    Heini Wernli (ETHZ)      Created wr2cdf.
1125
c       April 93    Bettina Messmer (ETHZ)   Created putdat.
1126
c-----------------------------------------------------------------------
1127
 
1128
      include "netcdf.inc"
1129
 
1130
C     Declaration of local variables
1131
 
1132
      character*(*) varnam
1133
      character*(20) chars
1134
      integer cdfid
1135
 
1136
 
1137
      real 	dat(*)
1138
      real	misdat,varmin(4),varmax(4),stag(4)
1139
      real	time, timeval
1140
      data	stag/0.,0.,0.,0./
1141
 
1142
      integer	corner(4),edgeln(4),did(4),vardim(4),ndims
1143
      integer	error, ierr
1144
      integer	level,ntime
1145
      integer	idtime,idvar,iflag
1146
      integer	i
1147
 
1148
      call ncpopt(NCVERBOS)
1149
 
1150
c     get definitions of data
1151
      call getdef (cdfid, trim(varnam), ndims, misdat, 
1152
     &                           vardim, varmin, varmax, stag, ierr)
1153
      if (ierr.ne.0)  print *,'*ERROR* in getdef in putdat'
1154
 
1155
c     get id of variable
1156
      idvar=ncvid(cdfid,trim(varnam),ierr)
1157
      if (ierr.ne.0) print *,'*ERROR* in ncvid in putdat'
1158
 
1159
c     get times-array 
1160
      did(4)=ncdid(cdfid,'time',ierr)
1161
      if (ierr.ne.0) print *,'*ERROR* did(4) in putdat'
1162
      call ncdinq(cdfid,did(4),chars,ntime,ierr)
1163
      if (ierr.ne.0) print *,'*ERROR* in ncdinq in putdat'
1164
      idtime=ncvid(cdfid,'time',ierr)
1165
      if (ierr.ne.0) print *,'*ERROR* in ncvid in putdat'
1166
C     Check if a new time step is starting
1167
      iflag=0
1168
      do i=1,ntime
1169
        call ncvgt1(cdfid,idtime,i,timeval,ierr)
1170
        if (ierr.ne.0) print *,'*ERROR* in ncvgt1 in putdat'
1171
        if (time.eq.timeval) iflag=i
1172
      enddo
1173
      if (iflag.eq.0) then		! new time step
1174
        ntime=ntime+1
1175
        iflag=ntime
1176
        idtime=ncvid(cdfid,'time',ierr)
1177
        if (ierr.ne.0) print *, '*ERROR* in ncvid in putdat'
1178
        call ncvpt1(cdfid,idtime,ntime,time,ierr)
1179
        if (ierr.ne.0) print *, '*ERROR* in ncvpt1 in putdat'
1180
      endif
1181
 
1182
C     Define data volume to write on the NetCDF file in index space
1183
      corner(1)=1               ! starting corner of data volume
1184
      corner(2)=1
1185
      edgeln(1)=vardim(1)       ! edge lengthes of data volume
1186
      edgeln(2)=vardim(2)
1187
      if (level.eq.0) then
1188
        corner(3)=1
1189
        edgeln(3)=vardim(3)
1190
      else
1191
        corner(3)=level
1192
        edgeln(3)=1
1193
      endif
1194
      corner(4)=iflag
1195
      edgeln(4)=1
1196
 
1197
C     Put data on NetCDF file
1198
 
1199
c      print *,'vor Aufruf ncvpt d.h. Daten schreiben in putdat '
1200
c      print *,'cdfid ',cdfid
1201
c      print *,'idvar ',idvar
1202
c      print *,'corner ',corner
1203
c      print *,'edgeln ',edgeln
1204
 
1205
      call ncvpt(cdfid,idvar,corner,edgeln,dat,error)
1206
      if (error.ne.0) then
1207
        print *, '*ERROR* in ncvpt in putdat - Put data on NetCDF file'
1208
      endif
1209
 
1210
C     Synchronize output to disk and close the files
1211
 
1212
      call ncsnc(cdfid,ierr)
1213
      if (ierr.ne.0) print *, '*ERROR* in ncsnc in putdat'
1214
      end
1215
 
1216
 
1217
 
1218
 
1219
 
1220
 
1221
      subroutine putdef (cdfid, varnam, ndim, misdat, 
1222
     &                            vardim, varmin, varmax, stag, error)
1223
c-----------------------------------------------------------------------
1224
c     Purpose:
1225
c        This routine is called to define the dimensions and the
1226
c        attributes of a variable on an IVE-NetCDF file for use with the
1227
c        IVE plotting package. Prior to calling this routine, the file must
1228
c        be opened with a call to opncdf (extend an existing file) or
1229
c        crecdf (create a new file).
1230
c     Arguments:
1231
c        cdfid   int   input   file-identifier
1232
c                              (can be obtained by calling routine 
1233
c                              opncdf)
1234
c        varnam  char  input   the user-supplied variable name.
1235
c        ndim    int   input   the number of dimensions (ndim<=4). 
1236
c                              Upon ndim=4, the fourth dimension of the
1237
c                              variable is specified as 'unlimited'
1238
c                              on the file (time-dimension). It can 
1239
c                              later be extended to arbitrary length.
1240
c        misdat  real  input   missing data value for the variable. 
1241
c        vardim  int   input   the dimensions of the variable.
1242
c                              Is dimensioned at least Min(3,ndim). 
1243
c        varmin  real  input   the location in physical space of the
1244
c                              origin of each variable.
1245
c                              Is dimensioned at least Min(3,ndim). 
1246
c        varmax  real  input   the extent of each variable in physical
1247
c                              space.
1248
c                              Is dimensioned at least Min(ndim). 
1249
c        stag    real  input   the grid staggering for each variable.
1250
c                              Is dimensioned at least Min(3,ndim). 
1251
c        error   int   output  indicates possible errors found in this
1252
c                              routine.
1253
c                              error = 0   no errors detected.
1254
c                              error =10   other errors detected.
1255
c     History:
1256
c       Apr. 93    Christoph Schaer (ETHZ)     Created.
1257
c-----------------------------------------------------------------------
1258
 
1259
      include "netcdf.inc"
1260
 
1261
c     Argument declarations.
1262
      integer        MAXDIM
1263
      parameter      (MAXDIM=4)
1264
      character *(*) varnam
1265
      integer        vardim(*), ndim, error, cdfid
1266
      real           misdat,  stag(*), varmin(*), varmax(*)
1267
 
1268
c     Local variable declarations.
1269
      character *(20) dimnam,attnam,dimchk
1270
      character *(1)  chrid(MAXDIM)
1271
      character *(20) dimnams(MAXNCDIM)
1272
      integer         dimvals(MAXNCDIM)
1273
      integer         numdims,numvars,numgats,dimulim
1274
      integer         id,did(MAXDIM),idtime,i,k,ierr
1275
      integer         ncopts
1276
      integer         ibeg,iend
1277
      data            chrid/'x','y','z','t'/
1278
 
1279
c     Get current value of error options.
1280
      call ncgopt (ncopts)
1281
 
1282
c     make sure NetCDF-errors do not abort execution
1283
      call ncpopt(NCVERBOS)
1284
 
1285
c     Initially set error to indicate no errors.
1286
      error = 0
1287
 
1288
c     Make sure ndim <= MAXDIM.
1289
      if (ndim.gt.MAXDIM) then
1290
         error = 10
1291
         go to 900
1292
      endif
1293
 
1294
c     Read existing dimensions-declarations from the file
1295
      call ncinq(cdfid,numdims,numvars,numgats,dimulim,error)
1296
      if (numdims.gt.0) then
1297
        do i=1,numdims
1298
          call ncdinq(cdfid,i,dimnams(i),dimvals(i),error)
1299
c         print *,dimnams(i),dimvals(i)
1300
        enddo
1301
      endif
1302
 
1303
c     put file into define mode
1304
      call ncredf(cdfid,error)
1305
      if (error.ne.0) goto 920
1306
 
1307
c     define spatial dimensions
1308
      do k=1,min0(3,ndim)
1309
c       define the default dimension-name
1310
        dimnam(1:3)='dim'
1311
        dimnam(4:4)=chrid(k)
1312
        dimnam(5:5)='_'
1313
        dimnam(6:5+len_trim(varnam))=trim(varnam)
1314
        dimnam=dimnam(1:5+len_trim(varnam))
1315
        did(k)=-1
1316
        if (numdims.gt.0) then
1317
c         check if an existing dimension-declaration can be used
1318
c         instead of defining a new dimension
1319
          do i=1,numdims
1320
            dimchk=dimnams(i)
1321
            if ((vardim(k).eq.dimvals(i)).and.
1322
     &        (dimnam(1:4).eq.dimchk(1:4))) then 
1323
              did(k)=i
1324
              goto 100
1325
            endif
1326
          enddo
1327
 100      continue
1328
        endif
1329
        if (did(k).lt.0) then
1330
c         define the dimension
1331
          did(k)=ncddef(cdfid,dimnam,vardim(k),error)
1332
          if (error.ne.0) goto 920
1333
        endif
1334
      enddo
1335
 
1336
c     define the times-array
1337
      if (ndim.eq.4) then
1338
c       define dimension and variable 'time'
1339
        if (numdims.ge.4) then
1340
          did(4)=ncdid(cdfid,'time',ierr)
1341
          idtime=ncvid(cdfid,'time',ierr)
1342
        else
1343
c         this dimension must first be defined
1344
          did(4) = ncddef (cdfid,'time',NCUNLIM,ierr)
1345
          idtime = ncvdef (cdfid,'time',NCFLOAT,1,did(4),ierr)
1346
        endif
1347
      endif
1348
 
1349
c     define variable
1350
      id=ncvdef(cdfid,varnam,NCFLOAT,ndim,did,error)
1351
      if (error.ne.0) goto 920
1352
 
1353
c     define attributes
1354
      do k=1,min0(ndim,3)
1355
c       min postion
1356
        attnam(1:1)=chrid(k)
1357
        attnam(2:4)='min'
1358
        attnam=attnam(1:4)
1359
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmin(k),error)
1360
        if (error.gt.0) goto 920
1361
c       max position     
1362
        attnam(1:1)=chrid(k)
1363
        attnam(2:4)='max'
1364
        attnam=attnam(1:4)
1365
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmax(k),error)
1366
        if (error.gt.0) goto 920     
1367
c       staggering
1368
        attnam(1:1)=chrid(k)
1369
        attnam(2:5)='stag'
1370
        attnam=attnam(1:5)
1371
        call ncapt(cdfid,id,attnam,NCFLOAT,1,stag(k),error)
1372
        if (error.gt.0) goto 920
1373
      enddo
1374
 
1375
c     define missing data value
1376
      call ncapt(cdfid,id,'missing_data',NCFLOAT,1,misdat,error)
1377
      if (error.gt.0) goto 920     
1378
 
1379
c     leave define mode
1380
      call ncendf(cdfid,error)
1381
      if (error.gt.0) goto 920     
1382
 
1383
c     synchronyse output to disk and exit
1384
      call ncsnc (cdfid,error)
1385
      call ncpopt (ncopts)
1386
      return
1387
 
1388
c     Error exits.
1389
 900  write (6, *) '*ERROR*: When calling putcdf, the number of ',
1390
     &             'variable dimensions must be less or equal 4.'
1391
      call ncpopt (ncopts)
1392
      call ncclos (cdfid, error)
1393
      return
1394
 
1395
 920  write (6, *) '*ERROR*: An error occurred while attempting to ',
1396
     &             'write the data file in subroutine putcdf.'
1397
      call ncpopt (ncopts)
1398
      call ncclos (cdfid, error)
1399
      return
1400
      end
1401
 
1402
 
1403
      subroutine gettimes(cdfid,times,ntimes,ierr)
1404
C------------------------------------------------------------------------
1405
C     Purpose:
1406
C        Get all times on the specified NetCDF file
1407
C     Arguments: 
1408
C        cdfid  int  input   identifier for NetCDF file
1409
C        times	real output  array contains all time values on the file,
1410
C                            dimensioned at least times(ntimes)
1411
C        ntimes int  output  number of times on the file
1412
C        error  int  output  errorflag 
1413
C     History:
1414
C        Heini Wernli, ETHZ  
1415
C------------------------------------------------------------------------
1416
 
1417
      include "netcdf.inc"
1418
 
1419
      integer	ierr,i
1420
      real times(*)
1421
      integer didtim,ntimes
1422
 
1423
      integer	cdfid,idtime
1424
      integer	ncopts
1425
      character*(20) dimnam
1426
 
1427
c     Get current value of error options, and make sure netCDF-errors do 
1428
c     not abort execution
1429
      call ncgopt (ncopts)
1430
      call ncpopt(NCVERBOS)
1431
 
1432
      didtim=ncdid(cdfid,'time',ierr)	! inquire id for time dimension
1433
      if (ierr.ne.0) goto 900
1434
      idtime=ncvid(cdfid,'time',ierr)   ! inquire id for time array
1435
      if (ierr.ne.0) goto 900
1436
      call ncdinq(cdfid,didtim,dimnam,ntimes,ierr)      ! inquire # of times
1437
      if (ierr.ne.0) goto 900
1438
 
1439
      do 10 i=1,ntimes
1440
        call ncvgt1(cdfid,idtime,i,times(i),ierr) ! get times
1441
        if (ierr.ne.0) goto 900
1442
   10 continue
1443
 
1444
c     normal exit
1445
      call ncpopt (ncopts)
1446
      return
1447
 
1448
c     error exit
1449
 900  ntimes=1
1450
      times(1)=0.
1451
      call ncpopt (ncopts)
1452
      end
1453
 
1454
 
1455
      subroutine puttimes(cdfid,times,ntimes,ierr)
1456
C------------------------------------------------------------------------
1457
C     Purpose:
1458
C        Get all times on the specified NetCDF file
1459
C     Arguments: 
1460
C        cdfid  int  input   identifier for NetCDF file
1461
C        times	real input   array contains all time values on the file,
1462
C                            dimensioned at least times(ntimes)
1463
C        ntimes int  input   number of times on the file
1464
C        error  int  output  errorflag 
1465
C     History:
1466
C        Heini Wernli, ETHZ  
1467
C        Christoph Schaer, ETHZ
1468
C     Note:
1469
C        This preliminary version does not define the times-array, but only
1470
C        overwrites or extends an existing times-array.
1471
C------------------------------------------------------------------------
1472
 
1473
      integer	ierr,i
1474
      real times(*)
1475
      integer didtim,ntimes
1476
 
1477
      integer	cdfid,idtime,nfiltim
1478
      integer	ncdid,ncvid
1479
 
1480
      idtime=ncvid(cdfid,'time',ierr)   ! inquire id for time array
1481
      if (ierr.ne.0) return
1482
      didtim=ncdid(cdfid,'time',ierr)	! inquire id for time dimension
1483
      if (ierr.ne.0) return
1484
 
1485
      call ncdinq(cdfid,didtim,'time',nfiltim,ierr)   ! inquire # of times
1486
      if (ierr.ne.0) return
1487
      if (nfiltim.lt.ntimes) then
1488
        print *,'Warning: puttimes is extending times-array'
1489
      else if (nfiltim.gt.ntimes) then
1490
        print *,'Warning: puttimes does not cover range of times-array'
1491
      endif
1492
 
1493
      do 10 i=1,ntimes
1494
        call ncvpt1(cdfid,idtime,i,times(i),ierr)
1495
        if (ierr.ne.0) return
1496
   10 continue
1497
      end
1498
 
1499
 
1500
 
1501
      subroutine cpp_crecdf(filnam,filnam_len,cdfid,phymin,phymax,ndim,
1502
     &     cfn,cfn_len,error)
1503
C------------------------------------------------------------------------
1504
C     Purpose:
1505
C        allows to call crecdf from c++
1506
C     Arguments: 
1507
C        see crecdf
1508
C        additionally: fname_len and cfn_len, the length of the 
1509
C           strings
1510
C        
1511
C        
1512
C     History:
1513
C        981221  Mark A. Liniger ETHZ
1514
C        
1515
C     Note:
1516
C        
1517
C        
1518
C------------------------------------------------------------------------
1519
      integer        filnam_len,ndim,cfn_len,error,cdfid
1520
      character *(*) filnam,cfn
1521
      real           phymin(*),phymax(*)
1522
 
1523
      call crecdf (filnam(1:filnam_len),cdfid,phymin,phymax,ndim,
1524
     &     cfn(1:cfn_len),error)
1525
 
1526
      end
1527
 
1528
 
1529
      subroutine cpp_putdef(cdfid,varnam,varnam_len,ndim,misdat,
1530
     &     vardim,varmin,varmax,stag,error)
1531
C------------------------------------------------------------------------
1532
C     Purpose:
1533
C        allows to call putdef from c++
1534
C     Arguments: 
1535
C        see crecdf
1536
C        additionally: varnam_len, the length of the 
1537
C           strings
1538
C        
1539
C        
1540
C     History:
1541
C        981221  Mark A. Liniger ETHZ
1542
C        
1543
C     Note:
1544
C        
1545
C        
1546
C------------------------------------------------------------------------
1547
      integer        varnam_len,ndim,error,vardim(*),cdfid
1548
      character *(*) varnam
1549
      real           misdat,stag(*),varmin(*),varmax(*)
1550
 
1551
      call putdef (cdfid, varnam(1:varnam_len), ndim, misdat, 
1552
     &     vardim, varmin, varmax, stag, error)
1553
 
1554
      end
1555
 
1556
 
1557
      subroutine cpp_putdat(cdfid, varnam,varnam_len, 
1558
     &     time, level, dat, error)
1559
C------------------------------------------------------------------------
1560
C     Purpose:
1561
C        allows to call putdef from c++
1562
C     Arguments: 
1563
C        see crecdf
1564
C        additionally: varnam_len, the length of the 
1565
C           strings
1566
C        
1567
C        
1568
C     History:
1569
C        981221  Mark A. Liniger ETHZ
1570
C        
1571
C     Note:
1572
C        
1573
C        
1574
C------------------------------------------------------------------------
1575
      integer        varnam_len,cdfid,error,level
1576
      character *(*) varnam
1577
      real           dat(*)
1578
      real           time
1579
 
1580
      call putdat(cdfid, varnam(1:varnam_len), time, level, dat, error)
1581
 
1582
 
1583
 
1584
      end
1585
 
1586
      FUNCTION strbeg (string)
1587
c-----------------------------------------------------------------------
1588
c     Purpose:
1589
c        This function returns the position of the first nonblank
1590
c           character in the input string.  Returns 0 if the entire
1591
c           string is blank.
1592
c     Arguments:
1593
c        string  char  input  string to be examined.
1594
c     History:
1595
c-----------------------------------------------------------------------
1596
      IMPLICIT NONE
1597
c     Function declaration
1598
      INTEGER strbeg
1599
 
1600
c     Argument declarations
1601
      CHARACTER*(*) string
1602
 
1603
c     Local variable declarations.
1604
      INTEGER i
1605
 
1606
c     External function declarations.
1607
      INTEGER len
1608
 
1609
      DO i = 1, len(string)
1610
        strbeg = i
1611
        IF (string(i:i) .NE. ' ' .AND. string(i:i) .NE. char(0)) THEN
1612
          RETURN
1613
        ENDIF
1614
      ENDDO
1615
      strbeg = 0
1616
      END
1617
 
1618
      FUNCTION strend (string)
1619
c-----------------------------------------------------------------------
1620
c     Purpose:
1621
c        This function returns the position of the last nonblank
1622
c           character in the input string.  Returns 0 if the entire
1623
c           string is blank.
1624
c     Arguments:
1625
c        string  char  input  string to be examined.
1626
c     History:
1627
c-----------------------------------------------------------------------
1628
      IMPLICIT NONE
1629
c     Function declaration
1630
      INTEGER strend
1631
 
1632
c     Argument declarations
1633
      CHARACTER*(*) string
1634
 
1635
c     Local variable declarations.
1636
      INTEGER i
1637
 
1638
c     External function declarations.
1639
      INTEGER len
1640
 
1641
      DO i = len(string), 1, -1
1642
        strend = i
1643
        IF (string(i:i) .NE. ' ' .AND. string(i:i) .NE. char(0)) THEN
1644
          RETURN
1645
        ENDIF
1646
      ENDDO
1647
      strend = 0
1648
      END