scale_aetracer_kajino13.F90

Go to the documentation of this file.

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

  include "inc_aetracer_kajino13.h"

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine aetracer_kajino13_setup
    use scale_process, only: &
      prc_mpistop
    implicit none

    integer, allocatable :: aero_idx(:,:,:,:)
    integer :: n_kap_max, n_siz_max, ncat_max
    integer :: NASIZ(3), NAKAP(3)
    character(len=H_SHORT) :: attribute, catego, aunit

    namelist / param_tracer_kajino13 / &
       ae_ctg, &
       nasiz,  &
       nakap

    integer :: m, ierr, ik, ic, ia0, is0

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '+++ READ NUMBER of TRACER for Aerosol'

    ncat_max = max( ic_mix, ic_sea, ic_dus )

    nasiz(:) = 64
    nakap(:) = 1

    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_tracer_kajino13,iostat=ierr)

    if( ierr < 0 ) then !--- missing
     if( io_l ) write(io_fid_log,*)  '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
     write(*,*) 'xxx Not appropriate names in namelist PARAM_TRACER_KAJINO13, Check!'
     call prc_mpistop
    end if

    if( io_l ) write(io_fid_log,nml=param_tracer_kajino13)

    if( ae_ctg > ncat_max ) then
     write(*,*) 'xxx AE_CTG should be smaller than', ncat_max+1, 'stop'
     call prc_mpistop
    endif

    allocate( nsiz(ae_ctg) )
    allocate( nkap(ae_ctg) )

    nkap(1:ae_ctg) = nakap(1:ae_ctg)
    nsiz(1:ae_ctg) = nasiz(1:ae_ctg)

    if( maxval( nkap ) /= 1 .OR. minval( nkap ) /= 1 ) then
     write(*,*) 'xxx NKAP(:) /= 1 is not supported now, Stop!'
     call prc_mpistop
    end if

    qa_ae = 0
!    do ia0 = 1, N_ATR
    do ic = 1, ae_ctg
    do ik = 1, nkap(ic)
    do is0 = 1, nsiz(ic)
    do ia0 = 1, n_atr
      qa_ae   = qa_ae + 1
    enddo
    enddo
    enddo
    enddo
    qa_ae = qa_ae + gas_ctg
    allocate( aq_ae_name(qa_ae) )
    allocate( aq_ae_desc(qa_ae) )
    allocate( aq_ae_unit(qa_ae) )

    n_siz_max = 0
    n_kap_max = 0
    do ic = 1, ae_ctg
      n_siz_max = max(n_siz_max, nsiz(ic))
      n_kap_max = max(n_kap_max, nkap(ic))
    enddo

    allocate( aero_idx(n_atr,ae_ctg,n_kap_max,n_siz_max) )
    m = 0
!    do ia0 = 1, N_ATR
    do ic = 1, ae_ctg
    do ik = 1, nkap(ic)
    do is0 = 1, nsiz(ic)
    do ia0 = 1, n_atr
      m = m+1
      aero_idx(ia0,ic,ik,is0) = m
    enddo
    enddo
    enddo
    enddo

    !-----------------------------------------------------------------------------
    !
    !++ calculate each category and aerosol
    !
    !-----------------------------------------------------------------------------
    ic = qa_ae-gas_ctg+ig_h2so4
    write(aq_ae_unit(ic),'(a)')  'kg/kg'
    ic = qa_ae-gas_ctg+ig_cgas
    write(aq_ae_unit(ic),'(a)')  'kg/kg'

!    do ia0 = 1, N_ATR
!      if( ia0 == 1 ) then
!         write(attribute,'(a)') "Number"
!         write(aunit,'(a)') "num/kg"
!      elseif( ia0 == 2 ) then
!         write(attribute,'(a)') "Section"
!         write(aunit,'(a)') "m2/kg"
!      elseif( ia0 == 3 ) then
!         write(attribute,'(a)') "Volume"
!         write(aunit,'(a)') "m3/kg"
!      elseif( ia0 == 4 ) then
!         write(attribute,'(a)') "Mass"
!         write(aunit,'(a)') "kg/kg"
!      elseif( ia0 == 5 ) then
!         write(attribute,'(a)') "kpXmass"
!         write(aunit,'(a)') "kg/kg"
!      endif
    do ic = 1, ae_ctg       !aerosol category
    do ik = 1, nkap(ic)   !kappa bin
    do is0 = 1, nsiz(ic)
    do ia0 = 1, n_atr
      if( ia0 == 1 ) then
         write(attribute,'(a)') "Number"
         write(aunit,'(a)') "num/kg"
      elseif( ia0 == 2 ) then
         write(attribute,'(a)') "Section"
         write(aunit,'(a)') "m2/kg"
      elseif( ia0 == 3 ) then
         write(attribute,'(a)') "Volume"
         write(aunit,'(a)') "m3/kg"
      elseif( ia0 == 4 ) then
         write(attribute,'(a)') "Mass"
         write(aunit,'(a)') "kg/kg"
      elseif( ia0 == 5 ) then
         write(attribute,'(a)') "kXm"
         write(aunit,'(a)') "kg/kg"
      endif
     if( ic == ic_mix ) then
      write(catego,'(a)') "Sulf_"
     elseif( ic == ic_sea ) then
      write(catego,'(a)') "Salt_"
     elseif( ic == ic_dus ) then
      write(catego,'(a)') "Dust_"
     endif
     write(aq_ae_unit(aero_idx(ia0,ic,ik,is0)),'(a)')  trim(aunit)
     write(aq_ae_name(aero_idx(ia0,ic,ik,is0)),'(a,a,i0)') trim(catego), trim(attribute), is0
     write(aq_ae_desc(aero_idx(ia0,ic,ik,is0)),'(a,a,a,i0)') trim(attribute), ' mixing radio of ', trim(catego), is0
    enddo
    enddo
    enddo
    enddo
    ic = qa_ae-gas_ctg+ig_h2so4
    write(aq_ae_name(ic),'(a)') 'H2SO4_Gas'
    ic = qa_ae-gas_ctg+ig_cgas
    write(aq_ae_name(ic),'(a)') 'Condensable_GAS'

    ic = qa_ae-gas_ctg+ig_h2so4
    write(aq_ae_desc(ic),'(a)') 'Mixing ratio of H2SO4 Gas'
    ic = qa_ae-gas_ctg+ig_cgas
    write(aq_ae_desc(ic),'(a)') 'Mixing ratio of Condensable GAS'

    deallocate(aero_idx)

    return
  end subroutine aetracer_kajino13_setup

end module scale_aetracer_kajino13