write_res1.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: WRITE_RES1                                             C
!  Purpose: write out the time-dependent restart records               C
!                                                                      C
!  Author: P. Nicoletti                               Date: 13-DEC-91  C
!  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date: 24-JAN-92  C
!                                                                      C
!  Revision Number:                                                    C
!  Purpose:                                                            C
!  Author:                                            Date: dd-mmm-yy  C
!  Reviewer:                                          Date: dd-mmm-yy  C
!                                                                      C
!  Literature/Document References:                                     C
!                                                                      C
!  Variables referenced: TIME, NSTEP, EP_g, P_g, P_star, RO_g, ROP_g   C
!                        T_g, T_s, U_g, V_g, W_g, ROP_s, U_s    C
!                        V_s, W_s, IJKMAX2                             C
!  Variables modified: None                                            C
!                                                                      C
!  Local variables: LC, N, NEXT_REC                                    C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
!
      SUBROUTINE write_res1
!...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
!...Switches: -xf
!
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE cdist
      USE compar           !//
      USE energy
      USE fldvar
      USE funits
      USE geometry
      USE machine, only: flush_res
      USE mpi_utility      !//d pnicol : for gather
      USE output
      USE param
      USE param1
      USE physprop
      USE run
      USE rxns
      USE scalars
      USE sendrecv         !//d pnicol : for gather
!//d pnicol  ... not needed    USE tmp_array
      IMPLICIT NONE
!-----------------------------------------------
!   G l o b a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
!
!
!
!
!//d pnicol : allocate arrays for gather/convert_to_io_dp
      double precision, allocatable :: array1(:)
      double precision, allocatable :: array2(:)


!             loop counter
      INTEGER :: LC, NN
!
!             pointer to first time-dependent record in restart file
      INTEGER :: NEXT_REC
!-----------------------------------------------
!

!//d pnicol
!      if (myPE.eq.PE_IO .and. .not.distio) then
         allocate (array1(ijkmax2))
         allocate (array2(ijkmax3))
!      else
!         allocate (array1(1))
!         allocate (array2(1))
!      end if


      if (mype.eq.pe_io .or. bdist_io) then
         READ (unit_res, rec=3) next_rec
         WRITE (unit_res, rec=next_rec) time, dt, nstep
         next_rec = next_rec + 1
      end if
!
!\\SP Local Send Receive - need to be moved to source later!!

      if (.not. bdist_io) then

          call send_recv(ep_g,2)
          call send_recv(p_g,2)
          call send_recv(p_star,2)
          call send_recv(ro_g,2)
          call send_recv(rop_g,2)
          call send_recv(x_g,2)
          call send_recv(t_g,2)
          call send_recv(u_g,2)
          call send_recv(v_g,2)
          call send_recv(w_g,2)
          call send_recv(rop_s,2)
          call send_recv(t_s,2)
          call send_recv(u_s,2)
          call send_recv(v_s,2)
          call send_recv(w_s,2)
          call send_recv(theta_m,2)
          call send_recv(x_s,2)
          if(nscalar > 0)call send_recv(scalar,2)
          if(k_epsilon) THEN
              call send_recv(k_turb_g,2)
              call send_recv(e_turb_g,2)
          endif
          call send_recv(gama_rg,2)
          call send_recv(t_rg,2)
          call send_recv(gama_rs,2)
          call send_recv(t_rs,2)
          if(nrr > 0)call send_recv(reactionrates,2)

      end if


      call gatherwriteres (ep_g,array2, array1, next_rec)  !//d pnicol
!
      call gatherwriteres (p_g,array2, array1, next_rec)  !//d pnicol
!
      call gatherwriteres (p_star,array2, array1, next_rec)  !//d pnicol
!
      call gatherwriteres (ro_g,array2, array1, next_rec)  !//d pnicol
!
      call gatherwriteres (rop_g,array2, array1, next_rec)  !//d pnicol
!
      call gatherwriteres (t_g,array2, array1, next_rec)  !//d pnicol
!
      DO nn = 1, nmax(0)
            call gatherwriteres (x_g(:,nn),array2, array1, next_rec)  !//d pnicol
      END DO
!
      call gatherwriteres (u_g,array2, array1, next_rec)  !//d pnicol
!
      call gatherwriteres (v_g,array2, array1, next_rec)  !//d pnicol
!
      call gatherwriteres (w_g,array2, array1, next_rec)  !//d pnicol
!
      DO lc = 1, mmax
!
        call gatherwriteres (rop_s(:,lc),array2, array1, next_rec)  !//d pnicol

        IF(any(solve_ros)) &
            call gatherwriteres (ro_s(:,lc),array2, array1, next_rec)  !//d pnicol
