scale_monitor.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_monitor
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedures
  !
  public :: monitor_setup
  public :: monitor_set_dim
  public :: monitor_reg
  public :: monitor_put
  public :: monitor_in
  public :: monitor_write
  public :: monitor_finalize

  interface monitor_in
     module procedure monitor_in_2d
     module procedure monitor_in_3d
  end interface monitor_in

  interface monitor_put
     module procedure monitor_put_2d
     module procedure monitor_put_3d
  end interface monitor_put

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  private :: monitor_writeheader

  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  integer                :: monitor_fid = -1

  character(len=H_LONG)  :: monitor_out_basename  = 'monitor'
  logical                :: monitor_usedevation   = .true.    
  integer                :: monitor_step_interval = 1

  real(DP)               :: monitor_dt

  integer, parameter     :: monitor_req_max = 1000
  integer                :: monitor_nreqs   = 0
  character(len=H_SHORT) :: monitor_reqs(monitor_req_max)

  type item
     character(len=H_SHORT) :: name
     character(len=H_MID)   :: desc
     character(len=H_SHORT) :: unit
     real(DP)               :: var
     real(DP)               :: var0
     logical                :: first
     logical                :: flux
     integer                :: dimid
  end type item
  integer                 :: monitor_nitems = 0
  type(item), allocatable :: monitor_items(:)

  type dim_type
     character(len=H_SHORT) :: name
     integer                :: ka, ks, ke
     integer                :: ia, is, ie
     integer                :: ja, js, je
     integer                :: dim_size
     real(RP), allocatable  :: area(:,:)
     real(RP)               :: total_area
     real(RP), allocatable  :: volume(:,:,:)
     real(RP)               :: total_volume
  end type dim_type
  integer, parameter :: monitor_dim_max = 30
  integer            :: monitor_ndims = 0
  type(dim_type)     :: monitor_dims(monitor_dim_max)

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine monitor_setup( dt )
    use scale_prc, only: &
       prc_abort
    implicit none

    real(DP), intent(in) :: dt

    namelist / param_monitor / &
       monitor_out_basename, &
       monitor_usedevation,  &
       monitor_step_interval

    character(len=H_SHORT) :: NAME

    namelist / monitor_item / &
       name

    integer :: ierr
    integer :: n
    !---------------------------------------------------------------------------

    log_newline
    log_info("MONITOR_setup",*) 'Setup'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_monitor,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info('MONITOR_setup',*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error('MONITOR_setup',*) 'Not appropriate names in namelist PARAM_MONITOR. Check!'
       call prc_abort
    endif
    log_nml(param_monitor)

    ! listup monitor request
    rewind(io_fid_conf)
    do n = 1, monitor_req_max
       read(io_fid_conf,nml=monitor_item,iostat=ierr)
       if( ierr /= 0 ) exit
    enddo
    monitor_nreqs = n - 1

    if    ( monitor_nreqs > monitor_req_max ) then
       log_error('MONITOR_setup',*) 'request of monitor file is exceed! n >', monitor_req_max
       call prc_abort
    elseif( monitor_nreqs == 0 ) then
       log_info('MONITOR_setup',*) 'No monitor file specified.'
       return
    else
       log_info('MONITOR_setup',*) 'Number of requested monitor item : ', monitor_nreqs
       log_info('MONITOR_setup',*) 'Monitor output interval   [step] : ', monitor_step_interval
       log_info('MONITOR_setup',*) 'Use deviation from first step?   : ', monitor_usedevation
    endif

    allocate( monitor_items(monitor_nreqs) )

    rewind(io_fid_conf)
    do n = 1, monitor_nreqs
       ! set default
       name  = 'unknown'

       read(io_fid_conf,nml=monitor_item,iostat=ierr)
       if( ierr /= 0 ) exit

       if ( io_fid_nml /= io_fid_log ) then
          log_nml(monitor_item)
       end if

       monitor_reqs(n) = name
    enddo


    monitor_dt = dt

    return
  end subroutine monitor_setup

  !-----------------------------------------------------------------------------
  subroutine monitor_set_dim( &
       KA, KS, KE, IA, IS, IE, JA, JS, JE, &
       dim_type, dim_size, &
       area, total_area, &
       volume, total_volume )
    integer, intent(in) :: KA, KS, KE
    integer, intent(in) :: IA, IS, IE
    integer, intent(in) :: JA, JS, JE

    character(len=*), intent(in) :: dim_type
    integer,          intent(in) :: dim_size
    real(RP),         intent(in), optional :: area(ia,ja)
    real(RP),         intent(in), optional :: total_area
    real(RP),         intent(in), optional :: volume(ka,ia,ja)
    real(RP),         intent(in), optional :: total_volume

    integer :: n

    monitor_ndims = monitor_ndims + 1
    n = monitor_ndims

    monitor_dims(n)%name = dim_type
    monitor_dims(n)%dim_size = dim_size

    monitor_dims(n)%KA = ka
    monitor_dims(n)%KS = ks
    monitor_dims(n)%KE = ke
    monitor_dims(n)%IA = ia
    monitor_dims(n)%IS = is
    monitor_dims(n)%IE = ie
    monitor_dims(n)%JA = ja
    monitor_dims(n)%JS = js
    monitor_dims(n)%JE = je

    if ( dim_size >= 2 ) then
       allocate( monitor_dims(n)%area(ia,ja) )
       monitor_dims(n)%area(:,:) = area(:,:)
       monitor_dims(n)%total_area = total_area
    end if

    if ( dim_size >= 3 ) then
       allocate( monitor_dims(n)%volume(ka,ia,ja) )
       monitor_dims(n)%volume(:,:,:) = volume(:,:,:)
       monitor_dims(n)%total_volume = total_volume
    end if

    return
  end subroutine monitor_set_dim

  !-----------------------------------------------------------------------------
  subroutine monitor_reg( &
       name, desc, unit, &
       itemid,           &
       ndims, dim_type,  &
       isflux            )
    use scale_prc, only: &
       prc_abort
    implicit none

    character(len=*), intent(in)  :: name
    character(len=*), intent(in)  :: desc
    character(len=*), intent(in)  :: unit

    integer, intent(out) :: itemid

    integer,          intent(in), optional :: ndims
    character(len=*), intent(in), optional :: dim_type
    logical,          intent(in), optional :: isflux

    integer :: n, reqid, dimid
    !---------------------------------------------------------------------------

    !--- search existing item
    do itemid = 1, monitor_nitems
       if ( name == monitor_items(itemid)%name ) return ! match existing item
    enddo

    do reqid = 1, monitor_nreqs
       if ( name == monitor_reqs(reqid) ) then
          monitor_nitems = monitor_nitems + 1
          itemid = monitor_nitems

          ! new file registration
          monitor_items(itemid)%name = name
          monitor_items(itemid)%desc = desc
          monitor_items(itemid)%unit = unit

          dimid = -1
          if ( present(dim_type) ) then
             do n = 1, monitor_ndims
                if ( monitor_dims(n)%name == dim_type ) then
                   dimid = n
                   exit
                end if
             end do
             if ( dimid < 0 ) then
                log_error('MONITOR_reg',*) 'dim_type (', trim(dim_type), ') must be registerd by MONITOR_set_dim'
                call prc_abort
             end if
          else if ( present(ndims) ) then
             do n = 1, monitor_ndims
                if ( monitor_dims(n)%dim_size == ndims ) then
                   dimid = n
                   exit
                end if
             end do
             if ( dimid == -1 ) then
                log_error('MONITOR_reg','(a,i1,a)') 'dim_type of ', ndims, 'D must be registerd with MONITOR_set_dim'
                call prc_abort
             end if
          else
             ! ndims = 3 is assumed as default
             do n = 1, monitor_ndims
                if ( monitor_dims(n)%dim_size == 3 ) then
                   dimid = n
                   exit
                end if
             end do
             if ( dimid == -1 ) then
                log_error('MONITOR_reg',*) 'dim_type or ndims must be specified'
                call prc_abort
             end if
          end if

          monitor_items(itemid)%dimid = dimid

          monitor_items(itemid)%var   = 0.0_dp
          monitor_items(itemid)%var0  = 0.0_dp
          monitor_items(itemid)%first = .true.
          if ( present(isflux) ) then
             monitor_items(itemid)%flux  = isflux
          else
             monitor_items(itemid)%flux  = .false.
          end if

          log_newline
          log_info('MONOTOR_reg','(A,I3)') ' Item registration No.= ', itemid
          log_info_cont(*) 'Name            : ', trim(monitor_items(itemid)%name)
          log_info_cont(*) 'Description     : ', trim(monitor_items(itemid)%desc)
          log_info_cont(*) 'Unit            : ', trim(monitor_items(itemid)%unit)
          log_info_cont(*) 'Dimension type  : ', trim(monitor_dims(monitor_items(itemid)%dimid)%name)
          log_info_cont(*) 'Integ. with dt? : ', monitor_items(itemid)%flux

          return
       end if
    end do

    itemid = -1 ! not found

    return
  end subroutine monitor_reg

  !-----------------------------------------------------------------------------
  subroutine monitor_put_2d( &
      itemid, var )
    use scale_statistics, only: &
       statistics_total
    implicit none
    integer,  intent(in) :: itemid
    real(RP), intent(in) :: var(:,:)

    integer :: dimid
    real(DP) :: total
    !---------------------------------------------------------------------------

    if( itemid <= 0 ) return

    dimid = monitor_items(itemid)%dimid

    call statistics_total( monitor_dims(dimid)%IA, monitor_dims(dimid)%IS, monitor_dims(dimid)%IE, &
                           monitor_dims(dimid)%JA, monitor_dims(dimid)%JS, monitor_dims(dimid)%JE, &
                           var(:,:), monitor_items(itemid)%name,                          & ! (in)
                           monitor_dims(dimid)%area(:,:), monitor_dims(dimid)%total_area, & ! (in)
                           log_suppress = .true.,                                         & ! (in)
                           sum = total                                                    ) ! (out)

    if ( monitor_items(itemid)%flux ) then
       if ( monitor_items(itemid)%first ) then
          monitor_items(itemid)%var = total * monitor_dt ! first put
          monitor_items(itemid)%first = .false.
       else
          monitor_items(itemid)%var = monitor_items(itemid)%var + total * monitor_dt ! integrate by last put
       endif
    else
       if ( monitor_usedevation ) then
          if ( monitor_items(itemid)%first ) then
             monitor_items(itemid)%var  = 0.0_rp
             monitor_items(itemid)%var0 = total
             monitor_items(itemid)%first = .false.
          else
             monitor_items(itemid)%var = total - monitor_items(itemid)%var0 ! overwrite by last put
          endif
       else
          monitor_items(itemid)%var = total ! overwrite by last put
       endif
    endif

    return
  end subroutine monitor_put_2d

  !-----------------------------------------------------------------------------
  subroutine monitor_put_3d( &
      itemid, var )
    use scale_statistics, only: &
       statistics_total
    implicit none

    integer,  intent(in) :: itemid
    real(RP), intent(in) :: var(:,:,:)

    integer :: dimid

    real(DP) :: total
    !---------------------------------------------------------------------------

    if( itemid <= 0 ) return

    dimid = monitor_items(itemid)%dimid


    call statistics_total( monitor_dims(dimid)%KA, monitor_dims(dimid)%KS, monitor_dims(dimid)%KE, &
                           monitor_dims(dimid)%IA, monitor_dims(dimid)%IS, monitor_dims(dimid)%IE, &
                           monitor_dims(dimid)%JA, monitor_dims(dimid)%JS, monitor_dims(dimid)%JE, &
                           var(:,:,:), monitor_items(itemid)%name,                              & ! (in)
                           monitor_dims(dimid)%volume(:,:,:), monitor_dims(dimid)%total_volume, & ! (in)
                           log_suppress = .true.,                                               & ! (in)
                           sum = total                                                          ) ! (out)

    if ( monitor_items(itemid)%flux ) then
       if ( monitor_items(itemid)%first ) then
          monitor_items(itemid)%var   = total * monitor_dt ! first put
          monitor_items(itemid)%first = .false.
       else
          monitor_items(itemid)%var = monitor_items(itemid)%var + total * monitor_dt ! integrate by last put
       endif
    else
       if ( monitor_usedevation ) then
          if ( monitor_items(itemid)%first ) then
             monitor_items(itemid)%var   = 0.0_rp
             monitor_items(itemid)%var0  = total
             monitor_items(itemid)%first = .false.
          else
             monitor_items(itemid)%var = total - monitor_items(itemid)%var0 ! overwrite by last put
          endif
       else
          monitor_items(itemid)%var = total ! overwrite by last put
       endif
    endif

    return
  end subroutine monitor_put_3d

  !-----------------------------------------------------------------------------
  subroutine monitor_in_2d( &
      var,              &
      name, desc, unit, &
      ndims, dim_type,  &
      isflux            )
    implicit none

    real(RP),         intent(in) :: var(:,:)
    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: unit

    integer,          intent(in), optional :: ndims
    character(len=*), intent(in), optional :: dim_type
    logical,          intent(in), optional :: isflux

    integer :: itemid
    !---------------------------------------------------------------------------

    call monitor_reg( name, desc, unit,               & ! (in)
                    itemid,                         & ! (out)
                    ndims=ndims, dim_type=dim_type, & ! (in)
                    isflux=isflux                   ) ! (in)
    call monitor_put( itemid, var(:,:) )

    return
  end subroutine monitor_in_2d

  !-----------------------------------------------------------------------------
  subroutine monitor_in_3d( &
      var,              &
      name, desc, unit, &
      ndims, dim_type,  &
      isflux            )
    implicit none

    real(RP),         intent(in) :: var(:,:,:)
    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: unit

    integer,          intent(in), optional :: ndims
    character(len=*), intent(in), optional :: dim_type
    logical,          intent(in), optional :: isflux

    integer :: itemid
    !---------------------------------------------------------------------------

    call monitor_reg( name, desc, unit,               & ! (in)
                    itemid,                         & ! (out)
                    ndims=ndims, dim_type=dim_type, & ! (in)
                    isflux=isflux                   ) ! (in)
    call monitor_put( itemid, var(:,:,:) )

    return
  end subroutine monitor_in_3d

  !-----------------------------------------------------------------------------
  subroutine monitor_write( memo, nowstep )
    implicit none
    character(len=*), intent(in) :: memo
    integer         , intent(in) :: nowstep

    logical, save :: firsttime = .true.

    integer :: n
    !---------------------------------------------------------------------------

    if( monitor_nitems == 0 ) return

    call prof_rapstart('FILE_O_ASCII', 2)

    if (firsttime) then
       firsttime = .false.
       call monitor_writeheader
    endif

    if ( monitor_fid > 0 ) then

       if ( mod(nowstep-1,monitor_step_interval) == 0 ) then
          log_progress(*) 'output monitor'

          write(monitor_fid,'(A,i7,A,A4,A)',advance='no') 'STEP=',nowstep,' (',memo,')'
          do n = 1, monitor_nitems
             write(monitor_fid,'(A,ES15.8)',advance='no') ' ', monitor_items(n)%var
          enddo
          write(monitor_fid,*)
       endif

    endif

    call prof_rapend  ('FILE_O_ASCII', 2)

    return
  end subroutine monitor_write

  !-----------------------------------------------------------------------------
  subroutine monitor_writeheader
    use scale_prc, only: &
       prc_abort, &
       prc_myrank, &
       prc_ismaster
    implicit none

    character(len=H_LONG) :: fname

    logical :: MONITOR_L
    integer :: ierr
    integer :: n
    !---------------------------------------------------------------------------

    log_newline
    log_info('MONITOR_writeheader',*) 'Output item list '
    log_info_cont(*) 'Number of monitor item :', monitor_nreqs
    log_info_cont('(2A)') 'NAME                   :description                                    ', &
                          ':UNIT           :dimension_type'
    log_info_cont('(2A)') '=======================================================================', &
                          '==============================='
    do n = 1, monitor_nitems
       log_info_cont('(A24,A48,A16,A16)') monitor_items(n)%name, monitor_items(n)%desc, monitor_items(n)%unit, monitor_dims(monitor_items(n)%dimid)%name
    enddo
    log_info_cont('(2A)') '=======================================================================', &
                          '==============================='

    if ( prc_ismaster ) then ! master node
       monitor_l = .true.
    else
       monitor_l = io_log_allnode
    endif

    if ( monitor_l ) then

       !--- Open logfile
       monitor_fid = io_get_available_fid()
       call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)
       open( unit   = monitor_fid,  &
             file   = trim(fname),  &
             form   = 'formatted',  &
             iostat = ierr          )
       if ( ierr /= 0 ) then
          log_error('MONITOR_writeheader',*) 'File open error! :', trim(fname)
          call prc_abort
       endif

       log_newline
       log_info('MONITOR_writeheader',*) 'Open ASCII file for monitor, name : ', trim(fname)

       write(monitor_fid,'(A)',advance='no') '                   '
       do n = 1, monitor_nitems
          write(monitor_fid,'(A16)',advance='no') monitor_items(n)%name
       enddo
       write(monitor_fid,*)

    endif

    return
  end subroutine monitor_writeheader

  !-----------------------------------------------------------------------------
  subroutine monitor_finalize
    use scale_prc, only: &
       prc_myrank
    implicit none

    character(len=H_LONG) :: fname

    integer :: n
    !---------------------------------------------------------------------------

    if ( monitor_fid > 0 ) then
       call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)

       log_newline
       log_info('MONITOR_finalize',*) 'Close ASCII file for monitor, name : ', trim(fname)

       close(monitor_fid)
    endif

    do n = 1, monitor_ndims
       if ( monitor_dims(n)%dim_size >= 2 ) deallocate( monitor_dims(n)%area )
       if ( monitor_dims(n)%dim_size >= 3 ) deallocate( monitor_dims(n)%volume )
    end do
    monitor_ndims = 0

    if ( allocated(monitor_items) ) deallocate( monitor_items )
    monitor_nitems = 0

    return
  end subroutine monitor_finalize

end module scale_monitor