ecearth3/sources/tm5mp/base/user_output_mmix.F90

!### macro's #####################################################
!
#define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
#define IF_NOTOK_RETURN(action) if (rcode/=0) then; TRACEBACK; action; return; end if
#define IF_ERROR_RETURN(action) if (rcode> 0) then; TRACEBACK; action; return; end if
!
#include "tm5.inc"
#include "output.inc"  
!
!----------------------------------------------------------------------------
!                    TM5                                                    !
!----------------------------------------------------------------------------
!BOP
!
! !MODULE:      USER_OUTPUT_MMIX
!
! !DESCRIPTION: Handles initialisation, accumulation and output of monthly
!               mean tracers mixing ratio, temperature, and pressure.
!               For run shorter than a month, average is done over the
!                duration of the run.
!\\
!\\
! !INTERFACE: 
!
MODULE USER_OUTPUT_MMIX
  !
  ! !USES:
  !
  use GO, only : gol, goPr, goErr, goBug, goLabel
  use dims !, mname_dims=>mname
  use chem_param, only: ntrace, nstd

  IMPLICIT NONE
  PRIVATE
  !
  ! !PUBLIC MEMBER FUNCTIONS:
  !
  public :: mmix_Init, mmix_Done  ! object life cycle
  public :: accumulate_mmix       ! accumulate data
  public :: reset_mmix            ! reset data
  public :: write_mmix            ! write data 
  public :: mmix_dat, w_mmix
  !
  ! !PUBLIC TYPES:
  !
  type, public :: mmix_data
     real,dimension(:,:,:,:),pointer     :: rmmix
     real,dimension(:,:,:,:),pointer     :: std_mmix
     real,dimension(:,:,:),pointer       :: tempm
     real,dimension(:,:),pointer         :: presm
  end type mmix_data

  type(mmix_data), dimension(nregions), target :: mmix_dat  ! accumulated data
  real,            dimension(nregions)         :: w_mmix    ! accumulated weight

  integer, dimension(6) :: startdate
  
  character(len=*), parameter  ::  mname = 'user_output_mmix'
  !
  ! !REVISION HISTORY: 
  !   16 Nov 2011 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  !
  ! !REMARKS:
  !
  !EOP
  !------------------------------------------------------------------------