!
        call gatherwriteres (t_s(:,lc),array2, array1, next_rec)  !//d pnicol
!
        call gatherwriteres (u_s(:,lc),array2, array1, next_rec)  !//d pnicol
!
        call gatherwriteres (v_s(:,lc),array2, array1, next_rec)  !//d pnicol
!
        call gatherwriteres (w_s(:,lc),array2, array1, next_rec)  !//d pnicol
!
        call gatherwriteres (theta_m(:,lc),array2, array1, next_rec)  !//d pnicol
!
         DO nn = 1, nmax(lc)
            call gatherwriteres (x_s(:,lc,nn),array2, array1, next_rec)  !//d pnicol
         END DO
      END DO
!
!     Version 1.3

      DO lc = 1, nscalar
            call gatherwriteres (scalar(:,lc),array2, array1, next_rec)  !//d pnicol
      END DO
!
!     Version 1.4 -- write radiation variables in write_res1
      call gatherwriteres (gama_rg,array2, array1, next_rec)  !//d pnicol

      call gatherwriteres (t_rg,array2, array1, next_rec)  !//d pnicol

      DO lc = 1, mmax
        call gatherwriteres (gama_rs(1,lc),array2, array1, next_rec)  !//d pnicol

        call gatherwriteres (t_rs(1,lc),array2, array1, next_rec)  !//d pnicol
      ENDDO

!
!     Version 1.5
      DO lc = 1, nrr
            call gatherwriteres (reactionrates(:,lc),array2, array1, next_rec)  !//d pnicol
      END DO
!
!     Version 1.6

      if (k_epsilon) then
            call gatherwriteres (k_turb_g,array2, array1, next_rec)  !//d pnicol
          call gatherwriteres (e_turb_g,array2, array1, next_rec)
      endif
!---------------------------------------------------------------------

      if ( (mype.eq.pe_io .and. .not.bdist_io) .or. bdist_io) then
           CALL flush_res (unit_res)
        end if

!      call MPI_Barrier(MPI_COMM_WORLD,mpierr)  !//PAR_I/O enforce barrier here
!
      deallocate (array1)  !//d pnicol
      deallocate (array2)  !//d pnicol
!     call MPI_Barrier(MPI_COMM_WORLD,mpierr)  !//PAR_I/O enforce barrier here

      call write_res1_netcdf
!
      RETURN
      END SUBROUTINE write_res1

      subroutine gatherwriteres(VAR, array2, array1, NEXT_REC)

      USE geometry
      USE funits
      USE cdist
      USE compar           !//
      USE mpi_utility      !//d pnicol : for gather
      USE sendrecv         !//d pnicol : for gather

      USE cutcell
      USE in_binary_512
      USE param, only: dimension_3

      IMPLICIT NONE

      double precision, dimension(ijkmax2) :: array1
      double precision, dimension(ijkmax3) :: array2
      double precision, dimension(DIMENSION_3) :: VAR,TMP_VAR

      INTEGER :: NEXT_REC

!     call MPI_Barrier(MPI_COMM_WORLD,mpierr)  !//PAR_I/O enforce barrier here
      if (.not.bdist_io) then


         IF(re_indexing) THEN
            CALL unshift_dp_array(var,tmp_var)
            CALL gather (tmp_var,array2,root)
         ELSE
            CALL gather (var,array2,root)
         ENDIF
!         call gather (VAR,array2,root)  !//d pnicol

!        call MPI_Barrier(MPI_COMM_WORLD,mpierr)  !//PAR_I/O enforce barrier here
         if (mype.eq.pe_io) then
            call convert_to_io_dp(array2,array1,ijkmax2)
            CALL out_bin_512 (unit_res, array1, ijkmax2, next_rec)
         end if

      else

         IF(re_indexing) THEN
            CALL unshift_dp_array(var,tmp_var)
            CALL out_bin_512 (unit_res, tmp_var, size(tmp_var), next_rec)
         ELSE
            CALL out_bin_512 (unit_res, var, size(var), next_rec)
         ENDIF
!         CALL OUT_BIN_512 (UNIT_RES, var, size(var), NEXT_REC)

      end if

      End subroutine gatherwriteres

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                              !
!                                      write_res1_netcdf                       !
!                                                                              !
      subroutine write_res1_netcdf

        USE param
        USE param1
        USE fldvar
        USE geometry
        USE physprop
        USE run
        USE scalars
        USE rxns
        USE cdist
        USE compar
        USE mpi_utility
        USE mfix_netcdf
        USE energy
        USE in_binary_512
