fvcom_tools  1.7.0
 All Data Structures Files Functions Variables
module_ncio.f90
Go to the documentation of this file.
1 
4 
7 module module_ncio
8 
9  use netcdf
10  implicit none
11 
12  public :: ncio
13  ! set default to private
14  private
15  !
16  type :: ncio
17  character(len=256) :: filename
18  integer :: ncid
19  integer :: status
20  integer :: debug_level
21 
22  integer :: nDims
23  integer :: ends(4)
24  integer :: xtype
25  character(len=40) :: dimname(4)
26  contains
27  procedure :: open => open_nc
28  procedure :: close => close_nc
29  procedure :: get_dim => get_dim_nc
31  procedure :: get_att_nc_int
32  procedure :: get_att_nc_real
33  procedure :: get_att_nc_string
43  procedure :: get_var_nc_short
44  procedure :: get_var_nc_short_1d
45  procedure :: get_var_nc_short_2d
46  procedure :: get_var_nc_int
47  procedure :: get_var_nc_int_1d
48  procedure :: get_var_nc_int_2d
49  procedure :: get_var_nc_int_3d
50  procedure :: get_var_nc_real
51  procedure :: get_var_nc_real_1d
52  procedure :: get_var_nc_real_2d
53  procedure :: get_var_nc_real_3d
54  procedure :: get_var_nc_double
55  procedure :: get_var_nc_double_1d
56  procedure :: get_var_nc_double_2d
57  procedure :: get_var_nc_double_3d
58  procedure :: get_var_nc_char
59  procedure :: get_var_nc_char_1d
60  procedure :: get_var_nc_char_2d
61  procedure :: get_var_nc_char_3d
70  procedure :: replace_var_nc_int
71  procedure :: replace_var_nc_int_1d
72  procedure :: replace_var_nc_int_2d
73  procedure :: replace_var_nc_int_3d
74  procedure :: replace_var_nc_real
75  procedure :: replace_var_nc_real_1d
76  procedure :: replace_var_nc_real_2d
77  procedure :: replace_var_nc_real_3d
78  procedure :: replace_var_nc_double
82  procedure :: replace_var_nc_char
83  procedure :: replace_var_nc_char_1d
84  procedure :: replace_var_nc_char_2d
85  procedure :: replace_var_nc_char_3d
86  procedure :: handle_err
87  procedure :: convert_theta2t_2dgrid
88  generic :: add_new_var => add_new_var_2d, &
90  procedure :: add_new_var_2d
91  procedure :: add_new_var_3d
92  end type ncio
93 
94 contains
95 
103  subroutine open_nc(this,filename,action,debug_level)
104 
105  implicit none
106  !
107  class(ncio) :: this
108  character(len=*),intent(in) :: filename
109  character(len=1),intent(in) :: action
110  integer,intent(in),optional :: debug_level
111 
112  integer :: ncid, status
113 
114  this%debug_level=20
115  if(present(debug_level)) this%debug_level=debug_level
116 
117  this%filename=trim(filename)
118  ! open existing netCDF dataset
119  if(action=="r" .or. action=="R") then
120  status = nf90_open(path = trim(filename), mode = nf90_nowrite, ncid = ncid)
121  elseif(action=="w" .or. action=="W") then
122  status = nf90_open(path = trim(filename), mode = nf90_write, ncid = ncid)
123  else
124  write(6,*) 'unknow action :', action
125  stop 123
126  endif
127  if (status /= nf90_noerr) call this%handle_err(status)
128  this%ncid=ncid
129 
130  if(this%debug_level>0) then
131  write(6,*) '>>> open file: ',trim(this%filename)
132  endif
133 
134  end subroutine open_nc
135 
140  subroutine close_nc(this)
141 
142  implicit none
143  !
144  class(ncio) :: this
145 
146  integer :: ncid, status
147 
148  ncid=this%ncid
149  !
150  ! close netCDF dataset
151  status = nf90_close(ncid)
152  if (status /= nf90_noerr) call this%handle_err(status)
153 
154  end subroutine close_nc
155 
162  subroutine get_att_nc_real(this,attname,rval)
163  implicit none
164  !
165  class(ncio) :: this
166  character(len=*),intent(in) :: attname
167  real, intent(out) :: rval
168 
169  integer :: ncid, status
170 
171  ! open existing netCDF dataset
172  ncid=this%ncid
173 
174  ! get date from exisiting NC file
175  status = nf90_get_att(ncid, nf90_global, trim(attname), rval)
176  if (status /= nf90_noerr) call this%handle_err(status)
177  !
178  end subroutine get_att_nc_real
179 
186  subroutine get_att_nc_int(this,attname,ival)
187  implicit none
188  !
189  class(ncio) :: this
190  character(len=*),intent(in) :: attname
191  integer, intent(out) :: ival
192 
193  integer :: ncid, status
194 
195  ! open existing netCDF dataset
196  ncid=this%ncid
197 
198  ! get date from exisiting NC file
199  status = nf90_get_att(ncid, nf90_global, trim(attname), ival)
200  if (status /= nf90_noerr) call this%handle_err(status)
201  !
202  end subroutine get_att_nc_int
203 
210  subroutine get_att_nc_string(this,attname,string)
211  implicit none
212  !
213  class(ncio) :: this
214  character(len=*),intent(in) :: attname
215  character(len=*), intent(out) :: string
216 
217  integer :: ncid, status
218 
219  ! open existing netCDF dataset
220  ncid=this%ncid
221 
222  ! get date from exisiting NC file
223  status = nf90_get_att(ncid, nf90_global, trim(attname), string)
224  if (status /= nf90_noerr) call this%handle_err(status)
225  !
226  end subroutine get_att_nc_string
227 
228 
235  subroutine get_dim_nc(this,dimname,dimvalue)
236  implicit none
237  !
238  class(ncio) :: this
239  character(len=*), intent(in) :: dimname
240  integer,intent(out) :: dimvalue
241 
242  integer :: ncid, status
243  integer :: dimid
244 
245  ! open existing netCDF dataset
246  ncid=this%ncid
247 
248  ! get dimension from exisiting NC file
249  status = nf90_inq_dimid(ncid,trim(dimname), dimid)
250  if (status /= nf90_noerr) call this%handle_err(status)
251  status = nf90_inquire_dimension(ncid, dimid, len = dimvalue)
252  if (status /= nf90_noerr) call this%handle_err(status)
253  !
254  end subroutine get_dim_nc
255 
263  subroutine replace_var_nc_char_1d(this,varname,nd1,field)
264 
265  use netcdf
266  !
267  implicit none
268  !
269  class(ncio) :: this
270  character(len=*),intent(in) :: varname ! name of the field to read
271  integer, intent(in) :: nd1 ! size of array dval
272  character, intent(in) :: field(nd1) ! values of the field read in
273  integer :: ilength
274  !
275  character*40,parameter :: thissubname='replace_var_nc_char_1d'
276  !
277  integer :: i
278  !
279  !
280  ilength=nd1
281  !
282  if(this%debug_level>100) then
283  write(6,*) trim(thissubname),' show samples:'
284  write(6,*) (field(i),i=1,min(nd1,10))
285  endif
286 
287  call this%replace_var_nc_char(varname,ilength,field)
288  !
289  end subroutine replace_var_nc_char_1d
290 
299  subroutine replace_var_nc_char_2d(this,varname,nd1,nd2,field)
300  use netcdf
301  !
302  implicit none
303  !
304  class(ncio) :: this
305  character(len=*),intent(in) :: varname ! name of the field to read
306  integer, intent(in) :: nd1,nd2 ! size of array dval
307  character, intent(in) :: field(nd1,nd2) ! values of the field read in
308  integer :: ilength
309  !
310  character,allocatable :: temp(:)
311  !
312  character*40,parameter :: thissubname='replace_var_nc_char_2d'
313  !
314  integer :: i,j,k
315  integer :: istart,iend
316  !
317  !
318  ilength=nd1*nd2
319  allocate(temp(ilength))
320 
321  do j=1,nd2
322  istart=(j-1)*nd1+1
323  iend=(j-1)*nd1+nd1
324  temp(istart:iend)=field(:,j)
325  enddo
326  !
327  if(this%debug_level>100) then
328  write(6,*) trim(thissubname),' show samples:'
329  write(6,*) field(1,1)
330  endif
331  !
332  call this%replace_var_nc_char(varname,ilength,temp)
333 
334  deallocate(temp)
335  !
336  end subroutine replace_var_nc_char_2d
337 
347  subroutine replace_var_nc_char_3d(this,varname,nd1,nd2,nd3,field)
348  use netcdf
349  !
350  implicit none
351  !
352  class(ncio) :: this
353  character(len=*),intent(in) :: varname ! name of the field to read
354  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
355  character, intent(in) :: field(nd1,nd2,nd3) ! values of the field read in
356  integer :: ilength
357  !
358  character,allocatable :: temp(:)
359  !
360  character*40,parameter :: thissubname='replace_var_nc_char_3d'
361  !
362  integer :: i,j,k
363  integer :: length2d
364  integer :: istart,iend
365  !
366  !
367  length2d=nd1*nd2
368  ilength=length2d*nd3
369  allocate(temp(ilength))
370 
371  do k=1,nd3
372  do j=1,nd2
373  istart=(k-1)*length2d+(j-1)*nd1+1
374  iend =(k-1)*length2d+(j-1)*nd1+nd1
375  temp(istart:iend)=field(:,j,k)
376  enddo
377  enddo
378  !
379  if(this%debug_level>100) then
380  write(6,*) trim(thissubname),' show samples:'
381  write(6,*) field(1,1,1)
382  endif
383 
384  call this%replace_var_nc_char(varname,ilength,temp)
385 
386  deallocate(temp)
387  !
388  end subroutine replace_var_nc_char_3d
389 
397  subroutine replace_var_nc_char(this,varname,ilength,field)
398  use netcdf
399  !
400  implicit none
401  !
402  class(ncio) :: this
403  character(len=*),intent(in) :: varname ! name of the field to read
404  integer, intent(in) :: ilength ! size of array dval
405  character, intent(in) :: field(ilength) ! values of the field read in
406  !
407  integer :: ncid
408  !
409  integer :: status
410  integer :: varid
411  integer :: ends(4),start(4)
412 
413  integer :: length4d,length3d,length2d
414  integer :: ndims,ndim
415  integer :: dimids(4)
416  integer :: xtype
417  character*40 :: dimname
418 
419  character*40,parameter :: thissubname='replace_var_nc_char'
420  !
421  integer :: i,k
422  !
423  !
424  ncid=this%ncid
425 
426  ! get variable IDs
427  status = nf90_inq_varid(ncid, trim(varname), varid)
428  if(status /= nf90_noerr) call this%handle_err(status)
429 
430  ! get dimensions
431  ends=1
432  start=1
433  this%ends=1
434 
435  this%dimname=" "
436  ! get variable type
437  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
438  if(status /= nf90_noerr) call this%handle_err(status)
439  if(xtype==nf90_char) then
440  this%xtype=xtype
441  else
442  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_int,' but read in ',xtype
443  stop 123
444  endif
445 
446  ! get dimension size
447  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
448  if(status /= nf90_noerr) call this%handle_err(status)
449  this%ndims=ndims
450  !
451  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
452  if(status /= nf90_noerr) call this%handle_err(status)
453  do i=1,ndims
454  dimname=" "
455  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
456  if (status /= nf90_noerr) call this%handle_err(status)
457  ends(i)=ndim
458  this%ends(i)=ends(i)
459  this%dimname(i)=trim(dimname)
460  if(this%ends(i) < 1) then
461  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
462  stop 1234
463  endif
464  enddo
465  length2d=ends(1)*ends(2)
466  length3d=length2d*ends(3)
467  length4d=length3d*ends(4)
468  if(ilength .ne. length4d) then
469  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
470  stop 123
471  endif
472  !
473  if(ndims <=4 ) then
474  status = nf90_put_var(ncid, varid, field, &
475  start = start(1:4) , &
476  count = ends(1:4))
477  if(status /= nf90_noerr) call this%handle_err(status)
478  else
479  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
480  stop 1234
481  endif
482  !
483  if(this%debug_level>0) then
484  write(6,'(a,a)') '>>>replace variable: ',trim(varname)
485  endif
486  if(this%debug_level>10) then
487  write(6,'(8x,a,I10)') 'data type : ',this%xtype
488  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
489  do i=1,this%nDims
490  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
491  enddo
492  endif
493  !
494  end subroutine replace_var_nc_char
495  !--- replace_var_nc_char
496 
504  subroutine replace_var_nc_real_1d(this,varname,nd1,field)
505  use netcdf
506  !
507  implicit none
508  !
509  class(ncio) :: this
510  character(len=*),intent(in) :: varname ! name of the field to read
511  integer, intent(in) :: nd1 ! size of array dval
512  real(4), intent(in) :: field(nd1) ! values of the field read in
513  integer :: ilength
514  !
515  character*40,parameter :: thissubname='replace_var_nc_real_1d'
516  !
517  integer :: i
518  !
519  !
520  ilength=nd1
521  !
522  if(this%debug_level>100) then
523  write(6,*) trim(thissubname),' show samples:'
524  write(6,*) (field(i),i=1,min(nd1,10))
525  endif
526  !
527  call this%replace_var_nc_real(varname,ilength,field)
528  !
529  end subroutine replace_var_nc_real_1d
530 
539  subroutine replace_var_nc_real_2d(this,varname,nd1,nd2,field)
540  use netcdf
541  !
542  implicit none
543  !
544  class(ncio) :: this
545  character(len=*),intent(in) :: varname ! name of the field to read
546  integer, intent(in) :: nd1,nd2 ! size of array dval
547  real(4), intent(in) :: field(nd1,nd2) ! values of the field read in
548  integer :: ilength
549  !
550  real(4),allocatable :: temp(:)
551  !
552  character*40,parameter :: thissubname='replace_var_nc_real_2d'
553  !
554  integer :: i,j,k
555  integer :: istart,iend
556  !
557  !
558  ilength=nd1*nd2
559  allocate(temp(ilength))
560 
561  do j=1,nd2
562  istart=(j-1)*nd1+1
563  iend=(j-1)*nd1+nd1
564  temp(istart:iend)=field(:,j)
565  enddo
566  !
567  if(this%debug_level>100) then
568  write(6,*) trim(thissubname),' show samples:'
569  write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:))
570  endif
571 
572  call this%replace_var_nc_real(varname,ilength,temp)
573 
574  deallocate(temp)
575  !
576  end subroutine replace_var_nc_real_2d
577 
587  subroutine replace_var_nc_real_3d(this,varname,nd1,nd2,nd3,field)
588  !
589  ! read in one field
590  !
591  use netcdf
592  !
593  implicit none
594  !
595  class(ncio) :: this
596  character(len=*),intent(in) :: varname ! name of the field to read
597  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
598  real(4), intent(in) :: field(nd1,nd2,nd3) ! values of the field read in
599  integer :: ilength
600  !
601  real(4),allocatable :: temp(:)
602  !
603  character*40,parameter :: thissubname='replace_var_nc_real_3d'
604  !
605  integer :: i,j,k
606  integer :: length2d
607  integer :: istart,iend
608  !
609  !
610  length2d=nd1*nd2
611  ilength=length2d*nd3
612  allocate(temp(ilength))
613 
614  do k=1,nd3
615  do j=1,nd2
616  istart=(k-1)*length2d+(j-1)*nd1+1
617  iend =(k-1)*length2d+(j-1)*nd1+nd1
618  temp(istart:iend)=field(:,j,k)
619  enddo
620  enddo
621  !
622  if(this%debug_level>100) then
623  write(6,*) trim(thissubname),' show samples:'
624  do k=1,nd3
625  write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k))
626  enddo
627  endif
628 
629  call this%replace_var_nc_real(varname,ilength,temp)
630 
631  deallocate(temp)
632  !
633  end subroutine replace_var_nc_real_3d
634 
642  subroutine replace_var_nc_real(this,varname,ilength,field)
643  use netcdf
644  !
645  implicit none
646  !
647  class(ncio) :: this
648  character(len=*),intent(in) :: varname ! name of the field to read
649  integer, intent(in) :: ilength ! size of array dval
650  real(4), intent(in) :: field(ilength) ! values of the field read in
651  !
652  integer :: ncid
653  !
654  integer :: status
655  integer :: varid
656  integer :: ends(4),start(4)
657 
658  integer :: length4d,length3d,length2d
659  integer :: ndims,ndim
660  integer :: dimids(4)
661  integer :: xtype
662  character*40 :: dimname
663 
664  character*40,parameter :: thissubname='replace_var_nc_real'
665  !
666  integer :: i,k
667  !
668  !
669  ncid=this%ncid
670 
671  ! get variable IDs
672  status = nf90_inq_varid(ncid, trim(varname), varid)
673  if(status /= nf90_noerr) call this%handle_err(status)
674 
675  ! get dimensions
676  ends=1
677  start=1
678  this%ends=1
679 
680  this%dimname=" "
681  ! get variable type
682  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
683  if(status /= nf90_noerr) call this%handle_err(status)
684  if(xtype==nf90_float) then
685  this%xtype=xtype
686  else
687  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_int,' but read in ',xtype
688  stop 123
689  endif
690 
691  ! get dimension size
692  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
693  if(status /= nf90_noerr) call this%handle_err(status)
694  this%ndims=ndims
695  !
696  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
697  if(status /= nf90_noerr) call this%handle_err(status)
698  do i=1,ndims
699  dimname=" "
700  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
701  if (status /= nf90_noerr) call this%handle_err(status)
702  ends(i)=ndim
703  this%ends(i)=ends(i)
704  this%dimname(i)=trim(dimname)
705  if(this%ends(i) < 1) then
706  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
707  stop 1234
708  endif
709  enddo
710  length2d=ends(1)*ends(2)
711  length3d=length2d*ends(3)
712  length4d=length3d*ends(4)
713  if(ilength .ne. length4d) then
714  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
715  stop 123
716  endif
717  !
718  if(ndims <=4 ) then
719  status = nf90_put_var(ncid, varid, field, &
720  start = start(1:4) , &
721  count = ends(1:4))
722  if(status /= nf90_noerr) call this%handle_err(status)
723  else
724  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
725  stop 1234
726  endif
727  !
728  if(this%debug_level>0) then
729  write(6,'(a,a)') '>>>replace variable: ',trim(varname)
730  endif
731  if(this%debug_level>10) then
732  write(6,'(8x,a,I10)') 'data type : ',this%xtype
733  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
734  do i=1,this%nDims
735  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
736  enddo
737  endif
738  !
739  end subroutine replace_var_nc_real
740 
748  subroutine replace_var_nc_double_1d(this,varname,nd1,field)
749  !
750  ! read in one field
751  !
752  use netcdf
753  !
754  implicit none
755  !
756  class(ncio) :: this
757  character(len=*),intent(in) :: varname ! name of the field to read
758  integer, intent(in) :: nd1 ! size of array dval
759  real(8), intent(in) :: field(nd1) ! values of the field read in
760  integer :: ilength
761  !
762  character*40,parameter :: thissubname='replace_var_nc_double_1d'
763  !
764  integer :: i
765  !
766  !
767  ilength=nd1
768  !
769  if(this%debug_level>100) then
770  write(6,*) trim(thissubname),' show samples:'
771  write(6,*) (field(i),i=1,min(nd1,10))
772  endif
773  !
774  call this%replace_var_nc_double(varname,ilength,field)
775  !
776  end subroutine replace_var_nc_double_1d
777 
786  subroutine replace_var_nc_double_2d(this,varname,nd1,nd2,field)
787  !
788  ! read in one field
789  !
790  use netcdf
791  !
792  implicit none
793  !
794  class(ncio) :: this
795  character(len=*),intent(in) :: varname ! name of the field to read
796  integer, intent(in) :: nd1,nd2 ! size of array dval
797  real(8), intent(in) :: field(nd1,nd2) ! values of the field read in
798  integer :: ilength
799  !
800  real(8),allocatable :: temp(:)
801  !
802  character*40,parameter :: thissubname='replace_var_nc_double_2d'
803  !
804  integer :: i,j,k
805  integer :: istart,iend
806  !
807  !
808  ilength=nd1*nd2
809  allocate(temp(ilength))
810 
811  do j=1,nd2
812  istart=(j-1)*nd1+1
813  iend=(j-1)*nd1+nd1
814  temp(istart:iend)=field(:,j)
815  enddo
816  !
817  if(this%debug_level>100) then
818  write(6,*) trim(thissubname),' show samples:'
819  write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:))
820  endif
821 
822  call this%replace_var_nc_double(varname,ilength,temp)
823 
824  deallocate(temp)
825  !
826  end subroutine replace_var_nc_double_2d
827 
837  subroutine replace_var_nc_double_3d(this,varname,nd1,nd2,nd3,field)
838  !
839  ! read in one field
840  !
841  use netcdf
842  !
843  implicit none
844  !
845  class(ncio) :: this
846  character(len=*),intent(in) :: varname ! name of the field to read
847  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
848  real(8), intent(in) :: field(nd1,nd2,nd3) ! values of the field read in
849  integer :: ilength
850  !
851  real(8),allocatable :: temp(:)
852  !
853  character*40,parameter :: thissubname='replace_var_nc_double_3d'
854  !
855  integer :: i,j,k
856  integer :: length2d
857  integer :: istart,iend
858  !
859  !
860  length2d=nd1*nd2
861  ilength=length2d*nd3
862  allocate(temp(ilength))
863 
864  do k=1,nd3
865  do j=1,nd2
866  istart=(k-1)*length2d+(j-1)*nd1+1
867  iend =(k-1)*length2d+(j-1)*nd1+nd1
868  temp(istart:iend)=field(:,j,k)
869  enddo
870  enddo
871  !
872  if(this%debug_level>100) then
873  write(6,*) trim(thissubname),' show samples:'
874  do k=1,nd3
875  write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k))
876  enddo
877  endif
878 
879  call this%replace_var_nc_double(varname,ilength,temp)
880 
881  deallocate(temp)
882  !
883  end subroutine replace_var_nc_double_3d
884  !
885 
893  subroutine replace_var_nc_double(this,varname,ilength,field)
894  use netcdf
895  !
896  implicit none
897  !
898  class(ncio) :: this
899  character(len=*),intent(in) :: varname ! name of the field to read
900  integer, intent(in) :: ilength ! size of array dval
901  real(8), intent(in) :: field(ilength) ! values of the field read in
902  !
903  integer :: ncid
904  !
905  integer :: status
906  integer :: varid
907  integer :: ends(4),start(4)
908 
909  integer :: length4d,length3d,length2d
910  integer :: ndims,ndim
911  integer :: dimids(4)
912  integer :: xtype
913  character*40 :: dimname
914 
915  character*40,parameter :: thissubname='replace_var_nc_double'
916  !
917  integer :: i,k
918  !
919  !
920  ncid=this%ncid
921 
922  ! get variable IDs
923  status = nf90_inq_varid(ncid, trim(varname), varid)
924  if(status /= nf90_noerr) call this%handle_err(status)
925 
926  ! get dimensions
927  ends=1
928  start=1
929  this%ends=1
930 
931  this%dimname=" "
932  ! get variable type
933  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
934  if(status /= nf90_noerr) call this%handle_err(status)
935  if(xtype==nf90_double) then
936  this%xtype=xtype
937  else
938  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_int,' but read in ',xtype
939  stop 123
940  endif
941 
942  ! get dimension size
943  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
944  if(status /= nf90_noerr) call this%handle_err(status)
945  this%ndims=ndims
946  !
947  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
948  if(status /= nf90_noerr) call this%handle_err(status)
949  do i=1,ndims
950  dimname=" "
951  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
952  if (status /= nf90_noerr) call this%handle_err(status)
953  ends(i)=ndim
954  this%ends(i)=ends(i)
955  this%dimname(i)=trim(dimname)
956  if(this%ends(i) < 1) then
957  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
958  stop 1234
959  endif
960  enddo
961  length2d=ends(1)*ends(2)
962  length3d=length2d*ends(3)
963  length4d=length3d*ends(4)
964  if(ilength .ne. length4d) then
965  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
966  stop 123
967  endif
968  !
969  if(ndims <=4 ) then
970  status = nf90_put_var(ncid, varid, field, &
971  start = start(1:4) , &
972  count = ends(1:4))
973  if(status /= nf90_noerr) call this%handle_err(status)
974  else
975  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
976  stop 1234
977  endif
978  !
979  if(this%debug_level>0) then
980  write(6,'(a,a)') '>>>replace variable: ',trim(varname)
981  endif
982  if(this%debug_level>10) then
983  write(6,'(8x,a,I10)') 'data type : ',this%xtype
984  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
985  do i=1,this%nDims
986  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
987  enddo
988  endif
989  !
990  end subroutine replace_var_nc_double
991 
999  subroutine replace_var_nc_int_1d(this,varname,nd1,field)
1000  use netcdf
1001  !
1002  implicit none
1003  !
1004  class(ncio) :: this
1005  character(len=*),intent(in) :: varname ! name of the field to read
1006  integer, intent(in) :: nd1 ! size of array dval
1007  integer, intent(in) :: field(nd1) ! values of the field read in
1008  integer :: ilength
1009  !
1010  character*40,parameter :: thissubname='get_var_nc_int_1d'
1011  !
1012  integer :: i
1013  !
1014  !
1015  ilength=nd1
1016  !
1017  if(this%debug_level>100) then
1018  write(6,*) trim(thissubname),' show samples:'
1019  write(6,*) (field(i),i=1,min(nd1,10))
1020  endif
1021 
1022  call this%replace_var_nc_int(varname,ilength,field)
1023  !
1024  end subroutine replace_var_nc_int_1d
1025 
1034  subroutine replace_var_nc_int_2d(this,varname,nd1,nd2,field)
1035  !
1036  ! read in one field
1037  !
1038  use netcdf
1039  !
1040  implicit none
1041  !
1042  class(ncio) :: this
1043  character(len=*),intent(in) :: varname ! name of the field to read
1044  integer, intent(in) :: nd1,nd2 ! size of array dval
1045  integer, intent(in) :: field(nd1,nd2) ! values of the field read in
1046  integer :: ilength
1047  !
1048  integer,allocatable :: temp(:)
1049  !
1050  character*40,parameter :: thissubname='replace_var_nc_int_2d'
1051  !
1052  integer :: i,j,k
1053  integer :: istart,iend
1054  !
1055  !
1056  ilength=nd1*nd2
1057  allocate(temp(ilength))
1058 
1059  do j=1,nd2
1060  istart=(j-1)*nd1+1
1061  iend=(j-1)*nd1+nd1
1062  temp(istart:iend)=field(:,j)
1063  enddo
1064  !
1065  if(this%debug_level>100) then
1066  write(6,*) trim(thissubname),' show samples:'
1067  write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:))
1068  endif
1069 
1070  call this%replace_var_nc_int(varname,ilength,temp)
1071 
1072  deallocate(temp)
1073  !
1074  end subroutine replace_var_nc_int_2d
1075 
1085  subroutine replace_var_nc_int_3d(this,varname,nd1,nd2,nd3,field)
1086  use netcdf
1087  !
1088  implicit none
1089  !
1090  class(ncio) :: this
1091  character(len=*),intent(in) :: varname ! name of the field to read
1092  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
1093  integer, intent(in) :: field(nd1,nd2,nd3) ! values of the field read in
1094  integer :: ilength
1095  !
1096  integer,allocatable :: temp(:)
1097  !
1098  character*40,parameter :: thissubname='replace_var_nc_int_3d'
1099  !
1100  integer :: i,j,k
1101  integer :: length2d
1102  integer :: istart,iend
1103  !
1104  !
1105  length2d=nd1*nd2
1106  ilength=length2d*nd3
1107  allocate(temp(ilength))
1108 
1109  do k=1,nd3
1110  do j=1,nd2
1111  istart=(k-1)*length2d+(j-1)*nd1+1
1112  iend =(k-1)*length2d+(j-1)*nd1+nd1
1113  temp(istart:iend)=field(:,j,k)
1114  enddo
1115  enddo
1116  !
1117  if(this%debug_level>100) then
1118  write(6,*) trim(thissubname),' show samples:'
1119  do k=1,nd3
1120  write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k))
1121  enddo
1122  endif
1123 
1124  call this%replace_var_nc_int(varname,ilength,temp)
1125 
1126  deallocate(temp)
1127  !
1128  end subroutine replace_var_nc_int_3d
1129 
1137  subroutine replace_var_nc_int(this,varname,ilength,field)
1138  use netcdf
1139  !
1140  implicit none
1141  !
1142  class(ncio) :: this
1143  character(len=*),intent(in) :: varname ! name of the field to read
1144  integer, intent(in) :: ilength ! size of array dval
1145  integer, intent(in) :: field(ilength) ! values of the field read in
1146  !
1147  integer :: ncid
1148  !
1149  integer :: status
1150  integer :: varid
1151  integer :: ends(4),start(4)
1152 
1153  integer :: length4d,length3d,length2d
1154  integer :: ndims,ndim
1155  integer :: dimids(4)
1156  integer :: xtype
1157  character*40 :: dimname
1158 
1159  character*40,parameter :: thissubname='replace_var_nc_int'
1160  !
1161  integer :: i,k
1162  !
1163  !
1164  ncid=this%ncid
1165 
1166  ! get variable IDs
1167  status = nf90_inq_varid(ncid, trim(varname), varid)
1168  if(status /= nf90_noerr) call this%handle_err(status)
1169 
1170  ! get dimensions
1171  ends=1
1172  start=1
1173  this%ends=1
1174 
1175  this%dimname=" "
1176  ! get variable type
1177  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
1178  if(status /= nf90_noerr) call this%handle_err(status)
1179  if(xtype==nf90_int) then
1180  this%xtype=xtype
1181  else
1182  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_int,' but read in ',xtype
1183  stop 123
1184  endif
1185 
1186  ! get dimension size
1187  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
1188  if(status /= nf90_noerr) call this%handle_err(status)
1189  this%ndims=ndims
1190  !
1191  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
1192  if(status /= nf90_noerr) call this%handle_err(status)
1193  do i=1,ndims
1194  dimname=" "
1195  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
1196  if (status /= nf90_noerr) call this%handle_err(status)
1197  ends(i)=ndim
1198  this%ends(i)=ends(i)
1199  this%dimname(i)=trim(dimname)
1200  if(this%ends(i) < 1) then
1201  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
1202  stop 1234
1203  endif
1204  enddo
1205  length2d=ends(1)*ends(2)
1206  length3d=length2d*ends(3)
1207  length4d=length3d*ends(4)
1208  if(ilength .ne. length4d) then
1209  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
1210  stop 123
1211  endif
1212  !
1213  if(ndims <=4 ) then
1214  status = nf90_put_var(ncid, varid, field, &
1215  start = start(1:4) , &
1216  count = ends(1:4))
1217  if(status /= nf90_noerr) call this%handle_err(status)
1218  else
1219  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
1220  stop 1634
1221  endif
1222  !
1223  if(this%debug_level>0) then
1224  write(6,'(a,a)') '>>>replace variable: ',trim(varname)
1225  endif
1226  if(this%debug_level>10) then
1227  write(6,'(8x,a,I10)') 'data type : ',this%xtype
1228  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
1229  do i=1,this%nDims
1230  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
1231  enddo
1232  endif
1233  !
1234  end subroutine replace_var_nc_int
1235 
1243  subroutine get_var_nc_double_1d(this,varname,nd1,field)
1244  use netcdf
1245  !
1246  implicit none
1247  !
1248  class(ncio) :: this
1249  character(len=*),intent(in) :: varname ! name of the field to read
1250  integer, intent(in) :: nd1 ! size of array dval
1251  real(8), intent(out) :: field(nd1) ! values of the field read in
1252  integer :: ilength
1253  !
1254  character*40,parameter :: thissubname='get_var_nc_double_1d'
1255  !
1256  integer :: i
1257  !
1258  !
1259  ilength=nd1
1260  call this%get_var_nc_double(varname,ilength,field)
1261  !
1262  if(nd1==this%ends(1)) then
1263  if(this%debug_level>100) then
1264  write(6,*) trim(thissubname),' show samples:'
1265  write(6,*) (field(i),i=1,min(nd1,10))
1266  endif
1267  else
1268  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1269  endif
1270  !
1271  end subroutine get_var_nc_double_1d
1272 
1281  subroutine get_var_nc_double_2d(this,varname,nd1,nd2,field)
1282  use netcdf
1283  !
1284  implicit none
1285  !
1286  class(ncio) :: this
1287  character(len=*),intent(in) :: varname ! name of the field to read
1288  integer, intent(in) :: nd1,nd2 ! size of array dval
1289  real(8), intent(out) :: field(nd1,nd2) ! values of the field read in
1290  integer :: ilength
1291  !
1292  real(8),allocatable :: temp(:)
1293  !
1294  character*40,parameter :: thissubname='get_var_nc_double_2d'
1295  !
1296  integer :: i,j,k
1297  integer :: istart,iend
1298  !
1299  !
1300  ilength=nd1*nd2
1301  allocate(temp(ilength))
1302 
1303  call this%get_var_nc_double(varname,ilength,temp)
1304 
1305  if(nd1==this%ends(1) .and. nd2==this%ends(2)) then
1306  do j=1,nd2
1307  istart=(j-1)*nd1+1
1308  iend=(j-1)*nd1+nd1
1309  field(:,j)=temp(istart:iend)
1310  enddo
1311  !
1312 ! if(this%debug_level>100) then
1313 ! write(*,*) trim(thissubname),' show samples:'
1314 ! write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:))
1315 ! endif
1316  else
1317  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1318  write(6,*) nd1,this%ends(1),nd2,this%ends(2)
1319  endif
1320  deallocate(temp)
1321  !
1322  end subroutine get_var_nc_double_2d
1323 
1333  subroutine get_var_nc_double_3d(this,varname,nd1,nd2,nd3,field)
1334  use netcdf
1335  !
1336  implicit none
1337  !
1338  class(ncio) :: this
1339  character(len=*),intent(in) :: varname ! name of the field to read
1340  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
1341  real(8), intent(out) :: field(nd1,nd2,nd3) ! values of the field read in
1342  integer :: ilength
1343  !
1344  real(8),allocatable :: temp(:)
1345  !
1346  character*40,parameter :: thissubname='get_var_nc_double_3d'
1347  !
1348  integer :: i,j,k
1349  integer :: length2d
1350  integer :: istart,iend
1351  !
1352  !
1353  length2d=nd1*nd2
1354  ilength=length2d*nd3
1355  allocate(temp(ilength))
1356 
1357  call this%get_var_nc_double(varname,ilength,temp)
1358 
1359  if(nd1==this%ends(1) .and. nd2==this%ends(2) .and. nd3==this%ends(3)) then
1360  do k=1,nd3
1361  do j=1,nd2
1362  istart=(k-1)*length2d+(j-1)*nd1+1
1363  iend =(k-1)*length2d+(j-1)*nd1+nd1
1364  field(:,j,k)=temp(istart:iend)
1365  enddo
1366  enddo
1367  !
1368 ! if(this%debug_level>100) then
1369 ! write(*,*) trim(thissubname),' show samples:'
1370 ! do k=1,nd3
1371 ! write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k))
1372 ! enddo
1373 ! endif
1374  else
1375  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1376  write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3)
1377  endif
1378  deallocate(temp)
1379  !
1380  end subroutine get_var_nc_double_3d
1381 
1389  subroutine get_var_nc_double(this,varname,ilength,field)
1390  use netcdf
1391  !
1392  implicit none
1393  !
1394  class(ncio) :: this
1395  character(len=*),intent(in) :: varname ! name of the field to read
1396  integer, intent(in) :: ilength ! size of array dval
1397  real(8), intent(out) :: field(ilength) ! values of the field read in
1398  !
1399  integer :: ncid
1400  !
1401  integer :: status
1402  integer :: varid
1403  integer :: ends(4),start(4)
1404 
1405  integer :: length4d,length3d,length2d
1406  integer :: ndims,ndim
1407  integer :: dimids(4)
1408  integer :: xtype
1409  character*40 :: dimname
1410 
1411  character*40,parameter :: thissubname='get_var_nc_double'
1412  !
1413  integer :: i,k
1414  !
1415  !
1416  ncid=this%ncid
1417 
1418  ! get variable IDs
1419  status = nf90_inq_varid(ncid, trim(varname), varid)
1420  if(status /= nf90_noerr) call this%handle_err(status)
1421 
1422  ! get dimensions
1423  ends=1
1424  start=1
1425  this%ends=1
1426 
1427  this%dimname=" "
1428  ! get variable type
1429  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
1430  if(status /= nf90_noerr) call this%handle_err(status)
1431  if(xtype==nf90_double) then
1432  this%xtype=xtype
1433  else
1434  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_double,' but read in ',xtype
1435  stop 123
1436  endif
1437 
1438  ! get dimension size
1439  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
1440  if(status /= nf90_noerr) call this%handle_err(status)
1441  this%ndims=ndims
1442  !
1443  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
1444  if(status /= nf90_noerr) call this%handle_err(status)
1445  do i=1,ndims
1446  dimname=" "
1447  write(6,*) 'dimids(i) = ', dimids(i)
1448  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
1449  if (status /= nf90_noerr) call this%handle_err(status)
1450  ends(i)=ndim
1451  this%ends(i)=ends(i)
1452  this%dimname(i)=trim(dimname)
1453  if(this%ends(i) < 1) then
1454  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
1455  stop 1234
1456  endif
1457  enddo
1458  length2d=ends(1)*ends(2)
1459  length3d=length2d*ends(3)
1460  length4d=length3d*ends(4)
1461  if(ilength .ne. length4d) then
1462  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
1463  stop 123
1464  endif
1465  !
1466  if(ndims <=4 ) then
1467  status = nf90_get_var(ncid, varid, field, &
1468  start = start(1:4) , &
1469  count = ends(1:4))
1470  if(status /= nf90_noerr) call this%handle_err(status)
1471  else
1472  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
1473  stop 1234
1474  endif
1475  !
1476  if(this%debug_level>0) then
1477  write(6,'(a,a)') '>>>read in variable: ',trim(varname)
1478  endif
1479  if(this%debug_level>10) then
1480  write(6,'(a,I10)') ' data type : ',this%xtype
1481  write(6,'(a,I10)')' dimension size: ',this%nDims
1482  do i=1,this%nDims
1483  write(6,'(a,I5,I10,2x,a)') ' rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
1484  enddo
1485  endif
1486  !
1487  end subroutine get_var_nc_double
1488 
1496  subroutine get_var_nc_real_1d(this,varname,nd1,field)
1497  use netcdf
1498  !
1499  implicit none
1500  !
1501  class(ncio) :: this
1502  character(len=*),intent(in) :: varname ! name of the field to read
1503  integer, intent(in) :: nd1 ! size of array dval
1504  real(4), intent(out) :: field(nd1) ! values of the field read in
1505  integer :: ilength
1506  !
1507  character*40,parameter :: thissubname='get_var_nc_real_1d'
1508  !
1509  integer :: i
1510  !
1511  !
1512  ilength=nd1
1513  call this%get_var_nc_real(varname,ilength,field)
1514  !
1515  if(nd1==this%ends(1)) then
1516  if(this%debug_level>100) then
1517  write(6,*) trim(thissubname),' show samples:'
1518  write(6,*) (field(i),i=1,min(nd1,10))
1519  endif
1520  else
1521  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1522  endif
1523  !
1524  end subroutine get_var_nc_real_1d
1525 
1534  subroutine get_var_nc_real_2d(this,varname,nd1,nd2,field)
1535  !
1536  ! read in one field
1537  !
1538  use netcdf
1539  !
1540  implicit none
1541  !
1542  class(ncio) :: this
1543  character(len=*),intent(in) :: varname ! name of the field to read
1544  integer, intent(in) :: nd1,nd2 ! size of array dval
1545  real(4), intent(out) :: field(nd1,nd2) ! values of the field read in
1546  integer :: ilength
1547  !
1548  real(4),allocatable :: temp(:)
1549  !
1550  character*40,parameter :: thissubname='get_var_nc_real_2d'
1551  !
1552  integer :: i,j,k
1553  integer :: istart,iend
1554  !
1555  !
1556  ilength=nd1*nd2
1557  allocate(temp(ilength))
1558 
1559  call this%get_var_nc_real(varname,ilength,temp)
1560 
1561  if(nd1==this%ends(1) .and. nd2==this%ends(2)) then
1562  do j=1,nd2
1563  istart=(j-1)*nd1+1
1564  iend=(j-1)*nd1+nd1
1565  field(:,j)=temp(istart:iend)
1566  enddo
1567  !
1568  if(this%debug_level>100) then
1569  write(6,*) trim(thissubname),' show samples:'
1570  write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:))
1571  endif
1572  else
1573  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1574  write(6,*) nd1,this%ends(1),nd2,this%ends(2)
1575  endif
1576  deallocate(temp)
1577  !
1578  end subroutine get_var_nc_real_2d
1579 
1589  subroutine get_var_nc_real_3d(this,varname,nd1,nd2,nd3,field)
1590  use netcdf
1591  !
1592  implicit none
1593  !
1594  class(ncio) :: this
1595  character(len=*),intent(in) :: varname ! name of the field to read
1596  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
1597  real(4), intent(out) :: field(nd1,nd2,nd3) ! values of the field read in
1598  integer :: ilength
1599  !
1600  real(4),allocatable :: temp(:)
1601  !
1602  character*40,parameter :: thissubname='get_var_nc_real_3d'
1603  !
1604  integer :: i,j,k
1605  integer :: length2d
1606  integer :: istart,iend
1607  !
1608  !
1609  length2d=nd1*nd2
1610  ilength=length2d*nd3
1611  allocate(temp(ilength))
1612 
1613  call this%get_var_nc_real(varname,ilength,temp)
1614 
1615  if(nd1==this%ends(1) .and. nd2==this%ends(2) .and. nd3==this%ends(3)) then
1616  do k=1,nd3
1617  do j=1,nd2
1618  istart=(k-1)*length2d+(j-1)*nd1+1
1619  iend =(k-1)*length2d+(j-1)*nd1+nd1
1620  field(:,j,k)=temp(istart:iend)
1621  enddo
1622  enddo
1623  !
1624  if(this%debug_level>100) then
1625  write(6,*) trim(thissubname),' show samples:'
1626  do k=1,nd3
1627  write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k))
1628  enddo
1629  endif
1630  else
1631  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1632  write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3)
1633  endif
1634  deallocate(temp)
1635  !
1636  end subroutine get_var_nc_real_3d
1637 
1645  subroutine get_var_nc_real(this,varname,ilength,field)
1646  !
1647  ! read in one field
1648  !
1649  use netcdf
1650  !
1651  implicit none
1652  !
1653  class(ncio) :: this
1654  character(len=*),intent(in) :: varname ! name of the field to read
1655  integer, intent(in) :: ilength ! size of array dval
1656  real(4), intent(out) :: field(ilength) ! values of the field read in
1657  !
1658  integer :: ncid
1659  !
1660  integer :: status
1661  integer :: varid
1662  integer :: ends(4),start(4)
1663 
1664  integer :: length4d,length3d,length2d
1665  integer :: ndims,ndim
1666  integer :: dimids(4)
1667  integer :: xtype
1668  character*40 :: dimname
1669 
1670  character*40,parameter :: thissubname='get_var_nc_real'
1671  !
1672  integer :: i,k
1673  !
1674  !
1675  ncid=this%ncid
1676 
1677  ! get variable IDs
1678  status = nf90_inq_varid(ncid, trim(varname), varid)
1679  if(status /= nf90_noerr) call this%handle_err(status)
1680 
1681  ! get dimensions
1682  ends=1
1683  start=1
1684  this%ends=1
1685 
1686  this%dimname=" "
1687  ! get variable type
1688  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
1689  if(status /= nf90_noerr) call this%handle_err(status)
1690  if(xtype==nf90_float) then
1691  this%xtype=xtype
1692  else
1693  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_float,' but read in ',xtype
1694  stop 123
1695  endif
1696 
1697  ! get dimension size
1698  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
1699  if(status /= nf90_noerr) call this%handle_err(status)
1700  this%ndims=ndims
1701  !
1702  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
1703  if(status /= nf90_noerr) call this%handle_err(status)
1704  do i=1,ndims
1705  dimname=" "
1706  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
1707  if (status /= nf90_noerr) call this%handle_err(status)
1708  ends(i)=ndim
1709  this%ends(i)=ends(i)
1710  this%dimname(i)=trim(dimname)
1711  if(this%ends(i) < 1) then
1712  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
1713  stop 1234
1714  endif
1715  enddo
1716  length2d=ends(1)*ends(2)
1717  length3d=length2d*ends(3)
1718  length4d=length3d*ends(4)
1719  if(ilength .ne. length4d) then
1720  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
1721  stop 123
1722  endif
1723  !
1724  if(ndims <=4 ) then
1725  status = nf90_get_var(ncid, varid, field, &
1726  start = start(1:4) , &
1727  count = ends(1:4))
1728  if(status /= nf90_noerr) call this%handle_err(status)
1729  else
1730  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
1731  stop 1234
1732  endif
1733  !
1734  if(this%debug_level>0) then
1735  write(6,'(a,a)') '>>>read in variable: ',trim(varname)
1736  endif
1737  if(this%debug_level>10) then
1738  write(6,'(8x,a,I10)') 'data type : ',this%xtype
1739  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
1740  do i=1,this%nDims
1741  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
1742  enddo
1743  endif
1744  !
1745  end subroutine get_var_nc_real
1746 
1754  subroutine get_var_nc_int_1d(this,varname,nd1,field)
1755  use netcdf
1756  !
1757  implicit none
1758  !
1759  class(ncio) :: this
1760  character(len=*),intent(in) :: varname ! name of the field to read
1761  integer, intent(in) :: nd1 ! size of array dval
1762  integer, intent(out) :: field(nd1) ! values of the field read in
1763  integer :: ilength
1764  !
1765  character*40,parameter :: thissubname='get_var_nc_int_1d'
1766  !
1767  integer :: i
1768  !
1769  !
1770  ilength=nd1
1771  call this%get_var_nc_int(varname,ilength,field)
1772  !
1773  if(nd1==this%ends(1)) then
1774  if(this%debug_level>100) then
1775  write(6,*) trim(thissubname),' show samples:'
1776  write(6,*) (field(i),i=1,min(nd1,10))
1777  endif
1778  else
1779  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1780  endif
1781  !
1782  end subroutine get_var_nc_int_1d
1783 
1792  subroutine get_var_nc_int_2d(this,varname,nd1,nd2,field)
1793  !
1794  ! read in one field
1795  !
1796  use netcdf
1797  !
1798  implicit none
1799  !
1800  class(ncio) :: this
1801  character(len=*),intent(in) :: varname ! name of the field to read
1802  integer, intent(in) :: nd1,nd2 ! size of array dval
1803  integer, intent(out) :: field(nd1,nd2) ! values of the field read in
1804  integer :: ilength
1805  !
1806  integer,allocatable :: temp(:)
1807  !
1808  character*40,parameter :: thissubname='get_var_nc_int_2d'
1809  !
1810  integer :: i,j,k
1811  integer :: istart,iend
1812  !
1813  !
1814  ilength=nd1*nd2
1815  allocate(temp(ilength))
1816 
1817  call this%get_var_nc_int(varname,ilength,temp)
1818 
1819  if(nd1==this%ends(1) .and. nd2==this%ends(2)) then
1820  do j=1,nd2
1821  istart=(j-1)*nd1+1
1822  iend=(j-1)*nd1+nd1
1823  field(:,j)=temp(istart:iend)
1824  enddo
1825  !
1826  if(this%debug_level>100) then
1827  write(6,*) trim(thissubname),' show samples:'
1828  write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:))
1829  endif
1830  else
1831  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1832  write(6,*) nd1,this%ends(1),nd2,this%ends(2)
1833  endif
1834  deallocate(temp)
1835  !
1836  end subroutine get_var_nc_int_2d
1837 
1847  subroutine get_var_nc_int_3d(this,varname,nd1,nd2,nd3,field)
1848  use netcdf
1849  !
1850  implicit none
1851  !
1852  class(ncio) :: this
1853  character(len=*),intent(in) :: varname ! name of the field to read
1854  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
1855  integer, intent(out) :: field(nd1,nd2,nd3) ! values of the field read in
1856  integer :: ilength
1857  !
1858  integer,allocatable :: temp(:)
1859  !
1860  character*40,parameter :: thissubname='get_var_nc_int_3d'
1861  !
1862  integer :: i,j,k
1863  integer :: length2d
1864  integer :: istart,iend
1865  !
1866  !
1867  length2d=nd1*nd2
1868  ilength=length2d*nd3
1869  allocate(temp(ilength))
1870 
1871  call this%get_var_nc_int(varname,ilength,temp)
1872 
1873  if(nd1==this%ends(1) .and. nd2==this%ends(2) .and. nd3==this%ends(3)) then
1874  do k=1,nd3
1875  do j=1,nd2
1876  istart=(k-1)*length2d+(j-1)*nd1+1
1877  iend =(k-1)*length2d+(j-1)*nd1+nd1
1878  field(:,j,k)=temp(istart:iend)
1879  enddo
1880  enddo
1881  !
1882  if(this%debug_level>100) then
1883  write(6,*) trim(thissubname),' show samples:'
1884  do k=1,nd3
1885  write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k))
1886  enddo
1887  endif
1888  else
1889  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
1890  write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3)
1891  endif
1892  deallocate(temp)
1893  !
1894  end subroutine get_var_nc_int_3d
1895 
1903  subroutine get_var_nc_int(this,varname,ilength,field)
1904  !
1905  ! read in one field
1906  !
1907  use netcdf
1908  !
1909  implicit none
1910  !
1911  class(ncio) :: this
1912  character(len=*),intent(in) :: varname ! name of the field to read
1913  integer, intent(in) :: ilength ! size of array dval
1914  integer, intent(out) :: field(ilength) ! values of the field read in
1915  !
1916  integer :: ncid
1917  !
1918  integer :: status
1919  integer :: varid
1920  integer :: ends(4),start(4)
1921 
1922  integer :: length4d,length3d,length2d
1923  integer :: ndims,ndim
1924  integer :: dimids(4)
1925  integer :: xtype
1926  character*40 :: dimname
1927 
1928  character*40,parameter :: thissubname='get_var_nc_int'
1929  !
1930  integer :: i,k
1931  !
1932  !
1933  ncid=this%ncid
1934 
1935  ! get variable IDs
1936  status = nf90_inq_varid(ncid, trim(varname), varid)
1937  if(status /= nf90_noerr) call this%handle_err(status)
1938 
1939  ! get dimensions
1940  ends=1
1941  start=1
1942  this%ends=1
1943 
1944  this%dimname=" "
1945  ! get variable type
1946  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
1947  if(status /= nf90_noerr) call this%handle_err(status)
1948  if(xtype==nf90_int) then
1949  this%xtype=xtype
1950  else
1951  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_int,' but read in ',xtype
1952  stop 123
1953  endif
1954 
1955  ! get dimension size
1956  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
1957  if(status /= nf90_noerr) call this%handle_err(status)
1958  this%ndims=ndims
1959  !
1960  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
1961  if(status /= nf90_noerr) call this%handle_err(status)
1962  do i=1,ndims
1963  dimname=" "
1964  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
1965  if (status /= nf90_noerr) call this%handle_err(status)
1966  ends(i)=ndim
1967  this%ends(i)=ends(i)
1968  this%dimname(i)=trim(dimname)
1969  if(this%ends(i) < 1) then
1970  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
1971  stop 1234
1972  endif
1973  enddo
1974  length2d=ends(1)*ends(2)
1975  length3d=length2d*ends(3)
1976  length4d=length3d*ends(4)
1977  if(ilength .ne. length4d) then
1978  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
1979  stop 123
1980  endif
1981  !
1982  if(ndims <=4 ) then
1983  status = nf90_get_var(ncid, varid, field, &
1984  start = start(1:4) , &
1985  count = ends(1:4))
1986  if(status /= nf90_noerr) call this%handle_err(status)
1987  else
1988  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
1989  stop 1234
1990  endif
1991  !
1992  if(this%debug_level>0) then
1993  write(6,'(a,a)') '>>>read in variable: ',trim(varname)
1994  endif
1995  if(this%debug_level>10) then
1996  write(6,'(8x,a,I10)') 'data type : ',this%xtype
1997  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
1998  do i=1,this%nDims
1999  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
2000  enddo
2001  endif
2002  !
2003  end subroutine get_var_nc_int
2004 
2012  subroutine get_var_nc_short_1d(this,varname,nd1,field)
2013  use netcdf
2014  !
2015  implicit none
2016  !
2017  class(ncio) :: this
2018  character(len=*),intent(in) :: varname ! name of the field to read
2019  integer, intent(in) :: nd1 ! size of array dval
2020  integer(2), intent(out) :: field(nd1) ! values of the field read in
2021  integer :: ilength
2022  !
2023  character*40,parameter :: thissubname='get_var_nc_short_1d'
2024  !
2025  integer :: i
2026  !
2027  !
2028  ilength=nd1
2029  call this%get_var_nc_short(varname,ilength,field)
2030  !
2031  if(nd1==this%ends(1)) then
2032  if(this%debug_level>100) then
2033  write(6,*) trim(thissubname),' show samples:'
2034  write(6,*) (field(i),i=1,min(nd1,10))
2035  endif
2036  else
2037  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
2038  endif
2039  !
2040  end subroutine get_var_nc_short_1d
2041 
2050  subroutine get_var_nc_short_2d(this,varname,nd1,nd2,field)
2051  !
2052  ! read in one field
2053  !
2054  use netcdf
2055  !
2056  implicit none
2057  !
2058  class(ncio) :: this
2059  character(len=*),intent(in) :: varname ! name of the field to read
2060  integer, intent(in) :: nd1,nd2 ! size of array dval
2061  integer(2), intent(out) :: field(nd1,nd2) ! values of the field read in
2062  integer :: ilength
2063  !
2064  integer(2),allocatable :: temp(:)
2065  !
2066  character*40,parameter :: thissubname='get_var_nc_short_2d'
2067  !
2068  integer :: i,j,k
2069  integer :: istart,iend
2070  !
2071  !
2072  ilength=nd1*nd2
2073  allocate(temp(ilength))
2074 
2075  call this%get_var_nc_short(varname,ilength,temp)
2076 
2077  if(nd1==this%ends(1) .and. nd2==this%ends(2)) then
2078  do j=1,nd2
2079  istart=(j-1)*nd1+1
2080  iend=(j-1)*nd1+nd1
2081  field(:,j)=temp(istart:iend)
2082  enddo
2083  !
2084  if(this%debug_level>100) then
2085  write(6,*) trim(thissubname),' show samples:'
2086  write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:))
2087  endif
2088  else
2089  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
2090  write(6,*) nd1,this%ends(1),nd2,this%ends(2)
2091  endif
2092  deallocate(temp)
2093  !
2094  end subroutine get_var_nc_short_2d
2095  !
2103  subroutine get_var_nc_short(this,varname,ilength,field)
2104  use netcdf
2105  !
2106  implicit none
2107  !
2108  class(ncio) :: this
2109  character(len=*),intent(in) :: varname ! name of the field to read
2110  integer, intent(in) :: ilength ! size of array dval
2111  integer(2), intent(out) :: field(ilength) ! values of the field read in
2112  !
2113  integer :: ncid
2114  !
2115  integer :: status
2116  integer :: varid
2117  integer :: ends(4),start(4)
2118 
2119  integer :: length4d,length3d,length2d
2120  integer :: ndims,ndim
2121  integer :: dimids(4)
2122  integer :: xtype
2123  character*40 :: dimname
2124 
2125  character*40,parameter :: thissubname='get_var_nc_short'
2126  !
2127  integer :: i,k
2128  !
2129  !
2130  ncid=this%ncid
2131 
2132  ! get variable IDs
2133  status = nf90_inq_varid(ncid, trim(varname), varid)
2134  if(status /= nf90_noerr) call this%handle_err(status)
2135 
2136  ! get dimensions
2137  ends=1
2138  start=1
2139  this%ends=1
2140 
2141  this%dimname=" "
2142  ! get variable type
2143  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
2144  if(status /= nf90_noerr) call this%handle_err(status)
2145  if(xtype==nf90_short) then
2146  this%xtype=xtype
2147  else
2148  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_short,' but read in ',xtype
2149  stop 123
2150  endif
2151 
2152  ! get dimension size
2153  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
2154  if(status /= nf90_noerr) call this%handle_err(status)
2155  this%ndims=ndims
2156  !
2157  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
2158  if(status /= nf90_noerr) call this%handle_err(status)
2159  do i=1,ndims
2160  dimname=" "
2161  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
2162  if (status /= nf90_noerr) call this%handle_err(status)
2163  ends(i)=ndim
2164  this%ends(i)=ends(i)
2165  this%dimname(i)=trim(dimname)
2166  if(this%ends(i) < 1) then
2167  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
2168  stop 1234
2169  endif
2170  enddo
2171  length2d=ends(1)*ends(2)
2172  length3d=length2d*ends(3)
2173  length4d=length3d*ends(4)
2174  if(ilength .ne. length4d) then
2175  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
2176  stop 123
2177  endif
2178  !
2179  if(ndims <=4 ) then
2180  status = nf90_get_var(ncid, varid, field, &
2181  start = start(1:4) , &
2182  count = ends(1:4))
2183  if(status /= nf90_noerr) call this%handle_err(status)
2184  else
2185  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
2186  stop 1234
2187  endif
2188  !
2189  if(this%debug_level>0) then
2190  write(6,'(a,a)') '>>>read in variable: ',trim(varname)
2191  endif
2192  if(this%debug_level>10) then
2193  write(6,'(8x,a,I10)') 'data type : ',this%xtype
2194  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
2195  do i=1,this%nDims
2196  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
2197  enddo
2198  endif
2199  !
2200  end subroutine get_var_nc_short
2201 
2209  subroutine get_var_nc_char_1d(this,varname,nd1,field)
2210  use netcdf
2211  !
2212  implicit none
2213  !
2214  class(ncio) :: this
2215  character(len=*),intent(in) :: varname ! name of the field to read
2216  integer, intent(in) :: nd1 ! size of array dval
2217  character, intent(out) :: field(nd1) ! values of the field read in
2218  integer :: ilength
2219  !
2220  character*40,parameter :: thissubname='get_var_nc_char_1d'
2221  !
2222  integer :: i
2223  !
2224  !
2225  ilength=nd1
2226  call this%get_var_nc_char(varname,ilength,field)
2227  !
2228  if(nd1==this%ends(1)) then
2229  if(this%debug_level>100) then
2230  write(6,*) trim(thissubname),' show samples:'
2231  write(6,*) (field(i),i=1,min(nd1,10))
2232  endif
2233  else
2234  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
2235  endif
2236  !
2237  end subroutine get_var_nc_char_1d
2238 
2247  subroutine get_var_nc_char_2d(this,varname,nd1,nd2,field)
2248  use netcdf
2249  !
2250  implicit none
2251  !
2252  class(ncio) :: this
2253  character(len=*),intent(in) :: varname ! name of the field to read
2254  integer, intent(in) :: nd1,nd2 ! size of array dval
2255  character, intent(out) :: field(nd1,nd2) ! values of the field read in
2256  integer :: ilength
2257  !
2258  character,allocatable :: temp(:)
2259  !
2260  character*40,parameter :: thissubname='get_var_nc_char_2d'
2261  !
2262  integer :: i,j,k
2263  integer :: istart,iend
2264  !
2265  !
2266  ilength=nd1*nd2
2267  allocate(temp(ilength))
2268 
2269  call this%get_var_nc_char(varname,ilength,temp)
2270 
2271  if(nd1==this%ends(1) .and. nd2==this%ends(2)) then
2272  do j=1,nd2
2273  istart=(j-1)*nd1+1
2274  iend=(j-1)*nd1+nd1
2275  field(:,j)=temp(istart:iend)
2276  enddo
2277  !
2278 ! if(this%debug_level>100) then
2279 ! write(*,*) trim(thissubname),' show samples:'
2280 ! write(*,*) field(1,1)
2281 ! endif
2282  else
2283  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
2284  write(6,*) nd1,this%ends(1),nd2,this%ends(2)
2285  endif
2286  deallocate(temp)
2287  !
2288  end subroutine get_var_nc_char_2d
2289 
2299  subroutine get_var_nc_char_3d(this,varname,nd1,nd2,nd3,field)
2300  use netcdf
2301  !
2302  implicit none
2303  !
2304  class(ncio) :: this
2305  character(len=*),intent(in) :: varname ! name of the field to read
2306  integer, intent(in) :: nd1,nd2,nd3 ! size of array dval
2307  character, intent(out) :: field(nd1,nd2,nd3) ! values of the field read in
2308  integer :: ilength
2309  !
2310  character,allocatable :: temp(:)
2311  !
2312  character*40,parameter :: thissubname='get_var_nc_char_3d'
2313  !
2314  integer :: i,j,k
2315  integer :: length2d
2316  integer :: istart,iend
2317  !
2318  !
2319  length2d=nd1*nd2
2320  ilength=length2d*nd3
2321  allocate(temp(ilength))
2322 
2323  call this%get_var_nc_char(varname,ilength,temp)
2324 
2325  if(nd1==this%ends(1) .and. nd2==this%ends(2) .and. nd3==this%ends(3)) then
2326  do k=1,nd3
2327  do j=1,nd2
2328  istart=(k-1)*length2d+(j-1)*nd1+1
2329  iend =(k-1)*length2d+(j-1)*nd1+nd1
2330  field(:,j,k)=temp(istart:iend)
2331  enddo
2332  enddo
2333  !
2334 ! if(this%debug_level>100) then
2335 ! write(*,*) trim(thissubname),' show samples:'
2336 ! write(*,*) field(1,1,1)
2337 ! endif
2338  else
2339  write(6,*) trim(thissubname),' ERROR: dimension does not match.'
2340  write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3)
2341  endif
2342  deallocate(temp)
2343  !
2344  end subroutine get_var_nc_char_3d
2345  !
2353  subroutine get_var_nc_char(this,varname,ilength,field)
2354  !
2355  ! read in one field
2356  !
2357  use netcdf
2358  !
2359  implicit none
2360  !
2361  class(ncio) :: this
2362  character(len=*),intent(in) :: varname ! name of the field to read
2363  integer, intent(in) :: ilength ! size of array dval
2364  character, intent(out) :: field(ilength) ! values of the field read in
2365  !
2366  integer :: ncid
2367  !
2368  integer :: status
2369  integer :: varid
2370  integer :: ends(4),start(4)
2371 
2372  integer :: length4d,length3d,length2d
2373  integer :: ndims,ndim
2374  integer :: dimids(4)
2375  integer :: xtype
2376  character*40 :: dimname
2377 
2378  character*40,parameter :: thissubname='get_var_nc_char'
2379  !
2380  integer :: i,k
2381  !
2382  !
2383  ncid=this%ncid
2384 
2385  ! get variable IDs
2386  status = nf90_inq_varid(ncid, trim(varname), varid)
2387  if(status /= nf90_noerr) call this%handle_err(status)
2388 
2389  ! get dimensions
2390  ends=1
2391  start=1
2392  this%ends=1
2393 
2394  this%dimname=" "
2395  ! get variable type
2396  status = nf90_inquire_variable(ncid, varid, xtype = xtype)
2397  if(status /= nf90_noerr) call this%handle_err(status)
2398  if(xtype==nf90_char) then
2399  this%xtype=xtype
2400  else
2401  write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',nf90_char,' but read in ',xtype
2402  stop 123
2403  endif
2404 
2405  ! get dimension size
2406  status = nf90_inquire_variable(ncid, varid, ndims = ndims)
2407  if(status /= nf90_noerr) call this%handle_err(status)
2408  this%ndims=ndims
2409  !
2410  status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
2411  if(status /= nf90_noerr) call this%handle_err(status)
2412  do i=1,ndims
2413  dimname=" "
2414  status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim)
2415  if (status /= nf90_noerr) call this%handle_err(status)
2416  ends(i)=ndim
2417  this%ends(i)=ends(i)
2418  this%dimname(i)=trim(dimname)
2419  if(this%ends(i) < 1) then
2420  write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i)
2421  stop 1234
2422  endif
2423  enddo
2424  length2d=ends(1)*ends(2)
2425  length3d=length2d*ends(3)
2426  length4d=length3d*ends(4)
2427  if(ilength .ne. length4d) then
2428  write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d
2429  stop 123
2430  endif
2431  !
2432  if(ndims <=4 ) then
2433  status = nf90_get_var(ncid, varid, field, &
2434  start = start(1:4) , &
2435  count = ends(1:4))
2436  if(status /= nf90_noerr) call this%handle_err(status)
2437  else
2438  write(6,*) trim(thissubname),'Error: too many dimensions:',ndims
2439  stop 1234
2440  endif
2441  !
2442  if(this%debug_level>0) then
2443  write(6,'(a,a)') '>>>read in variable: ',trim(varname)
2444  endif
2445  if(this%debug_level>10) then
2446  write(6,'(8x,a,I10)') 'data type : ',this%xtype
2447  write(6,'(8x,a,I10)') 'dimension size: ',this%nDims
2448  do i=1,this%nDims
2449  write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i))
2450  enddo
2451  endif
2452  !
2453  end subroutine get_var_nc_char
2454 
2460  subroutine handle_err(this,status)
2461  use netcdf
2462  implicit none
2463  class(ncio) :: this
2464  !
2465  integer, intent ( in) :: status
2466  if(status /= nf90_noerr) then
2467  print *, trim(nf90_strerror(status))
2468  stop "Stopped"
2469  end if
2470  end subroutine handle_err
2471 
2480  subroutine convert_theta2t_2dgrid(this,nx,ny,ps,t2)
2481  implicit none
2482  class(ncio) :: this
2483 
2484  integer :: nx,ny
2485  real, intent(in ) :: ps(nx,ny)
2486  real, intent(inout) :: t2(nx,ny)
2487 
2488  integer :: i,j
2489  real(8) :: rd,cp,rd_over_cp
2490 
2491 
2492  rd = 2.8705e+2_8
2493  cp = 1.0046e+3_8 ! specific heat of air @pressure (J/kg/K)
2494  rd_over_cp = rd/cp
2495 
2496  do j=1,ny
2497  do i=1,nx
2498  t2(i,j)=t2(i,j)*(ps(i,j)/1000.0)**rd_over_cp - 273.15
2499  enddo
2500  enddo
2501 
2502  end subroutine convert_theta2t_2dgrid
2503 
2516  subroutine add_new_var_3d(this,varname,dname1,dname2,dname3,lname,units)
2517  implicit none
2518  !
2519  class(ncio) :: this
2520  character(len=*),intent(in) :: varname,dname1,dname2,dname3 &
2521  ,lname,units
2522  integer :: status, ncid, dim1id, dim2id, dim3id, varid
2523 
2524  status = nf90_redef(this%ncid) !Enter Define Mode
2525  if (status /= nf90_noerr) call this%handle_err(status)
2526 
2527  status = nf90_inq_dimid(this%ncid, dname1, dim1id)
2528  if (status /= nf90_noerr) call this%handle_err(status)
2529  status = nf90_inq_dimid(this%ncid, dname2, dim2id)
2530  if (status /= nf90_noerr) call this%handle_err(status)
2531  status = nf90_inq_dimid(this%ncid, dname3, dim3id)
2532  if (status /= nf90_noerr) call this%handle_err(status)
2533 
2534  status = nf90_def_var(this%ncid, varname, nf90_double, &
2535  (/ dim1id, dim2id, dim3id /), varid)
2536  if (status /= nf90_noerr) call this%handle_err(status)
2537 
2538  status = nf90_put_att(this%ncid, varid, 'long_name', lname)
2539  if (status /= nf90_noerr) call this%handle_err(status)
2540  status = nf90_put_att(this%ncid, varid, 'units', units)
2541  if (status /= nf90_noerr) call this%handle_err(status)
2542 
2543  status = nf90_enddef(this%ncid) !Exit Define Mode and
2544  ! return to Data Mode
2545  if (status /= nf90_noerr) call this%handle_err(status)
2546 
2547  end subroutine add_new_var_3d
2548 
2560  subroutine add_new_var_2d(this,varname,dname1,dname2,lname,units)
2561  implicit none
2562  !
2563  class(ncio) :: this
2564  character(len=*),intent(in) :: varname,dname1,dname2 &
2565  ,lname,units
2566  integer :: status, ncid, dim1id, dim2id, varid
2567 
2568  status = nf90_redef(this%ncid) !Enter Define Mode
2569  if (status /= nf90_noerr) call this%handle_err(status)
2570 
2571  status = nf90_inq_dimid(this%ncid, dname1, dim1id)
2572  if (status /= nf90_noerr) call this%handle_err(status)
2573  status = nf90_inq_dimid(this%ncid, dname2, dim2id)
2574  if (status /= nf90_noerr) call this%handle_err(status)
2575 
2576  status = nf90_def_var(this%ncid, varname, nf90_double, &
2577  (/ dim1id, dim2id /), varid)
2578  if (status /= nf90_noerr) call this%handle_err(status)
2579 
2580  status = nf90_put_att(this%ncid, varid, 'long_name', lname)
2581  if (status /= nf90_noerr) call this%handle_err(status)
2582  status = nf90_put_att(this%ncid, varid, 'units', units)
2583  if (status /= nf90_noerr) call this%handle_err(status)
2584 
2585  status = nf90_enddef(this%ncid) !Exit Define Mode and
2586  ! return to Data Mode
2587  if (status /= nf90_noerr) call this%handle_err(status)
2588 
2589  end subroutine add_new_var_2d
2590 
2591 
2592 end module module_ncio
procedure get_var_nc_int
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:46
procedure get_var_nc_short_1d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:44
procedure replace_var_nc_real
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:74
procedure get_var_nc_int_1d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:47
generic get_var=> get_var_nc_double_1d, get_var_nc_double_2d,get_var_nc_double_3d,get_var_nc_real_1d, get_var_nc_real_2d,get_var_nc_real_3d,get_var_nc_short_1d, get_var_nc_short_2d,get_var_nc_int_1d, get_var_nc_int_2d,get_var_nc_int_3d,get_var_nc_char_1d, get_var_nc_char_2d,get_var_nc_char_3d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:34
procedure replace_var_nc_int_2d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:72
procedure get_var_nc_int_3d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:49
procedure replace_var_nc_double_3d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:81
procedure get_att_nc_real
Get attribute.
Definition: module_ncio.f90:32
subroutine open_nc(this, filename, action, debug_level)
Open a netcdf file, set initial debug level.
generic get_att=> get_att_nc_int, get_att_nc_real, get_att_nc_string
Get attribute.
Definition: module_ncio.f90:30
subroutine close_nc(this)
Close a netcdf file.
procedure replace_var_nc_char_1d
Replace character type variable.
Definition: module_ncio.f90:83
procedure get_var_nc_double_2d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:56
procedure get_var_nc_real_1d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:51
procedure get_var_nc_double_1d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:55
procedure get_var_nc_real_3d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:53
Functions to read and write netcdf files.
Definition: module_ncio.f90:7
procedure get_var_nc_real
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:50
procedure get_var_nc_short_2d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:45
generic add_new_var=> add_new_var_2d,add_new_var_3d
Add a new 2d or 3d variable to ouput file.
Definition: module_ncio.f90:88
procedure replace_var_nc_char
Replace character type variable.
Definition: module_ncio.f90:82
procedure replace_var_nc_real_2d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:76
procedure convert_theta2t_2dgrid
Convert theta T (Kelvin) to T (deg C).
Definition: module_ncio.f90:87
procedure replace_var_nc_int_1d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:71
procedure get_var_nc_char
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:58
procedure replace_var_nc_real_1d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:75
procedure get_var_nc_short
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:43
procedure add_new_var_3d
Add a new 3d variable to output file.
Definition: module_ncio.f90:91
subroutine get_dim_nc(this, dimname, dimvalue)
Get dimensions in netcdf file.
procedure get_dim=> get_dim_nc
read in dimension from the nc file
Definition: module_ncio.f90:29
procedure replace_var_nc_int
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:70
procedure handle_err
Handle netCDF errors.
Definition: module_ncio.f90:86
procedure get_var_nc_real_2d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:52
procedure replace_var_nc_real_3d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:77
procedure replace_var_nc_double_1d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:79
procedure get_var_nc_double
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:54
procedure replace_var_nc_double
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:78
procedure add_new_var_2d
Add a new 2d variable to output file.
Definition: module_ncio.f90:90
procedure replace_var_nc_double_2d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:80
procedure replace_var_nc_char_2d
Replace character type variable.
Definition: module_ncio.f90:84
procedure get_att_nc_string
Get attribute.
Definition: module_ncio.f90:33
procedure get_var_nc_int_2d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:48
procedure get_var_nc_char_1d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:59
procedure get_var_nc_char_2d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:60
procedure get_var_nc_char_3d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:61
procedure get_var_nc_double_3d
Read in a 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:57
procedure replace_var_nc_char_3d
Replace 3D character type variable.
Definition: module_ncio.f90:85
generic replace_var=> replace_var_nc_double_1d, replace_var_nc_double_2d,replace_var_nc_double_3d,replace_var_nc_real_1d, replace_var_nc_real_2d,replace_var_nc_real_3d,replace_var_nc_int_1d, replace_var_nc_int_2d,replace_var_nc_int_3d,replace_var_nc_char_1d, replace_var_nc_char_2d,replace_var_nc_char_3d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:62
procedure get_att_nc_int
Get attribute.
Definition: module_ncio.f90:31
procedure replace_var_nc_int_3d
Replace 1d, 2d, 3d, or 4d field from the nc file.
Definition: module_ncio.f90:73