!======================================= ! 2D cumulus model - kaminari ! - subroutine ptn_temp_1stp ! ! Author : TAKAHASHI Koko ! Date : 2003/12/25 最終更新 ! 2003/11/05 新規作成 ! Note : 1 ステップ目の温位 ! !======================================= !--- 1,2行目入力変数, 3行目入出力変数 subroutine ptn_temp_1stp(im,km,nuh,nuv,dx,dz,dtb,u,omg, & & ptemp) implicit none integer(8), intent(in) :: im, km real(8), intent(in) :: nuh, nuv!,cp, ml real(8), intent(in) :: dx, dz real(8), intent(in) :: dtb ! real(8), intent(in) :: prss_bs(-2:im+2,-2:km+2) ! real(8), intent(in) :: pi_bs(-2:im+2,-2:km+2) ! real(8), intent(in) :: dens_bs(-2:im+2,-2:km+2) real(8), intent(in) :: u(-2:im+2,-2:km+2) real(8), intent(in) :: omg(-2:im+2,-2:km+3) ! real(8), intent(in) :: qv(-2:im+2,-2:km+2) ! real(8), intent(in) :: qr(-2:im+2,-2:km+2) ! real(8), intent(in) :: qvs(-2:im+2,-2:km+2) real(8), intent(inout) :: ptemp(-2:im+2,-2:km+2) integer(8) :: i,k real(8) :: ptemp_dif(-2:im+2,-2:km+2) real(8) :: ptemp_adv(-2:im+2,-2:km+2) do k = 0,km do i = 0,im !--- 温位の数値粘性項 ptemp_dif(i,k) = nuh*( & & ptemp(i+1,k) - 2.0d0*ptemp(i,k) & & + ptemp(i-1,k) & & )/(dx**2.0d0) & & + nuv*( & & ptemp(i,k+1) - 2.0d0*ptemp(i,k) & & + ptemp(i,k-1) & & )/(dz**2.0d0) ptemp_dif(i,k) = 0.0d0 !--- 温位の移流項 ptemp_adv(i,k) = (u(i+1,k) + u(i,k))/2.0d0 & & *(ptemp(i+1,k) - ptemp(i-1,k))/(2.0d0*dx)& & + (omg(i,k+1) + omg(i,k))/2.0d0 & & *(ptemp(i,k+1) - ptemp(i,k-1)) & & /(2.0d0*dz) & & + ptemp_dif(i,k) !--- 温位 ptemp(i,k) = ptemp(i,k) - dtb*ptemp_adv(i,k) end do end do end subroutine ptn_temp_1stp