scale_atmos_phy_mp_convert Module Reference

module ATMOSPHERE / Physics Cloud Microphysics - Convert More...

Functions/Subroutines
subroutine, public	atmos_phy_mp_bulk2bin (xs, xe, ys, ye, dims, it, rank, handle, basename_org, dens_org, qtrc_org)
	Bulk to Bin. More...
subroutine, public	atmos_phy_mp_bin2bulk
	Bin to Bulk. More...

Detailed Description

module ATMOSPHERE / Physics Cloud Microphysics - Convert

Description

Convert module for Cloud Microphysics Bulk to Bin, and Bin to Bulk

Author

Team SCALE

History

• 2015-01-20 (Y.Sato) [new]

NAMELIST

• PARAM_ATMOS_PHY_MP_BIN2BULK

  name	type	default value	comment
  SIGMA_SDF	real(RP)
  R0_SDF	real(RP)
  N0_SDF	real(RP)
  RHO_SDF	real(RP)
  MP_TYPE_OUTER	character(LEN=16)	"NONE"
  MP_TYPE_INNER	character(LEN=16)	"NONE"

  
  

History Output

No history output

Function/Subroutine Documentation

atmos_phy_mp_bulk2bin()

subroutine, public scale_atmos_phy_mp_convert::atmos_phy_mp_bulk2bin	(	integer, intent(in)	xs,
		integer, intent(in)	xe,
		integer, intent(in)	ys,
		integer, intent(in)	ye,
		integer, dimension(:), intent(in)	dims,
		integer, intent(in)	it,
		integer, intent(in)	rank,
		integer, intent(in)	handle,
		character(len=*), intent(in)	basename_org,
		real(rp), dimension(:,:,:), intent(in)	dens_org,
		real(rp), dimension(:,:,:,:), intent(inout)	qtrc_org
	)

Bulk to Bin.

Definition at line 88 of file scale_atmos_phy_mp_convert.F90.

References scale_tracer::aq_name, scale_tracer::i_qc, scale_tracer::i_qg, scale_tracer::i_qi, scale_tracer::i_qr, scale_tracer::i_qs, scale_tracer::i_qv, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_get_available_fid(), scale_stdio::io_l, scale_stdio::io_lnml, dc_log::log(), scale_grid_nest::parent_imax, scale_grid_nest::parent_jmax, scale_process::prc_mpistop(), scale_tracer::qa, and scale_specfunc::sf_gamma().

Referenced by mod_realinput_scale::parentatominputscale().

    use scale_grid_nest, only: &
       parent_imax,     &
       parent_jmax
    use scale_specfunc, only: &
       sf_gamma
    use gtool_file, only: &
       fileread
    implicit none

    integer,          intent(in) :: xs, xe
    integer,          intent(in) :: ys, ye
    integer,          intent(in) :: dims(:)
    integer,          intent(in) :: it
    integer,          intent(in) :: rank
    integer,          intent(in) :: handle
    character(LEN=*), intent(in) :: basename_org
    real(RP),         intent(in) :: dens_org(:,:,:)
    real(RP),         intent(inout) :: qtrc_org(:,:,:,:)
