Open GrassBlock2016 opened 5 months ago
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
Same problems as the same as #63