CONTAINS

  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:    MMIX_INIT
  !
  ! !DESCRIPTION: Allocate and set to 0 fields to accumulate.
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE MMIX_INIT(rcode)
    !
    ! !USES:
    !
    use tm5_distgrid,  only : dgrid, Get_DistGrid
    !
    ! !OUTPUT PARAMETERS:
    !
    integer, intent(out)      ::  rcode
    !
    ! !REVISION HISTORY: 
    !   16 Nov 2011 - P. Le Sager - adapted for lon-lat MPI domain decomposition
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC
    character(len=*), parameter ::  rname = mname//'/Init_mmix'

    integer :: region, i1, i2, j1, j2

    call goLabel(rname)

    do region=1,nregions

       call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )

       allocate(mmix_dat(region)%rmmix   (i1:i2, j1:j2, lm(region), ntrace) )
       allocate(mmix_dat(region)%std_mmix(i1:i2, j1:j2, lm(region), nstd)   )
       allocate(mmix_dat(region)%tempm   (i1:i2, j1:j2, lm(region))         )
       allocate(mmix_dat(region)%presm   (i1:i2, j1:j2)                     )
       w_mmix(region) = 0.0

       mmix_dat(region)%rmmix    = 0.0
       mmix_dat(region)%std_mmix = 0.0
       mmix_dat(region)%presm    = 0.0
       mmix_dat(region)%tempm    = 0.0
    end do
    
    startdate = idatei ! start of model run
    
    call goLabel(); rcode=0

  end subroutine mmix_Init
  !EOC

  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:    MMIX_DONE
  !
  ! !DESCRIPTION: deallocate data
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE MMIX_DONE(rcode)
    !
    ! !OUTPUT PARAMETERS:
    !
    integer, intent(out)      ::  rcode
    !
    ! !REVISION HISTORY: 
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC
    character(len=*), parameter ::  rname = mname//'/mmix_Done'

    integer :: region

    call goLabel( rname )

    do region = 1,nregions
       deallocate ( mmix_dat(region)%rmmix   )
       deallocate ( mmix_dat(region)%std_mmix)
       deallocate ( mmix_dat(region)%tempm   )
       deallocate ( mmix_dat(region)%presm   )
    end do
    
    call goLabel(); rcode=0
    
  END SUBROUTINE MMIX_DONE
  !EOC

  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:    RESET_MMIX
  !
  ! !DESCRIPTION: reset to zero all accumulated fields
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE RESET_MMIX( rcode )
    !
    ! !OUTPUT PARAMETERS:
    !
    integer, intent(out)      ::  rcode
    !
    ! !REVISION HISTORY: 
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC
    character(len=*), parameter ::  rname = mname//'/reset_mmix'

    integer :: region

    call goLabel( rname )

    do region=1,nregions

       w_mmix(region) = 0.0

       mmix_dat(region)%rmmix    = 0.0
       mmix_dat(region)%std_mmix = 0.0
       mmix_dat(region)%presm    = 0.0
       mmix_dat(region)%tempm    = 0.0

    enddo
    
    startdate = idate
    
    ! ok
    call goLabel(); rcode=0

  END SUBROUTINE RESET_MMIX
  !EOC

  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:   ACCUMULATE_MMIX
  !
  ! !DESCRIPTION: accumulates fields
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE ACCUMULATE_MMIX( region, rcode)
    !
    ! !USES:
    !
    !use dims,          only : lm, okdebug, ndyn, ndyn_max
    use chem_param,    only : istd , nstd, ntrace, ntracet, ntrace_chem
    use global_data,   only : region_dat, mass_dat,  chem_dat
    use meteodata  ,   only : sp_dat, temper_dat, m_dat
    use partools,      only : isRoot
    use tm5_distgrid,  only : dgrid, Get_DistGrid
    !
    ! !INPUT PARAMETERS:
    !
    integer, intent(in)     :: region
    !
    ! !OUTPUT PARAMETERS:
    !
    integer, intent(out)    ::  rcode
    !
    ! !REVISION HISTORY: 
    !   16 Nov 2011 - P. Le Sager - adapted for lon-lat MPI domain decomposition
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC
    character(len=*), parameter ::  rname = mname//'/accumulate_mmix'

    real,dimension(:,:,:,:),pointer      :: rm, rmmix, std_mmix, rmc
    real,dimension(:,:,:),  pointer      :: t, tempm, m
    real,dimension(:,:,:),  pointer      :: p
    real,dimension(:,:),    pointer      :: presm
    integer,dimension(:,:), pointer      :: zoomed
    integer         :: n, i1, i2, j1, j2, itrace, i,j,l
    real            :: weight

    ! start
    call goLabel( rname )
    
    if (newmonth.and.(.not.newsrun)) then
       call write_mmix(rcode)
       IF_NOTOK_RETURN(rcode=1)
       call reset_mmix(rcode)
       IF_NOTOK_RETURN(rcode=1)
    endif
    
    call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )

    ! debug
    if (region /= 1) then
       print*, rname//" - unexpected region - FIXME ZOOM"; rcode=1
       IF_NOTOK_RETURN(rcode=1)
    end if


    ! input
    rm  => mass_dat(region)%rm(i1:i2,j1:j2,:,:)
    if ( ntrace_chem > 0 ) rmc => chem_dat(region)%rm(i1:i2,j1:j2,:,:)
    
    m  =>      m_dat(region)%data(i1:i2,j1:j2,:)
    t  => temper_dat(region)%data(i1:i2,j1:j2,:)
    p  =>     sp_dat(region)%data(i1:i2,j1:j2,:)

    ! output
    rmmix    => mmix_dat(region)%rmmix
    std_mmix => mmix_dat(region)%std_mmix
    tempm    => mmix_dat(region)%tempm
    presm    => mmix_dat(region)%presm

    weight = float(ndyn)/float(ndyn_max)

    ! mmix....
    do n=1, ntracet
       rmmix(:,:,:,n) = rmmix(:,:,:,n) + weight*rm(:,:,:,n)/m(:,:,:)
    end do


    ! non-transported tracers, if any
    if ( ntrace_chem > 0 ) then
       do n= ntracet+1, ntracet+ntrace_chem
          rmmix(:,:,:,n) = rmmix(:,:,:,n) + weight*rmc(:,:,:,n-ntracet)/m(:,:,:)
       end do
    end if

    ! stdt deviations
    do n=1,nstd
       itrace = istd(n)
       std_mmix(:,:,:,n) = std_mmix(:,:,:,n) + weight*(rm(:,:,:,itrace)/m(:,:,:))**2
    end do

    ! met fields
    tempm = tempm + weight*t
    presm = presm + weight*p(:,:,1)
    
    w_mmix(region) = w_mmix(region) + weight

    if ( okdebug ) print*, 'accumulate_mmix: region ',region, &
         '; w_mmix',w_mmix(region)

    nullify(m)
    nullify(rm)
    nullify(t)
    nullify(p)
    nullify(rmmix)
    nullify(std_mmix)
    nullify(presm)
    nullify(tempm)
    
    ! ok
    call goLabel(); rcode=0

  END SUBROUTINE ACCUMULATE_MMIX
  !EOC

  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:    WRITE_MMIX
  !
  ! !DESCRIPTION: Write to file mean fields defined in this module, plus all
  !               essential model parameters 
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE WRITE_MMIX( rcode )
    !
    ! !USES:
    !
    use chem_param