!    real(RP),         intent(in) :: dens_org(dims(1)+2,dims(2),dims(3))
!    real(RP),         intent(inout) :: qtrc_org(dims(1)+2,dims(2),dims(3),11)

    real(RP)         :: sigma_sdf(4)
    real(RP)         :: r0_sdf(4)
    real(RP)         :: n0_sdf(4)
    real(RP)         :: rho_sdf(4)
    character(LEN=11),parameter :: fname_micpara="micpara.dat"
    character(LEN=16) :: mp_type_outer = "NONE"
    character(LEN=16) :: mp_type_inner = "NONE"
    integer :: comm_world

    namelist / param_atmos_phy_mp_bin2bulk / &
       sigma_sdf, &
       r0_sdf,    &
       n0_sdf,    &
       rho_sdf,   &
       mp_type_outer, &
       mp_type_inner

    real(RP), allocatable :: read3di(:,:,:)
    real(RP), allocatable :: qtrc_tmp(:,:,:,:)

    integer  :: fid_micpara
    real(RP) :: coef0, coef1, coef2
    real(RP) :: tmp_hyd, n_hyd, lambda_hyd
    real(RP) :: dummy( nbin ), radc( nbin ) 
    integer  :: k, i, j, iq, ierr
    integer  :: nnbin, nnspc, nn
    !---------------------------------------------------------------------------

    !--- define coefficients
    coef0 = 4.0_rp/3.0_rp*pi
    coef1 = 4.0_rp/3.0_rp*sqrt(pi/2.0_rp)

    !--- determine the parameters for interpolating SDF from qxx, Nxx of parent domain
    sigma_sdf(1) = 0.2_rp
    sigma_sdf(2) = 0.35_rp
    sigma_sdf(3) = 0.35_rp
    sigma_sdf(4) = 0.35_rp
    r0_sdf(1)    = 5.e-6_rp
    r0_sdf(2)    = 2.61e-6_rp
    r0_sdf(3)    = 5.e-6_rp
    r0_sdf(4)    = 2.61e-6_rp
    n0_sdf(1)    = 8.0e+6_rp
    n0_sdf(2)    = 0.0_rp
    n0_sdf(3)    = 3.0e+6_rp
    n0_sdf(4)    = 4.0e+6_rp
    rho_sdf(1)   = dwatr
    rho_sdf(2)   = dice
    rho_sdf(3)   = 100.0_rp
    rho_sdf(4)   = 400.0_rp

    !---- initiate 
    allocate( read3di( parent_imax(handle), parent_jmax(handle), dims(1) ) )
    allocate( qtrc_tmp(dims(1)+2,dims(2),dims(3),11) )

    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_mp_bin2bulk,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) 'xxx Not found namelist. Check!'
       call prc_mpistop
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_MP_BIN2BULK. Check!'
       call prc_mpistop
    endif
    if( io_lnml ) write(io_fid_log,nml=param_atmos_phy_mp_bin2bulk)

    if( trim(mp_type_inner) /= "SUZUKI10" ) then
       write(*,*) 'xxx MP_TYPE_INNER should be SUZUKI10 Check!'
       write(*,*) 'Now MP_TYPE_INNER set as ', mp_type_inner
       call prc_mpistop
    endif

    !--- read micpara.dat (microphysical parameter) and broad cast
    fid_micpara = io_get_available_fid()
    !--- open parameter of cloud microphysics
    open ( fid_micpara, file = fname_micpara, form = 'formatted', status = 'old', iostat=ierr )

    !--- micpara.dat does not exist
    if( ierr == 0 ) then

      read( fid_micpara,* ) nnspc, nnbin

      if( nnbin /= nbin ) then
         write(*,*) 'xxx nbin in inc_tracer and nbin in micpara.dat is different check!'
         call prc_mpistop
      end if

      ! grid parameter
      if( io_l ) write(io_fid_log,*)  '*** Radius of cloud ****'
      do iq = 1, nbin
        read( fid_micpara,* ) nn, dummy( iq ), radc( iq )
        if( io_l ) write(io_fid_log,'(a,1x,i3,1x,a,1x,e15.7,1x,a)') &
                  "Radius of ", iq, "th cloud bin (bin center)= ", radc( iq ) , "[m]"
      end do

      close ( fid_micpara )

    else

      write(*,*) 'xxx micpara.dat does not exist. check!'
      call prc_mpistop
      
    endif

    call fileread( read3di(:,:,:), basename_org, "QV", it, rank )
    do k = 1, dims(1)
       qtrc_org(k+2,xs:xe,ys:ye,i_qv) = read3di(:,:,k)
    end do

    if( trim(mp_type_outer) == "KESSLER" ) then

      if( io_l ) write(io_fid_log,*)
      if( io_l ) write(io_fid_log,*) '+++ SDF of Bin model is created from'
      if( io_l ) write(io_fid_log,*) '+++ Kessler type Bulk microphysical model'

       call fileread( read3di(:,:,:), basename_org, "QC", it, rank )
       do k = 1, dims(1)
          qtrc_tmp(k+2,xs:xe,ys:ye,i_qc) = read3di(:,:,k)
       end do