!       USE tmp_array


        implicit none

        integer :: I , nn

        integer   :: ncid , xyz_dimid
        integer   :: varid_time , t_dimid
        integer   :: dimids(1) , varid_epg , varid_pg,dims_time(1)
        integer   :: varid_pstar  , varid_ug , varid_vg , varid_wg
        integer   :: varid_tg  , varid_ropg
        integer   :: varid_rog , varid_gamaRG , varid_TRG
        integer   :: varid_gamaRS(20) , varid_TRS(20)

        integer   :: varid_us(20) , varid_vs(20) , varid_ws(20)  !! MMAX
        integer   :: varid_rops(20)  , varid_ts(20) !! mmax
        integer   :: varid_thetam(20) !! mmax

        integer   :: varid_xg(20)  ! nmax(0)
        integer   :: varid_xs(20,20)  ! mmax , MAX(nmax(1:mmax))

        integer   :: varid_scalar(20)  ! nscalar
        integer   :: varid_rr(20)      ! nRR

        integer   :: varid_kturbg , varid_eturbg


        character(LEN=80) :: fname, var_name

        double precision, allocatable :: arr1(:)
        double precision, allocatable :: arr2(:)

! bWrite_netcdf(1)  : EP_g
! bWrite_netcdf(2)  : P_g
! bWrite_netcdf(3)  : P_star
! bWrite_netcdf(4)  : U_g / V_g / W_g
! bWrite_netcdf(5)  : U_s / V_s / W_s
! bWrite_netcdf(6)  : ROP_s
! bWrite_netcdf(7)  : T_g
! bWrite_netcdf(8)  : T_s
! bWrite_netcdf(9)  : X_g
! bWrite_netcdf(10) : X_s
! bWrite_netcdf(11) : Theta_m
! bWrite_netCDF(12) : Scalar
! bWrite_netCDF(13) : ReactionRates
! bWrite_netCDF(14) : k_turb_g , e_turb_g

        if (.not. mfix_usingnetcdf()) return
        if (.not. bglobalnetcdf) return

        return ! for now ... do not write restart files using netCDF

        if (mype .eq. pe_io) then
           allocate (arr1(ijkmax2))
           allocate (arr2(ijkmax3))
        else
           allocate (arr1(1))
           allocate (arr2(1))
        end if

!       call mpi$barrier(MPI_COMM_WORLD,mpierr)
        if (mype .ne. pe_io) goto 1234

        fname = trim(run_name) // "_RES1.nc"
        call mfix_check_netcdf( mfix_nf90_create(fname, nf90_clobber, ncid) )

        call mfix_check_netcdf( mfix_nf90_def_dim(ncid, "xyz", ijkmax2, xyz_dimid) )
        call mfix_check_netcdf( mfix_nf90_def_dim(ncid, "t"  ,         1        ,   t_dimid) )

        ! The dimids array is used to pass the IDs of the dimensions of
        ! the variables. Note that in fortran arrays are stored in
        ! column-major format.
        dims_time(1) = t_dimid
        dimids =  (/ xyz_dimid /)

        call mfix_check_netcdf( mfix_nf90_def_var(ncid ,"time"  , nf90_double ,dims_time , varid_time ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "EP_g"  , nf90_double, dimids    , varid_epg  ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "P_g"   , nf90_double, dimids    , varid_pg   ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "P_star", nf90_double, dimids    , varid_pstar) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "U_g"   , nf90_double, dimids    , varid_ug   ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "V_g"   , nf90_double, dimids    , varid_vg   ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "W_g"   , nf90_double, dimids    , varid_wg   ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "T_g"   , nf90_double, dimids    , varid_tg   ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "ROP_g" , nf90_double, dimids    , varid_ropg ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "RO_g"  , nf90_double, dimids    , varid_rog  ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "gamaRG"  , nf90_double, dimids    , varid_gamarg  ) )
        call mfix_check_netcdf( mfix_nf90_def_var(ncid, "TRG"  , nf90_double, dimids       , varid_trg  ) )

        do i = 1,1   ! mmax
           var_name = 'U_s_xxx'
           write (var_name(5:7),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_us(i)) )

           var_name = 'V_s_xxx'
           write (var_name(5:7),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_vs(i)) )

           var_name = 'W_s_xxx'
           write (var_name(5:7),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_ws(i)) )

           var_name = 'ROP_s_xxx'
           write (var_name(7:10),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_rops(i)) )

           var_name = 'T_s_xxx'
           write (var_name(5:7),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_ts(i)) )

           var_name = 'Theta_m_xxx'
           write (var_name(9:11),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_thetam(i)) )

           var_name = 'gamaRS_xxx'
           write (var_name(8:10),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_gamars(i)) )

           var_name = 'TRS_xxx'
           write (var_name(5:7),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_trs(i)) )

           DO nn = 1, nmax(i)
              var_name = 'X_s_xxx_xxx'
              write (var_name(5:7) ,'(i3.3)') i
              write (var_name(9:11),'(i3.3)') nn
              call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_xs(i,nn)) )
           END DO


        end do

        do i = 1,nmax(0)
           var_name = 'X_g_xxx'
           write (var_name(5:7),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_xg(i)) )
        end do

        do i = 1,nscalar
           var_name = 'Scalar_xxx'
           write (var_name(8:10),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_scalar(i)) )
        end do

        do i = 1,nrr
           var_name = 'RRates_xxx'
           write (var_name(8:10),'(i3.3)') i
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, var_name, nf90_double, dimids, varid_rr(i)) )
        end do


        if (k_epsilon) then
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, 'k_turb_g', nf90_double, dimids, varid_kturbg) )
           call mfix_check_netcdf( mfix_nf90_def_var(ncid, 'e_turb_g', nf90_double, dimids, varid_eturbg) )
        end if


        call mfix_check_netcdf( mfix_nf90_enddef(ncid) )

 1234   continue
