!-------------------------------------------------------------------------------
module nstio_module
!$$$  module documentation block
!
! module:    nstio_module    api for global spectral nst file i/o
!   prgmmr: xu li (modified from sfcio_modul)         org: w/nx23     date: 2007-10-26
!
! abstract: this module provides an application program interface
!   for performing i/o on the nst restart file of the global nst diurnal warming and sub-layer cooling models.
!   functions include opening, reading, writing, and closing as well as
!   allocating and deallocating data buffers sed in the transfers.
!   the i/o performed here is sequential.
!   the transfers are limited to header records or data records.
!   
! program history log:
!   2007-10-26  xu li
!   2008-03-25  xu li: add surface mask field
!   2008-05-23  shrinivas moorthi - corrected bugs in nsstio_swdbta
!   2009-06-30  xu li: modified for ncep dtm-1p
!   2010-02-17  shrinivas moorthi - removed "use resol_def" and added ngrids_nst!                                   to the argument
!
! public variables:
!   nstio_lhead1      integer parameter length of first header record (=32)
!   nstio_intkind     integer parameter kind or length of passed integers (=4)
!   nstio_realkind    integer parameter kind or length of passed reals (=4)
!   nstio_dblekind    integer parameter kind or length of passed longreals (=8)
!   nstio_realfill    real(nstio_realkind) fill value (=-9999.)
!   nstio_dblefill    real(nstio_dblekind) fill value (=-9999.)
!
! public defined types:
!   nstio_head        nst file header information
!     clabnst           character(nstio_lhead1) on85 label
!     fhour             real(nstio_realkind) forecast hour
!     idate             integer(nstio_intkind)(4) initial date
!                       (hour, month, day, 4-digit year)
!     latb              integer(nstio_intkind) latitudes
!     lonb              integer(nstio_intkind) longitudes
!     ivo               integer(nstio_intkind) version number
!     lsea              integer(nstio_intkind) sea levels
!     irealf            integer(sigio_intkind) floating point flag
!                       (=1 for 4-byte ieee, =2 for 8-byte ieee)
!     lpl               integer(nstio_intkind)(latb/2) lons per lat
!     zsea              real(nstio_realkind) sea depths (meter)
!
!   nstio_data        nst file data fields
!     slmsk             real(nstio_realkind)(:,:) pointer to lonb*latb
!                       surface mask: 0 = water; 1 = land; 2 = ice
!     xt                real(nstio_realkind)(:,:) pointer to lonb*latb
!                       heat content in dtl                                  (m*k)
!     xs                real(nstio_realkind)(:,:) pointer to lonb*latb
!                       salinity content in dtl                              (m*ppt)
!     xu                real(nstio_realkind)(:,:) pointer to lonb*latb
!                       u-current content in dtl                             (m*m/s)
!     xv                real(nstio_realkind)(:,:) pointer to lonb*latb
!                       v-current content in dtl                             (m*m/s)
!     xz                real(nstio_realkind)(:,:) pointer to lonb*latb
!                       dtl thickness                                        (m)
!     zm                real(nstio_realkind)(:,:) pointer to lonb*latb
!                       mxl thickness                                        (m)
!     xtts              real(nstio_realkind)(:,:) pointer to lonb*latb
!                       d(xt)/d(ts)                                          (1/m)
!     xzts              real(nstio_realkind)(:,:) pointer to lonb*latb
!                       d(xz)/d(ts)                                          (m/k)
!     dt_cool           real(nstio_realkind)(:,:) pointer to lonb*latb
!                       sea surface cooling amount by sub-layer cooling effect
!     z_c               real(nstio_realkind)(:,:) pointer to lonb*latb
!                       sea sub-layer depth in m
!     c_0               real(nstio_realkind)(:,:) pointer to lonb*latb
!                       coefficient to calculate d(tz)/d(tr) in dimensionless
!     c_d               real(nstio_realkind)(:,:) pointer to lonb*latb
!                       coefficient to calculate d(tz)/d(tr) in               (1/m)
!     w_0               real(nstio_realkind)(:,:) pointer to lonb*latb
!                       coefficient to calculate d(tz)/d(tr) in dimensionless
!     w_d               real(nstio_realkind)(:,:) pointer to lonb*latb
!                       coefficient to calculate d(tz)/d(tr)                  (1/m)
!     d_conv            real(nstio_realkind)(:,:) pointer to lonb*latb
!                       fcl thickness                                          (m)
!     ifd               real(nstio_realkind)(:,:) pointer to lonb*latb
!                       index of time integral started mode: 0 = not yet; 1 = started already
!     tref              real(nstio_realkind)(:,:) pointer to lonb*latb
!                       reference temperature                                  (k)
!     qrain             real(nstio_realkind)(:,:) pointer to lonb*latb
!                       sensible heat flux due to rainfall                     (w*m^-2)
!                       
!   nstio_dbta        nst file longreal data fields
!                       
! public subprograms:
!   nstio_sropen      open nst file for sequential reading
!     lu                integer(nstio_intkind) input logical unit
!     cfname            character(*) input filename
!     iret              integer(nstio_intkind) output return code
!
!   nstio_swopen      open nst file for sequential writing
!     lu                integer(nstio_intkind) input logical unit
!     cfname            character(*) input filename
!     iret              integer(nstio_intkind) output return code
!
!   nstio_srclose     close nst file for sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     iret              integer(nstio_intkind) output return code
!
!   nstio_srhead      read header information with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     head              type(nstio_head) output header information
!     iret              integer(nstio_intkind) output return code
!
!   nstio_swhead      write header information with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     head              type(nstio_head) input header information
!     iret              integer(nstio_intkind) output return code
!
!   nstio_alhead      allocate head allocatables
!     head              type(nstio_head) input/output header information
!     iret              integer(nstio_intkind) output return code
!     latb              integer(nstio_intkind) optional latitudes
!     lsea             integer(nstio_intkind) optional sea levels
!
!   nstio_aldata      allocate data fields
!     head              type(nstio_head) input header information
!     data              type(nstio_data) output data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_axdata      deallocate data fields
!     data              type(nstio_data) output data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_srdata      read data fields with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     head              type(nstio_head) input header information
!     data              type(nstio_data) output data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_swdata      write data fields with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     head              type(nstio_head) input header information
!     data              type(nstio_data) input data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_srohdc      open, read header & data and close with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     cfname            character(*) input filename
!     head              type(nstio_head) output header information
!     data              type(nstio_data) output data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_swohdc      open, write header & data and close with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     cfname            character(*) input filename
!     head              type(nstio_head) input header information
!     data              type(nstio_data) input data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_aldbta      allocate longreal data fields
!     head              type(nstio_head) input header information
!     dbta              type(nstio_dbta) output longreal data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_axdbta      deallocate longreal data fields
!     dbta              type(nstio_dbta) output longreal data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_srdbta      read longreal data fields with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     head              type(nstio_head) input header information
!     dbta              type(nstio_dbta) output longreal data fields
!     iret              integer(nstio_intkind) output return code
!
!   nstio_swdbta      write longreal data fields with sequential i/o
!     lu                integer(nstio_intkind) input logical unit
!     head              type(nstio_head) input header information
!     dbta              type(nstio_dbta) input longreal data fields
!     iret              integer(nstio_intkind) output return code
!
! remarks:
!   (1) here's the supported nst file formats.
!       for ivo=200907 
!         label containing
!           'gfs ','nst ',ivo,nhead,ndata,reserved(3) (8 4-byte words)
!         header records
!           lhead(nhead),ldata(ndata) (nhead+ndata 4-byte words)
!           fhour, idate(4), lonb, latb, lsea, irealf,
!             reserved(16)  (25 4-byte words)
!           lpl  (latb/2 4-byte words)
!           zsea  (lsea 4-byte words)
!         data records
!           slmsk    (lonb*latb 4-byte words)
!           xt       (lonb*latb 4-byte words)
!           xs       (lonb*latb 4-byte words)
!           xu       (lonb*latb 4-byte words)
!           xv       (lonb*latb 4-byte words)
!           xz       (lonb*latb 4-byte words)
!           zm       (lonb*latb 4-byte words)
!           xtts     (lonb*latb 4-byte words)
!           xzts     (lonb*latb 4-byte words)
!           dt_cool  (lonb*latb 4-byte words)
!           z_c      (lonb*latb 4-byte words)
!           c_0      (lonb*latb 4-byte words)
!           c_d      (lonb*latb 4-byte words)
!           w_0      (lonb*latb 4-byte words)
!           w_d      (lonb*latb 4-byte words)
!           d_conv   (lonb*latb 4-byte words)
!           ifd      (lonb*latb 4-byte words)
!           tref     (lonb*latb 4-byte words)
!           qrain    (lonb*latb 4-byte words)
!
!   (2) possible return codes:
!          0   successful call
!         -1   open or close i/o error
!         -2   header record i/o error or unrecognized version
!         -3   allocation or deallocation error
!         -4   data record i/o error
!         -5   insufficient data dimensions allocated
!
! examples:
!   (1) read the entire nst file 'nstf24' and
!       print out the northernmost nst temperature at greenwich.
!
!     use nstio_module
!     type(nstio_head):: head
!     type(nstio_data):: data
!     call nstio_srohdc(11,'nstf24',head,data,iret)
!     print '(f8.2)',data%tref(1,1)
!     end
!
! attributes:
!   language: fortran 90
!
!$$$
! use resol_def, only: ngrids_nst
  implicit none
  private
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! public variables
  integer,parameter,public:: nstio_lhead1=32
  integer,parameter,public:: nstio_intkind=4,nstio_realkind=4,nstio_dblekind=8
  real(nstio_realkind),parameter,public:: nstio_realfill=-9999.
  real(nstio_dblekind),parameter,public:: nstio_dblefill=nstio_realfill
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! public types
  type,public:: nstio_head
    character(nstio_lhead1):: clabnst='                                '
    real(nstio_realkind):: fhour=0.
    integer(nstio_intkind):: idate(4)=(/0,0,0,0/),latb=0,lonb=0,lsea=0,ivo=0
    integer(nstio_intkind):: irealf=1
    integer(nstio_intkind),allocatable:: lpl(:)
    real(nstio_realkind),allocatable:: zsea(:)
  end type
  type,public:: nstio_data
    real(nstio_realkind),pointer:: slmsk    (:,:)=>null()
    real(nstio_realkind),pointer:: xt       (:,:)=>null()
    real(nstio_realkind),pointer:: xs       (:,:)=>null()
    real(nstio_realkind),pointer:: xu       (:,:)=>null()
    real(nstio_realkind),pointer:: xv       (:,:)=>null()
    real(nstio_realkind),pointer:: xz       (:,:)=>null()
    real(nstio_realkind),pointer:: zm       (:,:)=>null()
    real(nstio_realkind),pointer:: xtts     (:,:)=>null()
    real(nstio_realkind),pointer:: xzts     (:,:)=>null()
    real(nstio_realkind),pointer:: dt_cool  (:,:)=>null()
    real(nstio_realkind),pointer:: z_c      (:,:)=>null()
    real(nstio_realkind),pointer:: c_0      (:,:)=>null()
    real(nstio_realkind),pointer:: c_d      (:,:)=>null()
    real(nstio_realkind),pointer:: w_0      (:,:)=>null()
    real(nstio_realkind),pointer:: w_d      (:,:)=>null()
    real(nstio_realkind),pointer:: d_conv   (:,:)=>null()
    real(nstio_realkind),pointer:: ifd      (:,:)=>null()
    real(nstio_realkind),pointer:: tref     (:,:)=>null()
    real(nstio_realkind),pointer:: qrain    (:,:)=>null()
  end type
  type,public:: nstio_dbta
    real(nstio_dblekind),pointer:: slmsk    (:,:)=>null()
    real(nstio_dblekind),pointer:: xt       (:,:)=>null()
    real(nstio_dblekind),pointer:: xs       (:,:)=>null()
    real(nstio_dblekind),pointer:: xu       (:,:)=>null()
    real(nstio_dblekind),pointer:: xv       (:,:)=>null()
    real(nstio_dblekind),pointer:: xz       (:,:)=>null()
    real(nstio_dblekind),pointer:: zm       (:,:)=>null()
    real(nstio_dblekind),pointer:: xtts     (:,:)=>null()
    real(nstio_dblekind),pointer:: xzts     (:,:)=>null()
    real(nstio_dblekind),pointer:: dt_cool  (:,:)=>null()
    real(nstio_dblekind),pointer:: z_c      (:,:)=>null()
    real(nstio_dblekind),pointer:: c_0      (:,:)=>null()
    real(nstio_dblekind),pointer:: c_d      (:,:)=>null()
    real(nstio_dblekind),pointer:: w_0      (:,:)=>null()
    real(nstio_dblekind),pointer:: w_d      (:,:)=>null()
    real(nstio_dblekind),pointer:: d_conv   (:,:)=>null()
    real(nstio_dblekind),pointer:: ifd      (:,:)=>null()
    real(nstio_dblekind),pointer:: tref     (:,:)=>null()
    real(nstio_dblekind),pointer:: qrain    (:,:)=>null()
  end type
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! public subprograms
  public nstio_sropen,nstio_swopen,nstio_srclose,nstio_srhead,nstio_swhead
  public nstio_alhead,nstio_aldata,nstio_axdata,nstio_srdata,nstio_swdata
  public nstio_aldbta,nstio_axdbta,nstio_srdbta,nstio_swdbta
  public nstio_srohdc,nstio_swohdc
  interface nstio_srohdc
  module procedure nstio_srohdca,nstio_srohdcb
  end interface
  interface nstio_swohdc
  module procedure nstio_swohdca,nstio_swohdcb
  end interface
