!--------------------------------------- LICENCE BEGIN -----------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
SUBROUTINE ltt2phi_gem4(column,columng) 1,26
!
!**s/r ltt2phi_gem4 - Temperature to geopotential transformation on GEM4 staggered levels
! NOTE: we assume
! 1) nlev_T = nlev_M+1
! 2) GZ_T(nlev_T) = GZ_M(nlev_M), both at the surface
! 3) a thermo level exists at the top, higher than the highest momentum level
! 4) the placement of the thermo levels means that GZ_T is the average of 2 nearest GZ_M
! (according to Ron and Claude)
!
!Author : M. Buehner, February 2014
!
use mathPhysConstants_mod
use physicsFunctions_mod
use columnData_mod
implicit none
type(struct_columnData) :: column,columng
integer :: columnIndex,lev_M,lev_T,nlev_M,nlev_T
real(8) :: hu,tt,delPsfc,ratioP1
real(8), allocatable :: tv(:),delTv(:),ratioP(:)
real(8), allocatable :: delLnP_M(:),delLnP_T(:)
real(8), pointer :: delGz_M(:),delGz_T(:)
type(struct_vco), pointer :: vco_anl
vco_anl => col_getVco(columng)
nlev_T = col_getNumLev(columng,'TH')
nlev_M = col_getNumLev(columng,'MM')
!write(*,*) 'ltt2phi_gem4: nlev_T,nlev_M=',nlev_T,nlev_M
if(nlev_T .ne. nlev_M+1) call abort3d('ltt2phi_gem4: nlev_T is not equal to nlev_M+1!')
allocate(tv(nlev_T))
allocate(delTv(nlev_T))
allocate(ratioP(nlev_T))
allocate(delLnP_M(nlev_M))
allocate(delLnP_T(nlev_T))
! loop over all columns
!$OMP PARALLEL DO PRIVATE(columnIndex,delGz_M,delGz_T, &
!$OMP delPsfc,lev_M,lev_T, &
!$OMP delLnP_M,delLnP_T,hu,tt,tv,delTv,ratioP,ratioP1)
do columnIndex = 1, col_getNumCol(columng)
delGz_M => col_getColumn(column,columnIndex,'GZ','MM')
delGz_T => col_getColumn(column,columnIndex,'GZ','TH')
! initialize GZ increment to zero
delGz_M(1:nlev_M) = 0.0d0
delGz_T(1:nlev_T) = 0.0d0
! compute lnP increment on momentum and thermo levels
delPsfc = col_getElem(column,1,columnIndex,'P0')
do lev_M = 1, nlev_M
delLnP_M(lev_M) = col_getPressureDeriv(columng,lev_M,columnIndex,'MM')*delPsfc/ &
col_getPressure(columng,lev_M,columnIndex,'MM')
enddo
do lev_T = 1, nlev_T
delLnP_T(lev_T) = col_getPressureDeriv(columng,lev_T,columnIndex,'TH')*delPsfc/ &
col_getPressure(columng,lev_T,columnIndex,'TH')
enddo
! compute background virtual temperature and its increment on thermo levels
do lev_T = 1, nlev_T
hu = exp(col_getElem(columng,lev_T,columnIndex,'HU'))
tt = col_getElem(columng,lev_T,columnIndex,'TT')
tv(lev_T) = fotvt8(tt,hu)
! delTv = dTv_dT*delT + dTv_dLQ*delLQ
delTv(lev_T) = fottva(hu,1.0d0)*col_getElem(column,lev_T,columnIndex,'TT') + &
folnqva(hu,tt,1.0d0)*col_getElem(column,lev_T,columnIndex,'HU')
enddo
! compute natural log of momenutum level pressure ratios for each layer
do lev_M = 1,(nlev_M-1)
lev_T = lev_M+1 ! thermo level just below momentum level
ratioP(lev_T) = log( col_getPressure(columng,lev_M+1,columnIndex,'MM') / &
col_getPressure(columng,lev_M,columnIndex,'MM') )
enddo
! compute GZ increment on momentum levels
do lev_M = (nlev_M-1), 1, -1
lev_T = lev_M+1 ! thermo level just below momentum level being computed
delGz_M(lev_M) = delGz_M(lev_M+1) + &
MPC_RGAS_DRY_AIR_R8*( ratioP(lev_T)*delTv(lev_T) + &
tv(lev_T)*(delLnP_M(lev_M+1) - &
delLnP_M(lev_M)) )
enddo
! compute GZ increment for top thermo level (from top momentum level)
ratioP1 = log( col_getPressure(columng,1,columnIndex,'MM') / &
col_getPressure(columng,1,columnIndex,'TH') )
delGz_T(1) = delGz_M(1) + &
MPC_RGAS_DRY_AIR_R8*( ratioP1*delTv(1) + &
tv(1)*(delLnP_M(1) - delLnP_T(1)) )
! compute GZ increment on remaining thermo levels by simple averaging
do lev_T = 2, (nlev_T-1)
lev_M = lev_T ! momentum level just below thermo level being computed
delGz_T(lev_T) = 0.5d0*( delGz_M(lev_M-1) + delGz_M(lev_M) )
enddo
!if(columnIndex.eq.1) then
! do lev_M = 1, nlev_M
! write(*,*) 'ltt2phi_gem4: delGz_M=',lev_M,delGz_M(lev_M)
! enddo
! do lev_T = 1, nlev_T
! write(*,*) 'ltt2phi_gem4: delGz_T=',lev_T,delGz_T(lev_T)
! enddo
!endif
enddo
!$OMP END PARALLEL DO
deallocate(tv)
deallocate(delTv)
deallocate(ratioP)
deallocate(delLnP_M)
deallocate(delLnP_T)
end subroutine ltt2phi_gem4