!       call mpi$barrier(MPI_COMM_WORLD,mpierr)

        if (mype .eq. pe_io) then
!           call check_netcdf( nf90_put_var(ncid,varid_time,the_time) )   ! ???
           call mfix_check_netcdf( mfix_nf90_put_var(ncid,varid_time,time) )       ! ???
        end if

        call gather(ep_g,arr2,root)

        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_epg, arr1) )
        end if

        call gather(p_g,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_pg, arr1) )
        end if

        call gather(p_star,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_pstar, arr1) )
        end if

        call gather(u_g,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_ug, arr1) )
        end if

        call gather(v_g,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_vg, arr1) )
        end if

        call gather(w_g,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_wg, arr1) )
        end if

        call gather(t_g,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_tg, arr1) )
        end if

        call gather(gama_rg,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_gamarg, arr1) )
        end if

        call gather(ro_g,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_rog, arr1) )
        end if

        call gather(rop_g,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_ropg, arr1) )
        end if

        call gather(t_rg,arr2,root)
        if (mype .eq. pe_io) then
           call convert_to_io_dp(arr2,arr1,ijkmax2)
           call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_trg, arr1) )
        end if

        do i = 1,1   ! mmax

           call gather(u_s(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_us(i), arr1) )
           end if

           call gather(v_s(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_vs(i), arr1) )
           end if


           call gather(w_s(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_ws(i), arr1) )
           end if

           call gather(rop_s(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_rops(i), arr1 ) )
           end if

           call gather(t_s(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_ts(i), arr1 ) )
           end if

           call gather(theta_m(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_thetam(i), arr1 ) )
           end if

           call gather(gama_rs(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_gamars(i), arr1 ) )
           end if

           call gather(t_rs(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_trs(i) , arr1 ) )
           end if

           do nn = 1,nmax(i)
              call gather(x_s(:,i,nn),arr2,root)
              if (mype .eq. pe_io) then
                 call convert_to_io_dp(arr2,arr1,ijkmax2)
                 call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_xs(i,nn), arr1 ) )
              end if
           end do

        end do

        do i = 1,nmax(0)
           call gather(x_g(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_xg(i), arr1 ) )
           end if
        end do

        do i = 1,nscalar
           call gather(scalar(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_scalar(i), arr1 ) )
           end if
        end do

        do i = 1,nrr
           call gather(reactionrates(:,i),arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_rr(i), arr1 ) )
           end if
        end do

        if (k_epsilon) then
           call gather(k_turb_g,arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_kturbg, arr1) )
           end if

           call gather(e_turb_g,arr2,root)
           if (mype .eq. pe_io) then
              call convert_to_io_dp(arr2,arr1,ijkmax2)
              call mfix_check_netcdf( mfix_nf90_put_var(ncid, varid_eturbg, arr1) )
           end if
        end if

 2222   continue

        ! Close the file. This frees up any internal netCDF resources
        ! associated with the file, and flushes any buffers.
        if (mype .eq. pe_io) then
           call mfix_check_netcdf( mfix_nf90_close(ncid) )
        end if

        deallocate (arr1)
        deallocate (arr2)

        return

      end subroutine write_res1_netcdf