contains
!-------------------------------------------------------------------------------
  subroutine nstio_sropen(lu,cfname,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    character*(*),intent(in):: cfname
    integer(nstio_intkind),intent(out):: iret
    integer ios
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    open(lu,file=cfname,form='unformatted',&
         status='old',action='read',iostat=ios)
    write(*,*) ' successfully opened : ',cfname, ios
    iret=ios
    if(iret.ne.0) iret=-1
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_swopen(lu,cfname,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    character*(*),intent(in):: cfname
    integer(nstio_intkind),intent(out):: iret
    integer ios
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    open(lu,file=cfname,form='unformatted',&
         status='unknown',action='readwrite',iostat=ios)
    iret=ios
    if(iret.ne.0) iret=-1
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_srclose(lu,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    integer(nstio_intkind),intent(out):: iret
    integer ios
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    close(lu,iostat=ios)
    iret=ios
    if(iret.ne.0) iret=-1
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_srhead(lu,head,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    type(nstio_head),intent(out):: head
    integer(nstio_intkind),intent(out):: iret
    integer:: ios
    character(4):: cgfs,cnst
    integer(nstio_intkind):: nhead,ndata,nresv(3)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    iret=-2
    rewind lu
    read(lu,iostat=ios) head%clabnst(1:8)
    write(*,*) ' head%clabnst done, ios : ',head%clabnst(1:8), ios
    if(ios.ne.0) return
    if(head%clabnst(1:8).eq.'GFS NST ') then  ! modern nst file
      rewind lu
      read(lu,iostat=ios) cgfs,cnst,head%ivo,nhead,nresv
      write(*,*) ' cgfs,cnst done, ios : ',cgfs,cnst, ios,head%ivo,nhead
      if(ios.ne.0) return
      if(head%ivo.eq.200907) then
        read(lu,iostat=ios)
        if(ios.ne.0) return
        read(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,&
                            head%lsea,head%irealf
        write(*,*) ' head%fhour, ios : ',head%fhour, ios
        if(ios.ne.0) return
        call nstio_alhead(head,ios)
        if(ios.ne.0) return
        read(lu,iostat=ios) head%lpl
        if(ios.ne.0) return
        read(lu,iostat=ios) head%zsea
        if(ios.ne.0) return
      else
        return
      endif
    endif
    iret=0
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_swhead(lu,head,ngrids_nst,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu, ngrids_nst
    type(nstio_head),intent(in):: head
    integer(nstio_intkind),intent(out):: iret
    integer:: ios
    integer i
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    iret=-2
    if(head%ivo.eq.200907) then
      rewind lu
      write(lu,iostat=ios) 'GFS NST ',head%ivo,ngrids_nst+4*head%lsea,0,0,0
      if(ios.ne.0) return
      write(lu,iostat=ios) 4*(/8,ngrids_nst+4*head%lsea,25,head%latb/2,head%lsea/),&
                           4*head%irealf*(/(head%lonb*head%latb,&
                                            i=1,ngrids_nst+4*head%lsea)/)
      if(ios.ne.0) return
      write(lu,iostat=ios) head%fhour,head%idate,head%lonb,head%latb,&
                           head%lsea,head%irealf,(0,i=1,16)
      if(ios.ne.0) return
      write(lu,iostat=ios) head%lpl
      if(ios.ne.0) return
      write(lu,iostat=ios) head%zsea
      if(ios.ne.0) return
      iret=0
    endif
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_alhead(head,iret,latb,lsea)
    implicit none
    type(nstio_head),intent(inout):: head
    integer(nstio_intkind),intent(out):: iret
    integer(nstio_intkind),optional,intent(in):: latb,lsea
    integer dim1l,dim1z
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if(present(latb)) then
      dim1l=latb/2
    else
      dim1l=head%latb/2
    endif
    if(present(lsea)) then
      dim1z=lsea
    else
      dim1z=head%lsea
    endif
    if(allocated(head%lpl)) deallocate(head%lpl)
    if(allocated(head%zsea)) deallocate(head%zsea)
    allocate(head%lpl(dim1l),head%zsea(dim1z),stat=iret)
    if(iret.eq.0) then
      head%lpl=0
      head%zsea=nstio_realfill
    endif
    if(iret.ne.0) then
      iret=-3
      write(*,*) ' fail to allocate nstio%head, iret = ',iret
    endif
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_aldata(head,data,iret)
    implicit none
    type(nstio_head),intent(in):: head
    type(nstio_data),intent(inout):: data
    integer(nstio_intkind),intent(out):: iret
    integer dim1,dim2,dim3
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_axdata(data,iret)
    dim1=head%lonb
    dim2=head%latb
    dim3=head%lsea
    write(*,*) 'in nstio_aldata, dim1, dim2, dim3 : ', dim1, dim2, dim3
    allocate(&
      data%slmsk(dim1,dim2),&
      data%xt(dim1,dim2),&
      data%xs(dim1,dim2),&
      data%xu(dim1,dim2),&
      data%xv(dim1,dim2),&
      data%xz(dim1,dim2),&
      data%zm(dim1,dim2),&
      data%xtts(dim1,dim2),&
      data%xzts(dim1,dim2),&
      data%dt_cool(dim1,dim2),&
      data%z_c(dim1,dim2),&
      data%c_0(dim1,dim2),&
      data%c_d(dim1,dim2),&
      data%w_0(dim1,dim2),&
      data%w_d(dim1,dim2),&
      data%d_conv(dim1,dim2),&
      data%ifd(dim1,dim2),&
      data%tref(dim1,dim2),&
      data%qrain(dim1,dim2),&
      stat=iret)
    if(iret.ne.0) then
      iret=-3
      write(*,*) ' fail to allocate nstio%data, iret = ',iret
    endif
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_axdata(data,iret)
    implicit none
    type(nstio_data),intent(inout):: data
    integer(nstio_intkind),intent(out):: iret
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    deallocate(&
      data%slmsk,&
      data%xt,&
      data%xs,&
      data%xu,&
      data%xv,&
      data%xz,&
      data%zm,&
      data%xtts,&
      data%xzts,&
      data%dt_cool,&
      data%z_c,&
      data%c_0,&
      data%c_d,&
      data%w_0,&
      data%w_d,&
      data%d_conv,&
      data%ifd,&
      data%tref,&
      data%qrain,&
      stat=iret)
    nullify(&
      data%slmsk,&
      data%xt,&
      data%xs,&
      data%xu,&
      data%xv,&
      data%xz,&
      data%zm,&
      data%xtts,&
      data%xzts,&
      data%dt_cool,&
      data%z_c,&
      data%c_0,&
      data%c_d,&
      data%w_0,&
      data%w_d,&
      data%d_conv,&
      data%ifd,&
      data%tref,&
      data%qrain)
    if(iret.ne.0) iret=-3
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_srdata(lu,head,data,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    type(nstio_head),intent(in):: head
    type(nstio_data),intent(inout):: data
    integer(nstio_intkind),intent(out):: iret
    integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
    integer:: ios
    integer i
    type(nstio_dbta) dbta
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    dim1=head%lonb
    dim2=head%latb
    dim3=head%lsea

    mdim1=min(&
      size(data%slmsk,1),&
      size(data%xt,1),&
      size(data%xs,1),&
      size(data%xu,1),&
      size(data%xv,1),&
      size(data%xz,1),&
      size(data%zm,1),&
      size(data%xtts,1),&
      size(data%xzts,1),&
      size(data%dt_cool,1),&
      size(data%z_c,1),&
      size(data%c_0,1),&
      size(data%c_d,1),&
      size(data%w_0,1),&
      size(data%w_d,1),&
      size(data%d_conv,1),&
      size(data%ifd,1),&
      size(data%tref,1),&
      size(data%qrain,1))
    mdim2=min(&
      size(data%slmsk,2),&
      size(data%xt,2),&
      size(data%xs,2),&
      size(data%xu,2),&
      size(data%xv,2),&
      size(data%xz,2),&
      size(data%zm,2),&
      size(data%xtts,2),&
      size(data%xzts,2),&
      size(data%dt_cool,2),&
      size(data%z_c,2),&
      size(data%c_0,2),&
      size(data%c_d,2),&
      size(data%w_0,2),&
      size(data%w_d,2),&
      size(data%d_conv,2),&
      size(data%ifd,2),&
      size(data%tref,2),&
      size(data%qrain,2))
    mdim3=0
    iret=-5
    if(mdim1.lt.dim1.or.&
       mdim2.lt.dim2.or.&
       mdim3.lt.dim3) return
    iret=-4
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if(head%ivo.eq.200907) then
      if(head%irealf.ne.2) then
        read(lu,iostat=ios)    data%slmsk(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)       data%xt(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)       data%xs(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)       data%xu(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)       data%xv(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)       data%xz(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)       data%zm(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)     data%xtts(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)     data%xzts(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)  data%dt_cool(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)      data%z_c(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)      data%c_0(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)      data%c_d(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)      data%w_0(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)      data%w_d(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)   data%d_conv(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)      data%ifd(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)     data%tref(:dim1,:dim2)
        if(ios.ne.0) return
        read(lu,iostat=ios)    data%qrain(:dim1,:dim2)
        if(ios.ne.0) return
      else
        call nstio_aldbta(head,dbta,iret)
        if(iret.ne.0) return
        call nstio_srdbta(lu,head,dbta,iret)
        if(iret.ne.0) return
        data%slmsk(:dim1,:dim2)   = dbta%slmsk(:dim1,:dim2)
        data%xt(:dim1,:dim2)      = dbta%xt(:dim1,:dim2)
        data%xs(:dim1,:dim2)      = dbta%xs(:dim1,:dim2)
        data%xu(:dim1,:dim2)      = dbta%xu(:dim1,:dim2)
        data%xv(:dim1,:dim2)      = dbta%xv(:dim1,:dim2)
        data%xz(:dim1,:dim2)      = dbta%xz(:dim1,:dim2)
        data%zm(:dim1,:dim2)      = dbta%zm(:dim1,:dim2)
        data%xtts(:dim1,:dim2)    = dbta%xtts(:dim1,:dim2)
        data%xzts(:dim1,:dim2)    = dbta%xzts(:dim1,:dim2)
        data%dt_cool(:dim1,:dim2) = dbta%dt_cool(:dim1,:dim2)
        data%z_c(:dim1,:dim2)     = dbta%z_c(:dim1,:dim2)
        data%c_0(:dim1,:dim2)     = dbta%c_0(:dim1,:dim2)
        data%c_d(:dim1,:dim2)     = dbta%c_d(:dim1,:dim2)
        data%w_0(:dim1,:dim2)     = dbta%w_0(:dim1,:dim2)
        data%w_d(:dim1,:dim2)     = dbta%w_d(:dim1,:dim2)
        data%d_conv(:dim1,:dim2)  = dbta%d_conv(:dim1,:dim2)
        data%ifd(:dim1,:dim2)     = dbta%ifd(:dim1,:dim2)
        data%tref(:dim1,:dim2)    = dbta%tref(:dim1,:dim2)
        data%qrain(:dim1,:dim2)   = dbta%qrain(:dim1,:dim2)
        call nstio_axdbta(dbta,iret)
      endif
    endif
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    iret=0
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_swdata(lu,head,data,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    type(nstio_head),intent(in):: head
    type(nstio_data),intent(in):: data
    integer(nstio_intkind),intent(out):: iret
    integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
    integer:: ios
    integer i
    type(nstio_dbta) dbta
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    dim1=head%lonb
    dim2=head%latb
    dim3=head%lsea
    mdim1=min(&
      size(data%slmsk,1),&
      size(data%xt,1),&
      size(data%xs,1),&
      size(data%xu,1),&
      size(data%xv,1),&
      size(data%xz,1),&
      size(data%zm,1),&
      size(data%xtts,1),&
      size(data%xzts,1),&
      size(data%dt_cool,1),&
      size(data%z_c,1),&
      size(data%c_0,1),&
      size(data%c_d,1),&
      size(data%w_0,1),&
      size(data%w_d,1),&
      size(data%d_conv,1),&
      size(data%ifd,1),&
      size(data%tref,1),&
      size(data%qrain,1))
    mdim2=min(&
      size(data%slmsk,2),&
      size(data%xt,2),&
      size(data%xs,2),&
      size(data%xu,2),&
      size(data%xv,2),&
      size(data%xz,2),&
      size(data%zm,2),&
      size(data%xtts,2),&
      size(data%xzts,2),&
      size(data%dt_cool,2),&
      size(data%z_c,2),&
      size(data%c_0,2),&
      size(data%c_d,2),&
      size(data%w_0,2),&
      size(data%w_d,2),&
      size(data%d_conv,2),&
      size(data%ifd,2),&
      size(data%tref,2))
    mdim3=0
    iret=-5
    if(mdim1.lt.dim1.or.&
       mdim2.lt.dim2.or.&
       mdim3.lt.dim3) return
    iret=-4
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if(head%ivo.eq.200907) then
      if(head%irealf.ne.2) then
        write(lu,iostat=ios) data%slmsk(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%xt(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%xs(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%xu(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%xv(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%xz(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%zm(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%xtts(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%xzts(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%dt_cool(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%z_c(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%c_0(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%c_d(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%w_0(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%w_d(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%d_conv(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%ifd(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%tref(:dim1,:dim2)
        if(ios.ne.0) return
        write(lu,iostat=ios) data%qrain(:dim1,:dim2)
        if(ios.ne.0) return
      else
        call nstio_aldbta(head,dbta,iret)
        if(iret.ne.0) return
        dbta%slmsk(:dim1,:dim2)    = data%slmsk(:dim1,:dim2)
        dbta%xt(:dim1,:dim2)       = data%xt(:dim1,:dim2)
        dbta%xs(:dim1,:dim2)       = data%xs(:dim1,:dim2)
        dbta%xu(:dim1,:dim2)       = data%xu(:dim1,:dim2)
        dbta%xv(:dim1,:dim2)       = data%xv(:dim1,:dim2)
        dbta%xz(:dim1,:dim2)       = data%xz(:dim1,:dim2)
        dbta%zm(:dim1,:dim2)       = data%zm(:dim1,:dim2)
        dbta%xtts(:dim1,:dim2)     = data%xtts(:dim1,:dim2)
        dbta%xzts(:dim1,:dim2)     = data%xzts(:dim1,:dim2)
        dbta%dt_cool(:dim1,:dim2)  = data%dt_cool(:dim1,:dim2)
        dbta%z_c(:dim1,:dim2)      = data%z_c(:dim1,:dim2)
        dbta%c_0(:dim1,:dim2)      = data%c_0(:dim1,:dim2)
        dbta%c_d(:dim1,:dim2)      = data%c_d(:dim1,:dim2)
        dbta%w_0(:dim1,:dim2)      = data%w_0(:dim1,:dim2)
        dbta%w_d(:dim1,:dim2)      = data%w_d(:dim1,:dim2)
        dbta%d_conv(:dim1,:dim2)   = data%d_conv(:dim1,:dim2)
        dbta%ifd(:dim1,:dim2)      = data%ifd(:dim1,:dim2)
        dbta%tref(:dim1,:dim2)     = data%tref(:dim1,:dim2)
        dbta%qrain(:dim1,:dim2)    = data%qrain(:dim1,:dim2)
        call nstio_swdbta(lu,head,dbta,iret)
        if(iret.ne.0) return
        call nstio_axdbta(dbta,iret)
      endif
    endif
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    iret=0
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_srohdca(lu,cfname,head,data,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    character*(*),intent(in):: cfname
    type(nstio_head),intent(inout):: head
    type(nstio_data),intent(inout):: data
    integer(nstio_intkind),intent(out):: iret
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_sropen(lu,cfname,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srhead(lu,head,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_aldata(head,data,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srdata(lu,head,data,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srclose(lu,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_swohdca(lu,cfname,head,ngrids_nst,data,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    character*(*),intent(in):: cfname
    type(nstio_head),intent(in):: head
    integer(nstio_intkind),intent(in):: ngrids_nst
    type(nstio_data),intent(in):: data
    integer(nstio_intkind),intent(out):: iret
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_swopen(lu,cfname,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_swhead(lu,head,ngrids_nst,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_swdata(lu,head,data,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srclose(lu,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_aldbta(head,dbta,iret)
    implicit none
    type(nstio_head),intent(in):: head
    type(nstio_dbta),intent(inout):: dbta
    integer(nstio_intkind),intent(out):: iret
    integer dim1,dim2,dim3
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_axdbta(dbta,iret)
    dim1=head%lonb
    dim2=head%latb
    dim3=head%lsea
    allocate(&
      dbta%slmsk(dim1,dim2),&
      dbta%xt(dim1,dim2),&
      dbta%xs(dim1,dim2),&
      dbta%xu(dim1,dim2),&
      dbta%xv(dim1,dim2),&
      dbta%xz(dim1,dim2),&
      dbta%zm(dim1,dim2),&
      dbta%xtts(dim1,dim2),&
      dbta%xzts(dim1,dim2),&
      dbta%dt_cool(dim1,dim2),&
      dbta%z_c(dim1,dim2),&
      dbta%c_0(dim1,dim2),&
      dbta%c_d(dim1,dim2),&
      dbta%w_0(dim1,dim2),&
      dbta%w_d(dim1,dim2),&
      dbta%d_conv(dim1,dim2),&
      dbta%ifd(dim1,dim2),&
      dbta%tref(dim1,dim2),&
      dbta%qrain(dim1,dim2),&
      stat=iret)
    if(iret.ne.0) iret=-3
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_axdbta(dbta,iret)
    implicit none
    type(nstio_dbta),intent(inout):: dbta
    integer(nstio_intkind),intent(out):: iret
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    deallocate(&
      dbta%slmsk,&
      dbta%xt,&
      dbta%xs,&
      dbta%xu,&
      dbta%xv,&
      dbta%xz,&
      dbta%zm,&
      dbta%xtts,&
      dbta%xzts,&
      dbta%dt_cool,&
      dbta%z_c,&
      dbta%c_0,&
      dbta%c_d,&
      dbta%w_0,&
      dbta%w_d,&
      dbta%d_conv,&
      dbta%ifd,&
      dbta%tref,&
      dbta%qrain,&
      stat=iret)
    nullify(&
      dbta%slmsk,&
      dbta%xt,&
      dbta%xs,&
      dbta%xu,&
      dbta%xv,&
      dbta%xz,&
      dbta%zm,&
      dbta%xtts,&
      dbta%xzts,&
      dbta%dt_cool,&
      dbta%z_c,&
      dbta%c_0,&
      dbta%c_d,&
      dbta%w_0,&
      dbta%w_d,&
      dbta%d_conv,&
      dbta%ifd,&
      dbta%tref)
    if(iret.ne.0) iret=-3
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_srdbta(lu,head,dbta,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    type(nstio_head),intent(in):: head
    type(nstio_dbta),intent(inout):: dbta
    integer(nstio_intkind),intent(out):: iret
    integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
    integer:: ios
    integer i
    type(nstio_data):: data
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    dim1=head%lonb
    dim2=head%latb
    dim3=head%lsea
    mdim1=min(&
      size(dbta%slmsk,1),&
      size(dbta%xt,1),&
      size(dbta%xs,1),&
      size(dbta%xu,1),&
      size(dbta%xv,1),&
      size(dbta%xz,1),&
      size(dbta%zm,1),&
      size(dbta%xtts,1),&
      size(dbta%xzts,1),&
      size(dbta%dt_cool,1),&
      size(dbta%z_c,1),&
      size(dbta%c_0,1),&
      size(dbta%c_d,1),&
      size(dbta%w_0,1),&
      size(dbta%w_d,1),&
      size(dbta%d_conv,1),&
      size(dbta%ifd,1),&
      size(dbta%tref,1),&
      size(dbta%qrain,1))
    mdim2=min(&
      size(dbta%slmsk,2),&
      size(dbta%xt,2),&
      size(dbta%xs,2),&
      size(dbta%xu,2),&
      size(dbta%xv,2),&
      size(dbta%xz,2),&
      size(dbta%zm,2),&
      size(dbta%xtts,2),&
      size(dbta%xzts,2),&
      size(dbta%dt_cool,2),&
      size(dbta%z_c,2),&
      size(dbta%c_0,2),&
      size(dbta%c_d,2),&
      size(dbta%w_0,2),&
      size(dbta%w_d,2),&
      size(dbta%d_conv,2),&
      size(dbta%ifd,2),&
      size(dbta%tref,2),&
      size(dbta%qrain,2))
    mdim3=0
    iret=-5
    if(mdim1.lt.dim1.or.&
       mdim2.lt.dim2.or.&
       mdim3.lt.dim3) return
    iret=-4
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if(head%irealf.ne.2) then
      call nstio_aldata(head,data,iret)
      if(iret.ne.0) return
      call nstio_srdata(lu,head,data,iret)
      if(iret.ne.0) return
        dbta%slmsk(:dim1,:dim2)    = data%slmsk(:dim1,:dim2)
        dbta%xt(:dim1,:dim2)       = data%xt(:dim1,:dim2)
        dbta%xs(:dim1,:dim2)       = data%xs(:dim1,:dim2)
        dbta%xu(:dim1,:dim2)       = data%xu(:dim1,:dim2)
        dbta%xv(:dim1,:dim2)       = data%xv(:dim1,:dim2)
        dbta%xz(:dim1,:dim2)       = data%xz(:dim1,:dim2)
        dbta%zm(:dim1,:dim2)       = data%zm(:dim1,:dim2)
        dbta%xtts(:dim1,:dim2)     = data%xtts(:dim1,:dim2)
        dbta%xzts(:dim1,:dim2)     = data%xzts(:dim1,:dim2)
        dbta%dt_cool(:dim1,:dim2)  = data%dt_cool(:dim1,:dim2)
        dbta%z_c(:dim1,:dim2)      = data%z_c(:dim1,:dim2)
        dbta%c_0(:dim1,:dim2)      = data%c_0(:dim1,:dim2)
        dbta%c_d(:dim1,:dim2)      = data%c_d(:dim1,:dim2)
        dbta%w_0(:dim1,:dim2)      = data%w_0(:dim1,:dim2)
        dbta%w_d(:dim1,:dim2)      = data%w_d(:dim1,:dim2)
        dbta%d_conv(:dim1,:dim2)   = data%d_conv(:dim1,:dim2)
        dbta%ifd(:dim1,:dim2)      = data%ifd(:dim1,:dim2)
        dbta%tref(:dim1,:dim2)     = data%tref(:dim1,:dim2)
        dbta%qrain(:dim1,:dim2)    = data%qrain(:dim1,:dim2)
      call nstio_axdata(data,iret)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    elseif(head%ivo == 200907) then
      read(lu,iostat=ios) dbta%slmsk(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%xt(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%xs(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%xu(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%xv(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%xz(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%zm(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%xtts(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%xzts(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%dt_cool(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%z_c(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%c_0(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%c_d(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%w_0(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%w_d(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%d_conv(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%ifd(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%tref(:dim1,:dim2)
      if(ios.ne.0) return
      read(lu,iostat=ios) dbta%qrain(:dim1,:dim2)
      if(ios.ne.0) return
    endif
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    iret=0
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_swdbta(lu,head,dbta,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    type(nstio_head),intent(in):: head
    type(nstio_dbta),intent(in):: dbta
    integer(nstio_intkind),intent(out):: iret
    integer:: dim1,dim2,dim3,mdim1,mdim2,mdim3
    integer:: ios
    integer i
    type(nstio_data):: data
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    dim1=head%lonb
    dim2=head%latb
    dim3=head%lsea
    mdim1=min(&
      size(dbta%slmsk,1),&
      size(dbta%xt,1),&
      size(dbta%xs,1),&
      size(dbta%xu,1),&
      size(dbta%xv,1),&
      size(dbta%xz,1),&
      size(dbta%zm,1),&
      size(dbta%xtts,1),&
      size(dbta%xzts,1),&
      size(dbta%dt_cool,1),&
      size(dbta%z_c,1),&
      size(dbta%c_0,1),&
      size(dbta%c_d,1),&
      size(dbta%w_0,1),&
      size(dbta%w_d,1),&
      size(dbta%d_conv,1),&
      size(dbta%ifd,1),&
      size(dbta%tref,1),&
      size(dbta%qrain,1))
    mdim2=min(&
      size(dbta%slmsk,2),&
      size(dbta%xt,2),&
      size(dbta%xs,2),&
      size(dbta%xu,2),&
      size(dbta%xv,2),&
      size(dbta%xz,2),&
      size(dbta%zm,2),&
      size(dbta%xtts,2),&
      size(dbta%xzts,2),&
      size(dbta%dt_cool,2),&
      size(dbta%z_c,2),&
      size(dbta%c_0,2),&
      size(dbta%c_d,2),&
      size(dbta%w_0,2),&
      size(dbta%w_d,2),&
      size(dbta%d_conv,2),&
      size(dbta%ifd,2),&
      size(dbta%tref,2),&
      size(dbta%qrain,2))
    mdim3=0
    iret=-5
    if(mdim1.lt.dim1.or.&
       mdim2.lt.dim2.or.&
       mdim3.lt.dim3) return
    iret=-4
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if(head%irealf.ne.2) then
      call nstio_aldata(head,data,iret)
      if(iret.ne.0) return
        data%slmsk(:dim1,:dim2)   = dbta%slmsk(:dim1,:dim2)
        data%xt(:dim1,:dim2)      = dbta%xt(:dim1,:dim2)
        data%xs(:dim1,:dim2)      = dbta%xs(:dim1,:dim2)
        data%xu(:dim1,:dim2)      = dbta%xu(:dim1,:dim2)
        data%xv(:dim1,:dim2)      = dbta%xv(:dim1,:dim2)
        data%xz(:dim1,:dim2)      = dbta%xz(:dim1,:dim2)
        data%zm(:dim1,:dim2)      = dbta%zm(:dim1,:dim2)
        data%xtts(:dim1,:dim2)    = dbta%xtts(:dim1,:dim2)
        data%xzts(:dim1,:dim2)    = dbta%xzts(:dim1,:dim2)
        data%dt_cool(:dim1,:dim2) = dbta%dt_cool(:dim1,:dim2)
        data%z_c(:dim1,:dim2)     = dbta%z_c(:dim1,:dim2)
        data%c_0(:dim1,:dim2)     = dbta%c_0(:dim1,:dim2)
        data%c_d(:dim1,:dim2)     = dbta%c_d(:dim1,:dim2)
        data%w_0(:dim1,:dim2)     = dbta%w_0(:dim1,:dim2)
        data%w_d(:dim1,:dim2)     = dbta%w_d(:dim1,:dim2)
        data%d_conv(:dim1,:dim2)  = dbta%d_conv(:dim1,:dim2)
        data%ifd(:dim1,:dim2)     = dbta%ifd(:dim1,:dim2)
        data%tref(:dim1,:dim2)    = dbta%tref(:dim1,:dim2)
        data%qrain(:dim1,:dim2)   = dbta%qrain(:dim1,:dim2)
      call nstio_swdata(lu,head,data,iret)
      if(iret.ne.0) return
      call nstio_axdata(data,iret)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    elseif(head%ivo == 200907) then
      write(lu,iostat=ios) dbta%slmsk(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%xt(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%xs(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%xu(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%xv(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%xz(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%zm(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%xtts(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%xzts(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%dt_cool(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%z_c(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%c_0(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%c_d(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%w_0(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%w_d(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%d_conv(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%ifd(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%tref(:dim1,:dim2)
      if(ios.ne.0) return
      write(lu,iostat=ios) dbta%qrain(:dim1,:dim2)
      if(ios.ne.0) return
    endif
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    iret=0
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_srohdcb(lu,cfname,head,dbta,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    character*(*),intent(in):: cfname
    type(nstio_head),intent(inout):: head
    type(nstio_dbta),intent(inout):: dbta
    integer(nstio_intkind),intent(out):: iret
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_sropen(lu,cfname,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srhead(lu,head,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_aldbta(head,dbta,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srdbta(lu,head,dbta,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srclose(lu,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
  subroutine nstio_swohdcb(lu,cfname,head,ngrids_nst,dbta,iret)
    implicit none
    integer(nstio_intkind),intent(in):: lu
    character*(*),intent(in):: cfname
    type(nstio_head),intent(in):: head
    integer(nstio_intkind),intent(in):: ngrids_nst
    type(nstio_dbta),intent(in):: dbta
    integer(nstio_intkind),intent(out):: iret
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_swopen(lu,cfname,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_swhead(lu,head,ngrids_nst,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_swdbta(lu,head,dbta,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    call nstio_srclose(lu,iret)
    if(iret.ne.0) return
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  end subroutine
!-------------------------------------------------------------------------------
end module