!-------------------------------------- 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 --------------------------------------
***s/r v4d_varconv - conversion control variables GEM <--> 3D-Var
*
#include "model_macros_f.h"
*
subroutine v4d_varconv( C_ut1, C_vt1, C_tt1, C_hut1, C_st1, 3,4
$ DIST_DIM, Nk, inverse_L )
*
implicit none
*
integer DIST_DIM,Nk
real C_ut1 (DIST_SHAPE,Nk), C_vt1 (DIST_SHAPE,Nk),
% C_tt1 (DIST_SHAPE,Nk), C_hut1(DIST_SHAPE,Nk),
% C_st1 (DIST_SHAPE)
logical inverse_L
*
*author
* Stephane Laroche
*
*revision
* v3_00 - Laroche S. - initial MPI version
* v3_00 - Gauthier P. - ln q to q
* v3_02 - Laroche S. - conversion to hybrid coordinate
* v3_11 - Tanguay M. - Add option for profiles done on U-V grids for winds
* - Add option for staggering already done by 3D-Var
* v3_30 - Fillion/Tanguay - Extend the scaling to all the grid in LAM mode
*
*object
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* C_ut1
* C_vt1
* C_tt1
* C_hut1
* C_st1
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
#include "geomg.cdk"
#include "cstv.cdk"
#include "dcst.cdk"
#include "v4dg.cdk"
*
*modules
*
integer i, j, k
real*8 pri2c_8
real wu(LDIST_SHAPE,l_nk),wv(LDIST_SHAPE,l_nk)
if(.not.inverse_L) then
C
C Conversion GEM --> 3D-Var
C =========================
C
*
C
C Winds
C -----
C
if(.not.V4dg_pruv_L) then
*
call itf_phy_uvgridscal ( C_ut1, C_vt1, LDIST_DIM, Nk, .true. )
do k=1,Nk
do j= 1, l_nj
pri2c_8 = Dcst_rayt_8/Geomg_cy_8(j)
do i= 1, l_ni
C_ut1(i,j,k) = C_ut1(i,j,k)*pri2c_8
C_vt1(i,j,k) = C_vt1(i,j,k)*pri2c_8
end do
end do
end do
*
else
*
do k=1,Nk
do j= 1, l_nj
pri2c_8 = Dcst_rayt_8/Geomg_cy_8(j)
do i= 1, l_niu
C_ut1(i,j,k) = C_ut1(i,j,k)*pri2c_8
end do
end do
end do
*
do k=1,Nk
do j= 1, l_njv
pri2c_8 = Dcst_rayt_8/Geomg_cyv_8(j)
do i= 1, l_ni
C_vt1(i,j,k) = C_vt1(i,j,k)*pri2c_8
end do
end do
end do
*
endif
C
C Temperature
C -----------
C
do k=1,Nk
do j= 1, l_nj
do i= 1, l_ni
C_tt1(i,j,k) = (C_tt1(i,j,k) + Cstv_tstr_8)
$ / (1.0 + Dcst_delta_8*C_hut1(i,j,k))
end do
end do
end do
C
C Surface pressure
C ----------------
C
do j= 1, l_nj
do i= 1, l_ni
C_st1(i,j) = Geomg_z_8(Nk)*exp(C_st1(i,j))
end do
end do
C
C Humidity: q --> log q
C
do k=1,Nk
do j= 1, l_nj
do i= 1, l_ni
C_hut1(i,j,k) = alog(C_hut1(i,j,k))
end do
end do
end do
*
else
*
C
C Conversion 3D-Var --> GEM
C =========================
C
C
C Humidity: log q --> q = exp(log q)
C
do k=1,Nk
do j= 1, l_nj
do i= 1, l_ni
C_hut1(i,j,k) = exp(C_hut1(i,j,k))
end do
end do
end do
C
C Winds
C -----
do k=1,Nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
wu(i,j,k) = 0.0
wv(i,j,k) = 0.0
enddo
enddo
enddo
*
if(.not.V4dg_ustag_L) then
do k=1,Nk
do j= 1, l_nj
pri2c_8 = Dcst_rayt_8/Geomg_cy_8(j)
do i= 1, l_ni
C_ut1(i,j,k) = C_ut1(i,j,k)/pri2c_8
end do
end do
end do
endif
*
if(.not.V4dg_vstag_L) then
do k=1,Nk
do j= 1, l_nj
pri2c_8 = Dcst_rayt_8/Geomg_cy_8(j)
do i= 1, l_ni
C_vt1(i,j,k) = C_vt1(i,j,k)/pri2c_8
end do
end do
end do
endif
*
if(.not.V4dg_ustag_L.and..not.V4dg_vstag_L) then
call itf_phy_uvgridscal ( C_ut1, C_vt1, LDIST_DIM, Nk, .false. )
*
elseif(V4dg_ustag_L.and..not.V4dg_vstag_L) then
call itf_phy_uvgridscal ( wu, C_vt1, LDIST_DIM, Nk, .false. )
*
elseif(.not.V4dg_ustag_L.and.V4dg_vstag_L) then
call itf_phy_uvgridscal ( C_ut1, wv, LDIST_DIM, Nk, .false. )
endif
*
if(V4dg_ustag_L) then
do k=1,Nk
do j= 1, l_nj
pri2c_8 = Dcst_rayt_8/Geomg_cy_8(j)
do i= 1, l_niu
C_ut1(i,j,k) = C_ut1(i,j,k)/pri2c_8
end do
end do
end do
endif
*
if(V4dg_vstag_L) then
do k=1,Nk
do j= 1, l_njv
pri2c_8 = Dcst_rayt_8/Geomg_cyv_8(j)
do i= 1, l_ni
C_vt1(i,j,k) = C_vt1(i,j,k)/pri2c_8
end do
end do
end do
endif
C
C Temperature
C -----------
C
do k=1,Nk
do j= 1, l_nj
do i= 1, l_ni
C_tt1(i,j,k) = C_tt1(i,j,k)*(1.0 + Dcst_delta_8*C_hut1(i,j,k))
$ - Cstv_tstr_8
end do
end do
end do
C
C Surface pressure
C ----------------
C
do j= 1, l_nj
do i= 1, l_ni
C_st1(i,j) = log( C_st1(i,j) / Geomg_z_8(Nk) )
end do
end do
endif
return
end