!       do k = 1, dims(1)
!       do i = xs, xe
!       do j = ys, ye
!          qtrc_tmp(k+2,i,j,I_QC) = qtrc_tmp(k+2,i,j,I_QC)*dens_org(k+2,i,j)
!       enddo
!       enddo
!       enddo

       call fileread( read3di(:,:,:), basename_org, "QR", it, rank )
       do k = 1, dims(1)
          qtrc_tmp(k+2,xs:xe,ys:ye,i_qr) = read3di(:,:,k)
       end do
!       do k = 1, dims(1)
!       do i = xs, xe
!       do j = ys, ye
!          qtrc_tmp(k+2,i,j,I_QR) = qtrc_tmp(k+2,i,j,I_QR)*dens_org(k+2,i,j)
!       enddo
!       enddo
!       enddo

       do k = 1, dims(1)
       do i = xs, xe
       do j = ys, ye

         do iq = 1, nbin
            dummy(iq) = coef1 / sigma_sdf(1) * dwatr * radc( iq )**3 &
                      * exp(  &
                            - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
                            / sigma_sdf(1) / sigma_sdf(1) &
                            )
         enddo

         tmp_hyd = 0.0_rp
         do iq = 1, nbin
            tmp_hyd = tmp_hyd + dummy(iq)
         enddo

         coef2 = ( qtrc_tmp(k+2,i,j,i_qc)+qtrc_tmp(k+2,i,j,i_qr) ) &
               / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
         do iq = 1, nbin
           qtrc_org(k+2,i,j,i_qv+iq) = coef2 * dummy(iq)
         enddo

       enddo
       enddo
       enddo

    elseif( trim(mp_type_outer) == "TOMITA08" ) then

       if( io_l ) write(io_fid_log,*)
       if( io_l ) write(io_fid_log,*) '+++ SDF of Bin model is created from'
       if( io_l ) write(io_fid_log,*) '+++ TOMITA08 Bulk microphysical model'

       call fileread( read3di(:,:,:), basename_org, "QC", it, rank )
       do k = 1, dims(1)
          qtrc_tmp(k+2,xs:xe,ys:ye,i_qc) = read3di(:,:,k)
       end do
!       do k = 1, dims(1)
!       do i = xs, xe
!       do j = ys, ye
!          qtrc_tmp(k+2,i,j,I_QC) = qtrc_tmp(k+2,i,j,I_QC)*dens_org(k+2,i,j)
!       enddo
!       enddo
!       enddo
  
       call fileread( read3di(:,:,:), basename_org, "QR", it, rank )
       do k = 1, dims(1)
          qtrc_tmp(k+2,xs:xe,ys:ye,i_qr) = read3di(:,:,k)
       end do
!       do k = 1, dims(1)
!       do i = xs, xe
!       do j = ys, ye
!          qtrc_tmp(k+2,i,j,I_QR) = qtrc_tmp(k+2,i,j,I_QR)*dens_org(k+2,i,j)
!       enddo
!       enddo
!       enddo

       call fileread( read3di(:,:,:), basename_org, "QI", it, rank )
       do k = 1, dims(1)
          qtrc_tmp(k+2,xs:xe,ys:ye,i_qi) = read3di(:,:,k)
       end do