#ifdef with_hdf4
    use io_hdf
#endif
    use datetime,      only : tstamp
    use global_data,   only : outdir
    use ParTools,      only : Par_Barrier, isRoot
    use User_Output_Common, only : User_Output_Check_Overwrite
    !
    ! !INPUT/OUTPUT PARAMETERS:
    !
    integer, intent(inout)   ::  rcode
    !
    ! !REVISION HISTORY: 
    !   16 Nov 2011 - P. Le Sager - adapted for lon-lat MPI domain decomposition
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC
    character(len=*), parameter ::  rname = mname//'/write_mmix'

#ifdef with_hdf4
    integer           :: istat, sfsnatt, sfscatt, io, sfstart
    integer           :: sfend
#endif
    integer           :: region
    integer           :: i,j,l,n,k,ind
    !integer,dimension(6) :: 
    character(len=12) :: name
    character(len=200):: FFilename
    
    ! start
    call goLabel( rname )

    REG : do region=nregions,1,-1
       
#ifdef with_hdf4
       IOroot : if ( isRoot ) then

          write (FFilename,'(a,"/mmix_",i4.4,3i2.2,"_",i4.4,3i2.2,"_",a,".hdf")') &
!               trim(outdir), idatei(1:4), idatee(1:4),trim(region_name(region)) 
               trim(outdir), startdate(1:4), idate(1:4),trim(region_name(region)) 

          ! check existence ...
          call User_Output_Check_Overwrite( trim(FFilename), rcode )
          IF_NOTOK_RETURN(rcode=1)

          ! open
          io = sfstart(FFilename,DFACC_CREATE)

          if ( io < 0 ) then
             write (gol,'("While starting mmix file")'); call goErr
             write (gol,'("Filename:",a)') trim(Ffilename); call goErr
             write (gol,'("IIO unit:",i10)') io; call goErr
             write (gol,'("in program")'); call goErr; rcode=1; return
          end if

          !write (gol,'("write_mmix: io unit",i10)') io; call goPr

          istat = sfsnatt(io,'itau',  DFNT_INT32, 1, itau)
          istat = sfsnatt(io,'nregions',  DFNT_INT32, 1, nregions)
          istat = sfscatt(io,'region_name',  DFNT_CHAR, &
               len_trim(region_name(region)), trim(region_name(region)) )
          istat = sfsnatt(io,'im',    DFNT_INT32, 1, im(region))
          istat = sfsnatt(io,'jm',    DFNT_INT32, 1, jm(region))
          istat = sfsnatt(io,'lm',    DFNT_INT32, 1, lm(region))
          istat = sfsnatt(io,'dx',    DFNT_FLOAT64, 1, dx/xref(region))
          istat = sfsnatt(io,'dy',    DFNT_FLOAT64, 1, dy/yref(region))
          istat = sfsnatt(io,'dz',    DFNT_FLOAT64, 1, dz/zref(region))
          istat = sfsnatt(io,'xbeg',  DFNT_INT32, 1, xbeg(region))
          istat = sfsnatt(io,'xend',  DFNT_INT32, 1, xend(region))
          istat = sfsnatt(io,'ybeg',  DFNT_INT32, 1, ybeg(region))
          istat = sfsnatt(io,'yend',  DFNT_INT32, 1, yend(region))
          istat = sfsnatt(io,'zbeg',  DFNT_INT32, 1, zbeg(region))
          istat = sfsnatt(io,'zend',  DFNT_INT32, 1, zend(region))
          if(region/=1) then
             istat = sfsnatt(io,'ibeg',  DFNT_INT32, 1, ibeg(region))
             istat = sfsnatt(io,'iend',  DFNT_INT32, 1, iend(region))
             istat = sfsnatt(io,'jbeg',  DFNT_INT32, 1, jbeg(region))
             istat = sfsnatt(io,'jend',  DFNT_INT32, 1, jend(region))
             istat = sfsnatt(io,'lbeg',  DFNT_INT32, 1, lbeg(region))
             istat = sfsnatt(io,'lend',  DFNT_INT32, 1, lend(region))
          end if
          istat = sfsnatt(io,'xref',  DFNT_INT32, 1, xref(region))
          istat = sfsnatt(io,'yref',  DFNT_INT32, 1, yref(region))
          istat = sfsnatt(io,'zref',  DFNT_INT32, 1, zref(region))
          istat = sfsnatt(io,'tref',  DFNT_INT32, 1, tref(region))
          istat = sfsnatt(io,'ntrace',DFNT_INT32, 1, ntrace)
          istat = sfsnatt(io,'ntracet',DFNT_INT32, 1, ntracet)
          istat = sfsnatt(io,'nstd',DFNT_INT32, 1, nstd)
          istat = sfsnatt(io,'idate' ,DFNT_INT32, 6, idate)
          istat = sfsnatt(io,'istart',  DFNT_INT32, 1, istart)
          istat = sfsnatt(io,'ndyn_max',  DFNT_INT32, 1, ndyn_max)
          istat = sfsnatt(io,'nconv', DFNT_INT32, 1, nconv)
          istat = sfsnatt(io,'ndiag', DFNT_INT32, 1, ndiag)
          istat = sfsnatt(io,'nchem', DFNT_INT32, 1, nchem)
          istat = sfsnatt(io,'nsrce', DFNT_INT32, 1, nsrce)
          istat = sfsnatt(io,'nread', DFNT_INT32, 1, nread)
          istat = sfsnatt(io,'nwrite',DFNT_INT32, 1, nwrite)
          istat = sfsnatt(io,'ninst', DFNT_INT32, 1, ninst)
          istat = sfsnatt(io,'ncheck',DFNT_INT32, 1, ncheck)
          istat = sfsnatt(io,'ndiff', DFNT_INT32, 1, ndiff)
          istat = sfsnatt(io,'itaui',    DFNT_INT32, 1, itaui)
          istat = sfsnatt(io,'itaue',    DFNT_INT32, 1, itaue)
          istat = sfsnatt(io,'itaut',    DFNT_INT32, 1, itaut)
          istat = sfsnatt(io,'itau0',    DFNT_INT32, 1, itau0)
          istat = sfsnatt(io,'idatei' ,  DFNT_INT32, 6, idatei)
          istat = sfsnatt(io,'idatee' ,  DFNT_INT32, 6, idatee)
          istat = sfsnatt(io,'idatet' ,  DFNT_INT32, 6, idatet)
          istat = sfsnatt(io,'idate0' ,  DFNT_INT32, 6, idate0)
          istat = sfsnatt(io,'icalendo' ,DFNT_INT32, 1, icalendo)
          istat = sfsnatt(io,'iyear0' ,  DFNT_INT32, 1, iyear0)
          istat = sfsnatt(io,'julday0' , DFNT_INT32, 1, julday0)
          istat = sfsnatt(io,'ndiagp1' , DFNT_INT32, 1, ndiagp1)
          istat = sfsnatt(io,'ndiagp2' , DFNT_INT32, 1, ndiagp2)
          istat = sfsnatt(io,'nstep'   , DFNT_INT32, 1, nstep)
          istat = sfsnatt(io,'cpu0'   ,  DFNT_FLOAT64, 1, cpu0)
          istat = sfsnatt(io,'cpu1'   ,  DFNT_FLOAT64, 1, cpu1)
          istat = sfsnatt(io,'ra'     ,  DFNT_FLOAT64, ntracet, ra)
          istat = sfsnatt(io,'fscale' ,  DFNT_FLOAT64, ntrace, fscale)
          istat = sfscatt(io,'names'  ,  DFNT_CHAR, ntrace*tracer_name_len, names)
          istat = sfsnatt(io,'areag'  ,  DFNT_FLOAT64, 1, areag)
          istat = sfsnatt(io,'czeta'  ,  DFNT_FLOAT64, 1, czeta)
          istat = sfsnatt(io,'czetak'  , DFNT_FLOAT64, 1, czetak)
          istat = sfscatt(io,'xlabel'  , DFNT_CHAR, 160, xlabel)
          istat = sfsnatt(io,'istd'    , DFNT_INT32, nstd, istd)
          istat = sfsnatt(io,'newyr'   , DFNT_INT32, 1, newyr)
          istat = sfsnatt(io,'newmonth', DFNT_INT32, 1, newmonth)
          istat = sfsnatt(io,'newday'  , DFNT_INT32, 1, newday)
          istat = sfsnatt(io,'newsrun' , DFNT_INT32, 1, newsrun)
