ecearth3/sources/nemo-3.6/TOOLS/OBSTOOLS/src/fbstatncio.F90

#define MYFILE 'fbstatncio.F90'
MODULE fbstatncio

   USE fbacctype
   USE nctools
   IMPLICIT NONE

   REAL, PARAMETER :: fbstncmiss = 99999.

   TYPE fbstatnctype
      INTEGER :: nlev,nbox,nadd
      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
      CHARACTER(len=32), POINTER, DIMENSION(:) :: name
      REAL, POINTER, DIMENSION(:) :: dep
      REAL, POINTER, DIMENSION(:,:,:) :: val
      INTEGER, POINTER, DIMENSION(:,:) :: cnt
   END TYPE fbstatnctype

   TYPE fbstathistnctype
      INTEGER :: nlev,nbox,npoints
      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
      REAL, POINTER, DIMENSION(:) :: dep,val
      INTEGER, POINTER, DIMENSION(:,:,:) :: nhist
   END TYPE fbstathistnctype

   TYPE fbstatxynctype
      INTEGER :: nlev,nbox,npoints
      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
      REAL, POINTER, DIMENSION(:) :: dep,val
      INTEGER, POINTER, DIMENSION(:,:,:,:) :: nxy
   END TYPE fbstatxynctype

CONTAINS

   SUBROUTINE fbstat_ncwrite(cdfilename,nvar,cdvar,nadd,cdadd,&
      & nobe,cdobe,nbge,cdbge,&
      & nbox,nboxl,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
      & knum,pbias,prms,pstd,pomean,pmmean,knuma,poamean, &
      & knumo,poerr,povar,knumb,pberr,pbvar)
      ! Arguments
      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
      INTEGER :: nvar                               ! Number of variables 
      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
      INTEGER :: nadd                               ! Number of additional data
      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
      INTEGER :: nobe                               ! Number of obs errors
      CHARACTER(len=*), DIMENSION(nadd) :: cdobe    ! Name of obs erors
      INTEGER :: nbge                               ! Number of bg errors
      CHARACTER(len=*), DIMENSION(nadd) :: cdbge    ! Name of bg erors
      INTEGER :: nbox                               ! Total number of boxes
      INTEGER :: nboxl                              ! Actual number of boxes
      INTEGER :: lenboxname                         ! Length of box names
      CHARACTER(len=lenboxname), DIMENSION(nbox) :: &
         & cdboxnam                                 ! Name of boxes
      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
      INTEGER :: nlev                               ! Number of levels
      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
      INTEGER, DIMENSION(nlev,nboxl,nadd,nvar) :: & ! Output data
         & knum
      REAL, DIMENSION(nlev,nboxl,nadd,nvar) :: &    ! Output data
         & pbias, prms, pstd, pomean, pmmean
      INTEGER, DIMENSION(nlev,nboxl,nvar) :: &      ! Output data
         & knuma
      REAL, DIMENSION(nlev,nboxl,nvar) :: &         ! Output data
         & poamean
      INTEGER, DIMENSION(nlev,nboxl,nobe,nvar) :: & ! Output data
         & knumo
      REAL, DIMENSION(nlev,nboxl,nobe,nvar) :: &    ! Output data
         & poerr,povar
      INTEGER, DIMENSION(nlev,nboxl,nbge,nvar) :: & ! Output data
         & knumb
      REAL, DIMENSION(nlev,nboxl,nbge,nvar) :: &    ! Output data
         & pberr,pbvar
      ! Local variables
      INTEGER :: jadd,jvar,incvar,iv,jbox,ip
      CHARACTER(len=50) :: cncvarbase
      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
      ! netcdf stuff
      INTEGER :: ncid,idlev,idbox,idlbox,idimdep(1),idimbox(2),idimids(2)
      INTEGER :: idvbox,idvlev
      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
      INTEGER :: inoboxes
      REAL, ALLOCATABLE, DIMENSION(:,:) :: ztmp
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: itmp
      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
         & clboxnam                                 ! Name of boxes

      ! Open netCDF files.

      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
         &          __LINE__,MYFILE)

      ! Create dimensions

      inoboxes=nbox-COUNT(lskipbox)
      ALLOCATE(ztmp(nlev,inoboxes),itmp(nlev,inoboxes),clboxnam(inoboxes))

      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)

      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
         &          __LINE__,MYFILE)

      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)

      ! Box variable name

      idimbox(1)=idlbox
      idimbox(2)=idbox
      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
         &          __LINE__,MYFILE)

      ! Depths

      idimdep(1)=idlev
      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
         &          __LINE__,MYFILE)

      ! Setup variables names

      idimids(1)=idlev
      idimids(2)=idbox
      incvar=(nadd*6+nobe*3+nbge*3+2)*nvar
      ALLOCATE(cncvar(incvar),idvar(incvar))
      iv=0
      DO jvar=1,nvar
         DO jadd=1,nadd
            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdadd(jadd))
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_bias'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_rms'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_std'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_omean'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_mmean'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_count'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
         ENDDO
         DO jadd=1,nobe
            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdobe(jadd))
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_count'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
         ENDDO
         DO jadd=1,nbge
            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdbge(jadd))
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
            iv=iv+1
            cncvar(iv)=TRIM(cncvarbase)//'_count'
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
               &                       idimids,idvar(iv)),__LINE__,MYFILE)
            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
               &          __LINE__,MYFILE)
         ENDDO
         WRITE(cncvarbase,'(A)')TRIM(cdvar(jvar))
         iv=iv+1
         cncvar(iv)=TRIM(cncvarbase)//'_omean'
         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
            &                       idimids,idvar(iv)),__LINE__,MYFILE)
         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
            &          __LINE__,MYFILE)
         iv=iv+1
         cncvar(iv)=TRIM(cncvarbase)//'_count'
         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
            &                       idimids,idvar(iv)),__LINE__,MYFILE)
         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
            &          __LINE__,MYFILE)
      ENDDO
      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
      
      ! Write box names
      
      ip=0
      DO jbox=1,nbox
         IF (.NOT.lskipbox(jbox)) THEN
            ip=ip+1
            clboxnam(ip)=cdboxnam(jbox)
         ENDIF
      ENDDO
      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
         &          __LINE__,MYFILE)

      ! Write levels

      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
         &          __LINE__,MYFILE)

      ! Write the output data

      iv=0
      DO jvar=1,nvar
         DO jadd=1,nadd
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=pbias(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=prms(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=pstd(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=pomean(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=pmmean(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  itmp(:,ip)=knum(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
               &          __LINE__,MYFILE)
         ENDDO
         DO jadd=1,nobe
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=poerr(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=povar(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  itmp(:,ip)=knumo(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
               &          __LINE__,MYFILE)
         ENDDO
         DO jadd=1,nbge
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=pberr(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  ztmp(:,ip)=pbvar(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
               &          __LINE__,MYFILE)
            iv=iv+1
            ip=0
            DO jbox=1,nbox
               IF (.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  itmp(:,ip)=knumb(:,ip,jadd,jvar)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
               &          __LINE__,MYFILE)
         ENDDO
         iv=iv+1
         ip=0
         DO jbox=1,nbox
            IF (.NOT.lskipbox(jbox)) THEN
               ip=ip+1
               ztmp(:,ip)=poamean(:,ip,jvar)
            ENDIF
         ENDDO
         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
            &          __LINE__,MYFILE)
         iv=iv+1
         ip=0
         DO jbox=1,nbox
            IF (.NOT.lskipbox(jbox)) THEN
               ip=ip+1
               itmp(:,ip)=knuma(:,ip,jvar)
            ENDIF
         ENDDO
         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
               &          __LINE__,MYFILE)
      ENDDO
      
      ! Close the file

      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)

      DEALLOCATE(cncvar,idvar,ztmp,itmp,clboxnam)

   END SUBROUTINE fbstat_ncwrite

   SUBROUTINE fbstat_ncwrite_hist(cdfilename,nvar,cdvar,nadd,cdadd,&
      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
      & zhist,zhistmin,zhiststep,ntyp)
      ! Arguments
      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
      INTEGER :: nvar                               ! Number of variables 
      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
      INTEGER :: nadd                               ! Number of addiables 
      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
      INTEGER :: nbox                               ! Number of boxes
      INTEGER :: lenboxname                         ! Length of box names
      CHARACTER(len=lenboxname), dimension(nbox) :: &
         & cdboxnam                                 ! Name of boxes
      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
      INTEGER :: nlev                               ! Number of levels
      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
      TYPE(histtype), DIMENSION(nvar) :: zhist      ! Histogram data
      REAL, DIMENSION(nvar) :: &
         & zhistmin,zhiststep                       ! Histogram info
      integer :: ntyp                               ! Type to write
      ! Local variables
      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
      CHARACTER(len=50) :: cncvarbase
      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
      ! netcdf stuff
      INTEGER :: ncid,idlev,idbox,idlbox,idimhist(nvar),&
         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(3)
      INTEGER :: idvbox,idvlev
      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
      CHARACTER(len=40) :: cdhdimname
      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
      INTEGER :: inoboxes
      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: itmp
      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
         & clboxnam                                 ! Name of boxes

      ! Open netCDF files.

      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
         &          __LINE__,MYFILE)

      ! Create dimensions

      inoboxes=nbox-COUNT(lskipbox) 
      ALLOCATE(clboxnam(inoboxes))

      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)

      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
         &          __LINE__,MYFILE)

      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
      
      DO jvar=1,nvar
         WRITE(cdhdimname,'(A,A)')'hist',TRIM(cdvar(jvar))
         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
            &                       zhist(jvar)%npoints,idimhist(jvar)),&
            & __LINE__,MYFILE)
      ENDDO

      ! Box variable name

      idimbox(1)=idlbox
      idimbox(2)=idbox
      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
         &          __LINE__,MYFILE)

      ! Depths

      idimdep(1)=idlev
      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
         &          __LINE__,MYFILE)

      ! Histogram values and depths

      incvar=nvar+nadd*nvar
      ALLOCATE(cncvar(incvar),idvar(incvar))
      iv=0
      DO jvar=1,nvar
         iv=iv+1
         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
         idimval(1)=idimhist(jvar)
         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
            &                       nf90_float,idimval,idvar(iv)),&
            &          __LINE__,MYFILE)
         DO jadd=1,nadd
            iv=iv+1
            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
               &                       TRIM(cdadd(jadd)),'_count'
            idimcnt(1)=idimhist(jvar)
            idimcnt(2)=idlev
            idimcnt(3)=idbox
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
               &                       nf90_int,idimcnt,idvar(iv)),&
               &          __LINE__,MYFILE)
         ENDDO
      ENDDO
      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
      
      ! Write box names

      ip=0
      DO jbox=1,nbox
         IF (.NOT.lskipbox(jbox)) THEN
            ip=ip+1
            clboxnam(ip)=cdboxnam(jbox)
         ENDIF
      ENDDO
      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
         &          __LINE__,MYFILE)

      ! Write levels

      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
         &          __LINE__,MYFILE)

      iv=0
      DO jvar=1,nvar
         iv=iv+1
         ALLOCATE(zhval(zhist(jvar)%npoints))
         DO ji=1,zhist(jvar)%npoints
            zhval(ji)=(ji-1)*zhiststep(jvar)+zhistmin(jvar)
         ENDDO
         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
            &          __LINE__,MYFILE)
         DEALLOCATE(zhval)
         DO jadd=1,nadd
            iv=iv+1
            ALLOCATE(itmp(zhist(jvar)%npoints,nlev,inoboxes))
            ip=0
            DO jbox=1,nbox
               IF(.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  itmp(:,:,ip)=zhist(jvar)%nhist(:,:,ip,jadd,ntyp)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
               &          __LINE__,MYFILE)
            DEALLOCATE(itmp)
         ENDDO
      ENDDO

      ! Close the file

      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
      
      DEALLOCATE(cncvar,idvar,clboxnam)

   END SUBROUTINE fbstat_ncwrite_hist

   SUBROUTINE fbstat_ncwrite_xy(cdfilename,nvar,cdvar,nadd,cdadd,&
      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
      & zxy,zxymin,zxystep,ntyp)
      ! Arguments
      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
      INTEGER :: nvar                               ! Number of variables 
      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
      INTEGER :: nadd                               ! Number of addiables 
      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
      INTEGER :: nbox                               ! Number of boxes
      INTEGER :: lenboxname                         ! Length of box names
      CHARACTER(len=lenboxname), dimension(nbox) :: &
         & cdboxnam                                 ! Name of boxes
      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
      INTEGER :: nlev                               ! Number of levels
      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
      TYPE(xytype), DIMENSION(nvar) :: zxy          ! xyplot data
      REAL, DIMENSION(nvar) :: &
         & zxymin,zxystep                           ! xyplot info
      integer :: ntyp                               ! Type to write
      ! Local variables
      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
      CHARACTER(len=50) :: cncvarbase
      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
      ! netcdf stuff
      INTEGER :: ncid,idlev,idbox,idlbox,idimxy(nvar),&
         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(4)
      INTEGER :: idvbox,idvlev
      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
      CHARACTER(len=40) :: cdhdimname
      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
      INTEGER :: inoboxes
      INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: itmp
      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
         & clboxnam                                 ! Name of boxes

      ! Open netCDF files.

      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
         &          __LINE__,MYFILE)

      ! Create dimensions

      inoboxes=nbox-COUNT(lskipbox) 
      ALLOCATE(clboxnam(inoboxes))

      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)

      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
         &          __LINE__,MYFILE)

      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
      
      DO jvar=1,nvar
         WRITE(cdhdimname,'(A,A)')'xy',TRIM(cdvar(jvar))
         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
            &                       zxy(jvar)%npoints,idimxy(jvar)),&
            & __LINE__,MYFILE)
      ENDDO

      ! Box variable name

      idimbox(1)=idlbox
      idimbox(2)=idbox
      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
         &          __LINE__,MYFILE)

      ! Depths

      idimdep(1)=idlev
      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
         &          __LINE__,MYFILE)

      ! Histogram values and depths

      incvar=nvar+nadd*nvar
      ALLOCATE(cncvar(incvar),idvar(incvar))
      iv=0
      DO jvar=1,nvar
         iv=iv+1
         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
         idimval(1)=idimxy(jvar)
         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
            &                       nf90_float,idimval,idvar(iv)),&
            &          __LINE__,MYFILE)
         DO jadd=1,nadd
            iv=iv+1
            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
               &                       TRIM(cdadd(jadd)),'_count'
            idimcnt(1)=idimxy(jvar)
            idimcnt(2)=idimxy(jvar)
            idimcnt(3)=idlev
            idimcnt(4)=idbox
            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
               &                       nf90_int,idimcnt,idvar(iv)),&
               &          __LINE__,MYFILE)
         ENDDO
      ENDDO
      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
      
      ! Write box names

      ip=0
      DO jbox=1,nbox
         IF (.NOT.lskipbox(jbox)) THEN
            ip=ip+1
            clboxnam(ip)=cdboxnam(jbox)
         ENDIF
      ENDDO
      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
         &          __LINE__,MYFILE)

      ! Write levels

      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
         &          __LINE__,MYFILE)

      iv=0
      DO jvar=1,nvar
         iv=iv+1
         ALLOCATE(zhval(zxy(jvar)%npoints))
         DO ji=1,zxy(jvar)%npoints
            zhval(ji)=(ji-1)*zxystep(jvar)+zxymin(jvar)
         ENDDO
         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
            &          __LINE__,MYFILE)
         DEALLOCATE(zhval)
         DO jadd=1,nadd
            iv=iv+1
            ALLOCATE(itmp(zxy(jvar)%npoints,zxy(jvar)%npoints,nlev,inoboxes))
            ip=0
            DO jbox=1,nbox
               IF(.NOT.lskipbox(jbox)) THEN
                  ip=ip+1
                  itmp(:,:,:,ip)=zxy(jvar)%nxy(:,:,:,ip,jadd,ntyp)
               ENDIF
            ENDDO
            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
               &          __LINE__,MYFILE)
            DEALLOCATE(itmp)
         ENDDO
      ENDDO

      ! Close the file

      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
      
      DEALLOCATE(cncvar,idvar,clboxnam)

   END SUBROUTINE fbstat_ncwrite_xy

   SUBROUTINE fbstat_ncread(cdfilename,cdvar,sdata)
      ! Arguments
      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
      CHARACTER(len=*) :: cdvar                     ! Name of variables 
      TYPE(fbstatnctype) :: sdata                 ! Data to be filled
      ! Local variables
      INTEGER :: nbox,nlev,nadd,nvar
      INTEGER :: ncid,dimid,varid,i,icntpos
      CHARACTER(len=128) :: cdname,tmpname

      ! Open the file and get the dimensions

      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=nbox),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=nlev),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire(ncid,nVariables=nvar),__LINE__,MYFILE)

      ! Count the number of variables and find the "count" position

      nadd=0
      icntpos=0
      DO i=1,nvar
         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
            &          __LINE__,MYFILE)
         IF (TRIM(cdvar)//'_count'==TRIM(cdname)) THEN
            icntpos=i
         ELSE
            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
               tmpname=cdname(LEN_TRIM(cdvar)+2:)
               IF (INDEX(tmpname,'_')==0) THEN
                  nadd=nadd+1
               ENDIF
            ENDIF
         ENDIF
      ENDDO

      ! Allocate the data structure

      CALL fbstat_ncread_alloc(sdata,nlev,nbox,nadd)

      ! Get the box names in files

      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
      
      ! Get the depths
      
      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)

      nadd=0
      DO i=1,nvar
         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
            &          __LINE__,MYFILE)
         IF (i==icntpos) THEN
            CALL nchdlerr(nf90_get_var(ncid,i,sdata%cnt),__LINE__,MYFILE)
         ELSE
            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
               tmpname=cdname(LEN_TRIM(cdvar)+2:)
               IF (INDEX(tmpname,'_')==0) THEN
                  nadd=nadd+1
                  sdata%name(nadd)=tmpname(1:MAX(LEN_TRIM(tmpname),32))
                  CALL nchdlerr(nf90_get_var(ncid,i,sdata%val(:,:,nadd)),&
                     &                       __LINE__,MYFILE)
               ENDIF
            ENDIF
         ENDIF
      ENDDO

      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)

   END SUBROUTINE fbstat_ncread

   SUBROUTINE fbstat_ncread_alloc(sdata,nlev,nbox,nadd)
      ! Arguments
      TYPE(fbstatnctype) :: sdata    ! Data to be allocated
      INTEGER :: nlev,nbox,nadd
      ! Local variables

      sdata%nlev=nlev
      sdata%nbox=nbox
      sdata%nadd=nadd
      ALLOCATE( &
         & sdata%area(nbox), &
         & sdata%dep(nlev), &
         & sdata%name(nadd), &
         & sdata%val(nlev,nbox,nadd), &
         & sdata%cnt(nlev,nbox) &
         )
      
   END SUBROUTINE fbstat_ncread_alloc

   SUBROUTINE fbstat_ncread_dealloc(sdata)
      ! Arguments
      TYPE(fbstatnctype) :: sdata    ! Data to be deallocated
      ! Local variables

      sdata%nlev=0
      sdata%nbox=0
      sdata%nadd=0
      DEALLOCATE( &
         & sdata%area, &
         & sdata%dep, &
         & sdata%name, &
         & sdata%val, &
         & sdata%cnt &
         )
      
   END SUBROUTINE fbstat_ncread_dealloc

   SUBROUTINE fbstat_ncread_hist(cdfilename,cdvar,cdext,sdata)
      ! Arguments
      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
      CHARACTER(len=*) :: cdvar                     ! Name of variables 
      CHARACTER(len=*) :: cdext                     ! Name of extras
      TYPE(fbstathistnctype) :: sdata               ! Data to be filled
      ! Local variables
      INTEGER :: nbox,nlev,npoints
      INTEGER :: ncid,dimid,varid

      ! Open the file and get the dimensions

      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=nbox),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=nlev),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'hist'//TRIM(cdvar),dimid),&
         &                                __LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=npoints),__LINE__,MYFILE)

      ! Allocate the data structure

      CALL fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)

      ! Get the box names in files

      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
      
      ! Get the depths
      
      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)

      ! Get values

      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
         &          __LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)

      ! Get histograms

      CALL nchdlerr(nf90_inq_varid(ncid,&
         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
         &          __LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nhist),__LINE__,MYFILE)

      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)

   END SUBROUTINE fbstat_ncread_hist

   SUBROUTINE fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)
      ! Arguments
      TYPE(fbstathistnctype) :: sdata    ! Data to be allocated
      INTEGER :: npoints,nlev,nbox
      ! Local variables

      sdata%nlev=nlev
      sdata%nbox=nbox
      sdata%npoints=npoints
      ALLOCATE( &
         & sdata%area(nbox), &
         & sdata%dep(nlev), &
         & sdata%val(npoints), &
         & sdata%nhist(npoints,nlev,nbox) &
         & )
      
   END SUBROUTINE fbstat_ncread_hist_alloc

   SUBROUTINE fbstat_ncread_hist_dealloc(sdata)
      ! Arguments
      TYPE(fbstathistnctype) :: sdata    ! Data to be deallocated
      ! Local variables

      sdata%nlev=0
      sdata%nbox=0
      sdata%npoints=0
      DEALLOCATE( &
         & sdata%area, &
         & sdata%dep, &
         & sdata%val, &
         & sdata%nhist &
         & )
      
   END SUBROUTINE fbstat_ncread_hist_dealloc

   SUBROUTINE fbstat_ncread_xy(cdfilename,cdvar,cdext,sdata)
      ! Arguments
      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
      CHARACTER(len=*) :: cdvar                     ! Name of variables 
      CHARACTER(len=*) :: cdext                     ! Name of extras
      TYPE(fbstatxynctype) :: sdata                 ! Data to be filled
      ! Local variables
      INTEGER :: nbox,nlev,npoints
      INTEGER :: ncid,dimid,varid

      ! Open the file and get the dimensions

      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=nbox),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=nlev),__LINE__,MYFILE)
      CALL nchdlerr(nf90_inq_dimid(ncid,'xy'//TRIM(cdvar),dimid),&
         &                                __LINE__,MYFILE)
      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
         &                      len=npoints),__LINE__,MYFILE)

      ! Allocate the data structure

      CALL fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)

      ! Get the box names in files

      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
      
      ! Get the depths
      
      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)

      ! Get values

      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
         &          __LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)

      ! Get xyograms

      CALL nchdlerr(nf90_inq_varid(ncid,&
         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
         &          __LINE__,MYFILE)
      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nxy),__LINE__,MYFILE)

      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)

   END SUBROUTINE fbstat_ncread_xy

   SUBROUTINE fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)
      ! Arguments
      TYPE(fbstatxynctype) :: sdata    ! Data to be allocated
      INTEGER :: npoints,nlev,nbox
      ! Local variables

      sdata%nlev=nlev
      sdata%nbox=nbox
      sdata%npoints=npoints
      ALLOCATE( &
         & sdata%area(nbox), &
         & sdata%dep(nlev), &
         & sdata%val(npoints), &
         & sdata%nxy(npoints,npoints,nlev,nbox) &
         & )
      
   END SUBROUTINE fbstat_ncread_xy_alloc

   SUBROUTINE fbstat_ncread_xy_dealloc(sdata)
      ! Arguments
      TYPE(fbstatxynctype) :: sdata    ! Data to be deallocated
      ! Local variables

      sdata%nlev=0
      sdata%nbox=0
      sdata%npoints=0
      DEALLOCATE( &
         & sdata%area, &
         & sdata%dep, &
         & sdata%val, &
         & sdata%nxy &
         & )
      
   END SUBROUTINE fbstat_ncread_xy_dealloc

END MODULE fbstatncio