!       do k = 1, dims(1)
!       do i = xs, xe
!       do j = ys, ye
!          qtrc_tmp(k+2,i,j,I_QI) = qtrc_tmp(k+2,i,j,I_QI)*dens_org(k+2,i,j)
!       enddo
!       enddo
!       enddo

       call fileread( read3di(:,:,:), basename_org, "QS", it, rank )
       do k = 1, dims(1)
          qtrc_tmp(k+2,xs:xe,ys:ye,i_qs) = read3di(:,:,k)
       end do
!       do k = 1, dims(1)
!       do i = xs, xe
!       do j = ys, ye
!          qtrc_tmp(k+2,i,j,I_QS) = qtrc_tmp(k+2,i,j,I_QS)*dens_org(k+2,i,j)
!       enddo
!       enddo
!       enddo

       call fileread( read3di(:,:,:), basename_org, "QG", it, rank )
       do k = 1, dims(1)
          qtrc_tmp(k+2,xs:xe,ys:ye,i_qg) = read3di(:,:,k)
       end do
!       do k = 1, dims(1)
!       do i = xs, xe
!       do j = ys, ye
!          qtrc_tmp(k+2,i,j,I_QG) = qtrc_tmp(k+2,i,j,I_QG)*dens_org(k+2,i,j)
!       enddo
!       enddo
!       enddo

       if( nspc == 1 ) then !--- put all hydrometeors to liquid (warm bin)

         do k = 1, dims(1)
         do i = xs, xe
         do j = ys, ye
  
           do iq = 1, nbin
              dummy(iq) = coef1 / sigma_sdf(1) * rho_sdf(1) * radc( iq )**3 &
                        * exp(  &
                              - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
                              / sigma_sdf(1) / sigma_sdf(1) &
                              )
           enddo
  
           tmp_hyd = 0.0_rp
           do iq = 1, nbin
              tmp_hyd = tmp_hyd + dummy(iq)
           enddo
  
           coef2 = ( &
                     qtrc_tmp(k+2,i,j,i_qc)+qtrc_tmp(k+2,i,j,i_qr) &
                   + qtrc_tmp(k+2,i,j,i_qs)+qtrc_tmp(k+2,i,j,i_qi) &
                   + qtrc_tmp(k+2,i,j,i_qg) &
                   ) &
                 / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
           do iq = 1, nbin
             qtrc_org(k+2,i,j,i_qv+(il-1)*nbin+iq) = coef2 * dummy(iq)
           enddo
  
         enddo
         enddo
         enddo

       elseif( nspc == 7 ) then  !--- put each hydrometer to each category (ice bin)

         do k = 1, dims(1)
         do i = xs, xe
         do j = ys, ye

           !--- Rain and Cloud put into liquid bin (log-normal)
           do iq = 1, nbin
              dummy(iq) = coef1 / sigma_sdf(1) * rho_sdf(1) * radc( iq )**3 &
                        * exp(  &
                              - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
                              / sigma_sdf(1) / sigma_sdf(1) &
                              )
           enddo
 
           tmp_hyd = 0.0_rp
           do iq = 1, nbin
              tmp_hyd = tmp_hyd + dummy(iq)
           enddo
 
           coef2 = ( qtrc_tmp(k+2,i,j,i_qc)+qtrc_tmp(k+2,i,j,i_qr) ) &
                 / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
           do iq = 1, nbin
             qtrc_org(k+2,i,j,i_qv+(il-1)*nbin+iq) = coef2 * dummy(iq)
           enddo
 
           !--- Ice put into plate bin (log-normal)
           do iq = 1, nbin
              dummy(iq) = coef1 / sigma_sdf(2) * rho_sdf(2) * radc( iq )**3 &
                        * exp(  &
                              - ( log( radc(iq) )-log( r0_sdf(2) ) )**2*0.5_rp &
                              / sigma_sdf(2) / sigma_sdf(2) &
                              )
           enddo
 
           tmp_hyd = 0.0_rp
           do iq = 1, nbin
              tmp_hyd = tmp_hyd + dummy(iq)
           enddo
 
           coef2 = qtrc_tmp(k+2,i,j,i_qi) &
                 / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
           do iq = 1, nbin
             qtrc_org(k+2,i,j,i_qv+(ip-1)*nbin+iq) = coef2 * dummy(iq)
           enddo

           !--- Snow put into snow bin (gamma)
           n_hyd = coef0 * n0_sdf(3) * rho_sdf(3)
           lambda_hyd = ( pi * rho_sdf(3) / 6.0_rp *n0_sdf(3) * sf_gamma(4.0_rp) &
                      / ( qtrc_tmp(k+2,i,j,i_qs) &
                        + (0.50_rp-sign(0.50_rp,qtrc_tmp(k+2,i,j,i_qs)-eps)) &
                        ) )**(0.25_rp)
           do iq = 1, nbin
              dummy(iq) = n_hyd * radc( iq )**3 &
                        * exp( -lambda_hyd * 0.5_rp * radc( iq ) )
           enddo
           tmp_hyd = 0.0_rp
           do iq = 1, nbin
              tmp_hyd = tmp_hyd + dummy(iq)
           enddo
 
           coef2 = qtrc_tmp(k+2,i,j,i_qs) &
                 / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
           do iq = 1, nbin
             qtrc_org(k+2,i,j,i_qv+(iss-1)*nbin+iq) = coef2 * dummy(iq)
           enddo

           !--- Graupel put into Graupel bin (gamma)
           n_hyd = coef0 * n0_sdf(4) * rho_sdf(4)
           lambda_hyd = ( pi * rho_sdf(4) / 6.0_rp *n0_sdf(4) * sf_gamma(4.0_rp) &
                      / ( qtrc_tmp(k+2,i,j,i_qg) &
                        + (0.50_rp-sign(0.50_rp,qtrc_tmp(k+2,i,j,i_qg)-eps)) &
                        ) )**(0.25_rp)
           do iq = 1, nbin
              dummy(iq) = n_hyd * radc( iq )**3 &
                        * exp( -lambda_hyd * 0.5_rp * radc( iq ) )
           enddo
           tmp_hyd = 0.0_rp
           do iq = 1, nbin
              tmp_hyd = tmp_hyd + dummy(iq)
           enddo
 
           coef2 = qtrc_tmp(k+2,i,j,i_qg) &
                 / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
           do iq = 1, nbin
             qtrc_org(k+2,i,j,i_qv+(ig-1)*nbin+iq) = coef2 * dummy(iq)
           enddo

         enddo
         enddo
         enddo

       endif

    elseif( trim(mp_type_outer) == "SN14" ) then

       write(*,*) 'SN14 is not supported for MP_TYPE_OUTER now'
       write(*,*) 'Please wait'
       call prc_mpistop

    elseif( trim(mp_type_outer) == "SUZUKI10" ) then

      if( io_l ) write(io_fid_log,*)
      if( io_l ) write(io_fid_log,*) '+++ SDF of Bin model is created directory'
      if( io_l ) write(io_fid_log,*) '+++ from Bin microphysical model'
      do iq = 1, qa
         call fileread( read3di(:,:,:), basename_org, aq_name(iq), it, rank )
         do k = 1, dims(1)
            qtrc_org(k+2,xs:xe,ys:ye,iq) = read3di(:,:,k)
         end do
      end do         

    else

       write(*,*) 'MP_TYPE_OUTER should be KESSLER, TOMITA08, or SUZUKI10'
       write(*,*) 'Please check! Now MP_TYPE_OUTER set as ', mp_type_outer
       call prc_mpistop

    endif

    deallocate( read3di )
    deallocate( qtrc_tmp )
    return

Here is the call graph for this function:

Here is the caller graph for this function:

atmos_phy_mp_bin2bulk()

subroutine, public scale_atmos_phy_mp_convert::atmos_phy_mp_bin2bulk

(

)

Bin to Bulk.

Definition at line 501 of file scale_atmos_phy_mp_convert.F90.

    !---------------------------------------------------------------------------

    return