!          istat = sfsnatt(io,'cdebug'  , DFNT_INT32, 1, cdebug)
          istat = sfsnatt(io,'limits'  , DFNT_INT32, 1, limits)
          istat = sfsnatt(io,'nregions'  , DFNT_INT32, 1, nregions)
          istat = sfsnatt(io,'w_mmix'  , DFNT_FLOAT64, 1, w_mmix(region))
          istat = sfsnatt(io,'at'  , DFNT_FLOAT64,lm(1)+1, at)
          istat = sfsnatt(io,'bt'  , DFNT_FLOAT64,lm(1)+1, bt)
#ifdef slopes
#ifndef secmom
          istat = sfscatt(io,'adv_scheme'  , DFNT_CHAR, 5, 'slope')
#else
          istat = sfscatt(io,'adv_scheme'  , DFNT_CHAR, 5, '2nd_m')
#endif
#endif
          istat = sfsnatt(io,'nsplitsteps'  , DFNT_INT32, 1, nsplitsteps)
          istat = sfscatt(io,'splitorder'  , DFNT_CHAR,  nsplitsteps, splitorder)
       end if IOroot
       
       CALL WRITEMMIX_REGION( region, rcode )
       IF_NOTOK_RETURN(rcode=1)

       call par_barrier

       if ( isRoot ) then
          write(gol,'("write mmix: sfend returns",i4)') sfend(io) ; call goPr
       endif
