Implement Intel OneMKL in /src/dynamics/operators_mod.F90: calc_t()

[GrassBlock2016]

  subroutine calc_t(block, dstate)

    type(block_type), intent(in) :: block
    type(dstate_type), intent(inout) :: dstate

    real(r8), allocatable :: phd_pow_rd(:,:,:), rd_o_cpd_vec(:,:,:)

    integer i, j, k

    call perf_start('calc_t')

    associate (mesh => block%mesh         , &
               pt   => dstate%pt          , & ! in
               ph   => dstate%ph          , & ! in
               q    => tracers(block%id)%q, & ! in
               t    => dstate%t           , & ! out
               tv   => dstate%tv          )   ! out

    allocate(phd_pow_rd(mesh%full_ids:mesh%full_ide+1, mesh%full_jds:mesh%full_jde + merge(0, 1, mesh%has_north_pole()), mesh%full_kds:mesh%full_kde))
    allocate(rd_o_cpd_vec(mesh%full_ids:mesh%full_ide+1, mesh%full_jds:mesh%full_jde + merge(0, 1, mesh%has_north_pole()), mesh%full_kds:mesh%full_kde))
    rd_o_cpd_vec = rd_o_cpd
    call vdpow((mesh%full_ide-mesh%full_ids+2)*(mesh%full_jde+merge(0, 1, mesh%has_north_pole())-mesh%full_ids+1)*(mesh%full_kde-mesh%full_kds+1), ph%d, rd_o_cpd_vec, phd_pow_rd)

    if (idx_qv > 0) then
      do k = mesh%full_kds, mesh%full_kde
        do j = mesh%full_jds, mesh%full_jde + merge(0, 1, mesh%has_north_pole())
          do i = mesh%full_ids, mesh%full_ide - 1, 2
            t%d(i,j,k) = temperature(pt%d(i,j,k), ph%d(i,j,k), q%d(i,j,k,idx_qv))
            tv%d(i,j,k) = virtual_temperature_from_modified_potential_temperature(pt%d(i,j,k), phd_pow_rd(i,j,k), q%d(i,j,k,idx_qv))
            ! tv%d(i,j,k) = virtual_temperature_from_modified_potential_temperature(pt%d(i,j,k), ph%d(i,j,k)**rd_o_cpd, q%d(i,j,k,idx_qv))
            t%d(i+1,j,k) = temperature(pt%d(i+1,j,k), ph%d(i+1,j,k), q%d(i+1,j,k,idx_qv))
            tv%d(i+1,j,k) = virtual_temperature_from_modified_potential_temperature(pt%d(i+1,j,k), phd_pow_rd(i+1,j,k), q%d(i+1,j,k,idx_qv))
            ! tv%d(i+1,j,k) = virtual_temperature_from_modified_potential_temperature(pt%d(i+1,j,k), ph%d(i+1,j,k)**rd_o_cpd, q%d(i+1,j,k,idx_qv))
          end do
          do i = mesh%full_ide - mod(mesh%full_ide - mesh%full_ids, 2), mesh%full_ide + 1
            t%d(i,j,k) = temperature(pt%d(i,j,k), ph%d(i,j,k), q%d(i,j,k,idx_qv))
            tv%d(i,j,k) = virtual_temperature_from_modified_potential_temperature(pt%d(i,j,k), phd_pow_rd(i,j,k), q%d(i,j,k,idx_qv))
            ! tv%d(i,j,k) = virtual_temperature_from_modified_potential_temperature(pt%d(i,j,k), ph%d(i,j,k)**rd_o_cpd, q%d(i,j,k,idx_qv))
          end do
        end do
      end do
    else
      do k = mesh%full_kds, mesh%full_kde
        do j = mesh%full_jds, mesh%full_jde + merge(0, 1, mesh%has_north_pole())
          do i = mesh%full_ids, mesh%full_ide + 1
            t%d(i,j,k) = temperature(pt%d(i,j,k), ph%d(i,j,k), 0.0_r8)
            tv%d(i,j,k) = t%d(i,j,k)
          end do
        end do
      end do
    end if
    end associate

    call perf_stop('calc_t')

  end subroutine calc_t

Same problems as the same as #63