scale_tracer.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_tracer
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: tracer_regist
  public :: tracer_inq_id
  public :: tracer_finalize
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  integer, public :: qa = 0
 
  integer, private, parameter :: qa_max = 1024
 
  character(len=H_SHORT), public :: tracer_name (qa_max)
  character(len=H_MID),   public :: tracer_desc (qa_max)
  character(len=H_SHORT), public :: tracer_unit (qa_max)
  real(rp),               public :: tracer_cv   (qa_max)
  real(rp),               public :: tracer_cp   (qa_max)
  real(rp),               public :: tracer_r    (qa_max)
  real(rp),               public :: tracer_engi0(qa_max)
  logical,                public :: tracer_advc (qa_max)
  real(rp),               public :: tracer_mass (qa_max)
 
  !$acc declare create(QA, TRACER_CV, TRACER_CP, TRACER_R, TRACER_ENGI0, TRACER_ADVC, TRACER_MASS)
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine tracer_regist(  &
       QS,                   &
       NQ, NAME, DESC, UNIT, &
       CV, CP, R, ENGI0,     &
       ADVC, MASS            )
    use scale_prc, only: &
      prc_abort
    implicit none
 
    integer,          intent(out)          :: qs
    integer,          intent(in)           :: nq
    character(len=*), intent(in)           :: name (nq)
    character(len=*), intent(in)           :: desc (nq)
    character(len=*), intent(in)           :: unit (nq)
    real(rp),         intent(in), optional :: cv   (nq)
    real(rp),         intent(in), optional :: cp   (nq)
    real(rp),         intent(in), optional :: r    (nq)
    real(rp),         intent(in), optional :: engi0(nq)
    logical,          intent(in), optional :: advc (nq)
    logical,          intent(in), optional :: mass (nq)
 
    real(rp) :: cv_   (nq)
    real(rp) :: cp_   (nq)
    real(rp) :: r_    (nq)
    real(rp) :: engi0_(nq)
    logical  :: advc_ (nq)
    logical  :: mass_ (nq)
 
    character(len=24) :: name_trim
 
    integer  :: n
    !---------------------------------------------------------------------------
 
    if ( qa + nq > qa_max ) then
       log_error("TRACER_regist",*) 'total number of tracer must be less or equal to ', qa_max
       call prc_abort
    end if
 
    if ( present(cv) ) then
       cv_(:) = cv(:)
    else
       cv_(:) = 0.0_rp
    end if
 
    if ( present(cp) ) then
       cp_(:) = cp(:)
    else
       cp_(:) = 0.0_rp
    end if
 
    if ( present(r) ) then
       r_(:) = r(:)
    else
       r_(:) = 0.0_rp
    end if
 
    if ( present(engi0) ) then
       engi0_(:) = engi0(:)
    else
       engi0_(:) = 0.0_rp
    end if
 
    if ( present(advc) ) then
       advc_(:) = advc(:)
    else
       advc_(:) = .true.
    end if
 
    if ( present(mass) ) then
       mass_(:) = mass(:)
    else
       mass_(:) = .false.
    end if
 
    log_newline
    do n = 1, nq
 
       name_trim = trim(name(n))
 
       log_info("TRACER_regist",'(1x,A,I3,A,A,A,F6.1,A,F6.1,A,ES10.3,A,L1,A,L1)') &
                                      '] Register tracer : No.', qa+n,      &
                                                    ', NAME = ', name_trim, &
                                                      ', CV = ', cv_(n),  &
                                                      ', CP = ', cp_(n),  &
                                                   ', ENGI0 = ', engi0_(n),  &
                                                    ', ADVC = ', advc_(n),  &
                                                    ', MASS = ', mass_(n)
 
       tracer_name(qa+n) = name(n)
       tracer_desc(qa+n) = desc(n)
       tracer_unit(qa+n) = unit(n)
       tracer_cv(qa+n) = cv_(n)
       tracer_cp(qa+n) = cp_(n)
       tracer_r(qa+n) = r_(n)
       tracer_engi0(qa+n) = engi0_(n)
       tracer_advc(qa+n) = advc_(n)
 
       if ( mass_(n) ) then
          tracer_mass(qa+n) = 1.0_rp
       else
          tracer_mass(qa+n) = 0.0_rp
       end if
    end do
 
    qs = qa + 1
    qa = qa + nq
 
    !$acc update device(QA, TRACER_CV(QS:QA), TRACER_CP(QS:QA), TRACER_R(QS:QA), TRACER_ENGI0(QS:QA), TRACER_ADVC(QS:QA), TRACER_MASS(QS:QA))
 
    return
  end subroutine tracer_regist
 
  subroutine tracer_finalize
    qa = 0
 
    return
  end subroutine tracer_finalize
 
  !-----------------------------------------------------------------------------
  subroutine tracer_inq_id( &
       NAME, &
       ID    )
    implicit none
    character(len=*), intent(in)  :: name
    integer,          intent(out) :: id
    integer :: iq
 
    id = -1
    do iq = 1, qa
       if ( name == tracer_name(iq) ) then
          id = iq
          exit
       end if
    end do
 
    return
  end subroutine tracer_inq_id
 
end module scale_tracer