#else
    write (gol,'("not compiled with hdf4")'); call goErr
    TRACEBACK; rcode=1; return
#endif // with_hdf4

    END DO REG

    ! ok
    call goLabel(); rcode=0


  CONTAINS

    !------------------------------------------------------------------------
    !                    TM5                                                !
    !------------------------------------------------------------------------
    !BOP
    !
    ! !IROUTINE:    WRITEMMIX_REGION
    !
    ! !DESCRIPTION: Write to file mean fields defined in this module
    !\\
    !\\
    ! !INTERFACE:
    !
    SUBROUTINE WRITEMMIX_REGION( region, rcode ) 
      !
      ! !USES:
      !
      use global_data,   only : region_dat
      use tm5_distgrid,  only : dgrid, Get_DistGrid, gather
      use ParTools,      only : isRoot
      !
      ! !INPUT PARAMETERS:
      !
      integer,intent(in)      :: region
      !
      ! !INPUT/OUTPUT PARAMETERS:
      !
      integer, intent(inout)  :: rcode
      !
      ! !REVISION HISTORY: 
      !   17 Nov 2011 - P. Le Sager - adapted for lon-lat MPI domain decomposition
      !
      ! !REMARKS:
      !
      !EOP
      !---------------------------------------------------------------------
      !BOC
      character(len=*), parameter ::  rname = mname//'/write_mmix_region'

      real,dimension(:,:,:,:),pointer        :: rmmix, std_mmix
      real,dimension(:,:,:)  ,pointer        :: tempm
      real,dimension(:,:)    ,pointer        :: presm
      real,dimension(:,:,:,:),allocatable    :: rmmix_glb
      real,dimension(:,:,:,:),allocatable    :: std_mmix_glb
      integer :: imr, jmr, lmr, nsend, i1, i2, j1, j2, n
      real    :: ahelp,ahelp1

      ! start
      call goLabel( rname )

