scale_tracer.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_tracer
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: tracer_regist

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  integer, public :: qa = 0

  integer, private, parameter :: qa_max = 1024

  real(RP),               public :: tracer_cp  (qa_max)
  real(RP),               public :: tracer_cv  (qa_max)
  real(RP),               public :: tracer_r   (qa_max)
  real(RP),               public :: tracer_mass(qa_max)
  logical,                public :: tracer_advc(qa_max)
  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)

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine tracer_regist(  &
       QS,                   &
       NQ, NAME, DESC, UNIT, &
       CV, CP, R, ADVC, MASS )
    use scale_process, only: &
      prc_mpistop
    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)
    logical,          intent(in), optional :: advc(nq)
    logical,          intent(in), optional :: mass(nq)

    real(RP) :: cv_  (nq)
    real(RP) :: cp_  (nq)
    real(RP) :: r_   (nq)
    logical  :: advc_(nq)
    logical  :: mass_(nq)

    character(len=24) :: name_trim

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

    if ( qa + nq > qa_max ) then
       write(*,*) 'xxx total number of tracer must be less or equal to ', qa_max
       call prc_mpistop
    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(advc) ) then
       advc_(:) = advc(:)
    else
       advc_(:) = .true.
    end if

    if ( present(mass) ) then
       mass_(:) = mass(:)
    else
       mass_(:) = .false.
    end if

    if( io_l ) write(io_fid_log,*)
    do n = 1, nq

       name_trim = trim(name(n))

       if( io_l ) write(io_fid_log,'(1x,A,I3,A,A,A,F6.1,A,F6.1,A,L1,A,L1)') &
                                      '] Register tracer : No.', qa+n,      &
                                                    ', NAME = ', name_trim, &
                                                      ', CV = ', cv_(n),  &
                                                      ', CP = ', cp_(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_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

    return
  end subroutine tracer_regist

end module scale_tracer