#ifdef with_hdf4

      ! global and local indices
      imr = im(region)
      jmr = jm(region)
      lmr = lm(region)
      call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
      
      ! array to gather data
      if (isRoot) then 
         allocate(   rmmix_glb(imr,jmr,lmr,ntrace) )
         allocate(std_mmix_glb(imr,jmr,lmr,nstd)   )
      else
         allocate(   rmmix_glb(1,1,1,1) )
         allocate(std_mmix_glb(1,1,1,1) )
      end if

      ! shortcut
      rmmix    => mmix_dat(region)%rmmix
      std_mmix => mmix_dat(region)%std_mmix
      tempm    => mmix_dat(region)%tempm
      presm    => mmix_dat(region)%presm

      ! 
      !write(gol,'("writemmix_region: w_mmix",f12.2)') w_mmix(region); call goPr      
      if ( w_mmix(region) > 2 ) then

         ! scale stdt deviation tracers
         do k= 1,nstd
         do l= 1,lmr
         do j=j1,j2
         do i=i1,i2
            
            n = istd(k)
            ahelp = rmmix(i,j,l,n)

            ahelp1= fscale(n) * &
                 (std_mmix(i,j,l,k) - ahelp*ahelp/w_mmix(region) ) / &
                 (w_mmix(region)-1)

            std_mmix(i,j,l,k)=max(1e-35,ahelp1)

         end do
         end do
         end do
         end do

         ! scale tracers
         do n=1,ntrace
            rmmix(:,:,:,n) = fscale(n) * rmmix(:,:,:,n)/w_mmix(region)
         end do

         ! scale temperature and pressure
         tempm = tempm/w_mmix(region)
         presm = presm/w_mmix(region)

         ! GATHER AND WRITE METEO
         call gather(dgrid(region), tempm, rmmix_glb(:,:,:,1), 0, rcode)         
         IF_NOTOK_RETURN(rcode=1)
         
         if (isRoot) then
            call io_write3d_32d(io,imr,'LON'//trim(region_name(region)), &
                 jmr,'LAT'//trim(region_name(region)),lmr, &
                 'HYBRID',rmmix_glb(1:imr,1:jmr,1:lmr,1),'tempm',idate)
         end if
         
         call gather(dgrid(region), presm, rmmix_glb(:,:,1,1), 0, rcode)
         IF_NOTOK_RETURN(rcode=1)
         
         if (isRoot) then
            call io_write2d_32d(io,imr,'LON'//trim(region_name(region)), &
                 jmr,'LAT'//trim(region_name(region)), &
                 rmmix_glb(1:imr,1:jmr,1,1),'presm',idate)
         end if
         
         ! gather & write mmix
         call gather(dgrid(region), rmmix, rmmix_glb, 0, rcode)
         IF_NOTOK_RETURN(rcode=1)

         if (isRoot) then
            do n=1,ntrace
               name=names(n)
               call io_write3d_32d(io,imr,'LON'//trim(region_name(region)), &
                    jmr,'LAT'//trim(region_name(region)),lmr,'HYBRID', &
                    rmmix_glb(1:imr,1:jmr,1:lmr,n),name,idate)
            end do
         end if

         ! gather and write stdt dev
         call gather(dgrid(region), std_mmix, std_mmix_glb, 0, rcode)
         IF_NOTOK_RETURN(rcode=1)
         
         if (isRoot) then
            do k=1,nstd
               n = istd(k)
               name = 'std_'//names(n)
               call io_write3d_32d(io,imr,'LON'//trim(region_name(region)), &
                    jmr,'LAT'//trim(region_name(region)),lmr,'HYBRID', &
                    std_mmix_glb(1:imr,1:jmr,1:lmr,k),name,idate)
            end do
         end if

      else
         write(gol,'("writemmix_region: NO WRITING! just avoided division by zero!")') ; call goPr
      end if
      
      
      deallocate(rmmix_glb)
      deallocate(std_mmix_glb)
      nullify(rmmix)
      nullify(std_mmix)
      nullify(tempm)
      nullify(presm)
#else
      write (gol,'("not compiled with hdf4")'); call goErr
      TRACEBACK; rcode=1; return
#endif // with_hdf4

      ! ok
      call goLabel(); rcode=0

    END SUBROUTINE WRITEMMIX_REGION
    !EOC

  END SUBROUTINE WRITE_MMIX
  !EOC

END MODULE USER_OUTPUT_MMIX