!-------------------------------------- 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_predat_tl - TLM of v4d_predat
*
#include "model_macros_f.h"
*
subroutine v4d_predat_tl 1,11
*
implicit none
*
*author
* M.Tanguay
*
*revision
* v3_03 - Tanguay M. - initial MPI version
* v3_11 - Tanguay M. - modify evaluation of Ind_pip
* v3_21 - Tanguay M. - Revision Openmp
* - do filtering at t=0 in v4d_predat
* v3_22 - Tanguay M. - Change positioning of hzd_hoffld for psd
* v3_30 - Tanguay M. - Change parameters of initw2
* v3_31 - Tanguay M. - Change positioning of hzd_hoffld for u,v
*
*object
* see id section
*
*#############################################
* REMARK: INPUT TRAJECTORY: tpt1m,st1m,um,vm
*#############################################
*
*arguments
* none
*
*implicits
#include "glb_ld.cdk"
#include "lun.cdk"
#include "cstv.cdk"
#include "dcst.cdk"
#include "geomg.cdk"
#include "schm.cdk"
#include "ind.cdk"
#include "indm.cdk"
#include "lctl.cdk"
#include "v4dg.cdk"
#include "hzd.cdk"
*
integer i, j, k
real pr1, pr2
*
* __________________________________________________________________
*
if( Lun_out.gt.0 ) write(Lun_out,1003)
*
* -------------------------------------------------------------
* Set dependent variables phi',phi from T',s' when Schm_hydro_L
* -------------------------------------------------------------
if(Schm_hydro_L) call vtap_tl ()
*
!$omp parallel private (pr1,pr2)
*
if(.not.Schm_hydro_L) then
*
* Compute phi from phi'
* ---------------------
!$omp do
do k= 1, G_nk
do j= 1, l_nj
do i= 1, l_ni
*
* TRAJECTORY
* ----------
Indm_fim(i,j,k) = Indm_fipm(i,j,k) + Cstvr_fistr_8(k)
$ + Ind_topo(i,j)
*
* TLM
* ---
Ind_fi(i,j,k) = Ind_fip(i,j,k)
*
end do
end do
end do
!$omp end do
*
endif
*
* Compute T from T'
* -----------------
!$omp do
do k= 1, G_nk
do j= 1, l_nj
do i= 1, l_ni
*
* TRAJECTORY
* ----------
Indm_tm(i,j,k) = Indm_tpm(i,j,k) + Cstv_tstr_8
*
* TLM
* ---
Ind_t(i,j,k) = Ind_tp(i,j,k)
*
end do
end do
end do
!$omp end do
*
* Compute q
* ---------
!$omp do
do k= 1, G_nk
do j= 1, l_nj
do i= 1, l_ni
*
* TRAJECTORY
* ----------
Indm_qm(i,j,k) = alog( Geomg_pia(k) + Geomg_pib(k)*exp(Indm_sm(i,j)))
*
* TLM
* ---
Ind_q(i,j,k) = ( Geomg_pib(k)*exp(Indm_sm(i,j))*Ind_s(i,j) )/
% ( Geomg_pia(k) + Geomg_pib(k)*exp(Indm_sm(i,j)) )
*
end do
end do
end do
!$omp end do
*
* Compute pi'
* -----------
!$omp do
do k= 1, G_nk
*
if (k.eq.1) then
do j= 1, l_nj
do i= 1, l_ni
*
* TRAJECTORY
* ----------
Indm_pipm(i,j,1) = 0.
*
* TLM
* ---
Ind_pip(i,j,1) = 0.
*
end do
end do
*
else
*
do j= 1, l_nj
do i= 1, l_ni
*
* TRAJECTORY
* ----------
Indm_pipm(i,j,k) = Geomg_pia(k)+Geomg_pib(k)*exp(Indm_sm(i,j))
% - Geomg_z_8(k)
*
* TLM
* ---
Ind_pip(i,j,k) = Geomg_pib(k)*exp(Indm_sm(i,j))*Ind_s(i,j)
*
end do
end do
endif
*
end do
!$omp end do
*
* Compute P and T'
* lin
* ------------------
!$omp do
do k= 1, G_nk
pr1 = Dcst_rgasd_8 * Cstv_tstr_8 * Geomg_pib(k) / Geomg_z_8(k)
pr2 = Cstv_tstr_8*(Geomg_pib(k)/Geomg_z_8(k) - Geomg_dpib(k))
do j= 1, l_nj
do i= 1, l_ni
*
* TRAJECTORY
* ----------
Indm_gpm (i,j,k) = Indm_fipm(i,j,k) + pr1 * Indm_sm(i,j)
Indm_tplm(i,j,k) = (Cstv_tstr_8+Indm_tpm(i,j,k))*
% (1.0+Geomg_dpib(k)*(exp(Indm_sm(i,j))-1.))*
% Geomg_z_8(k) / (Geomg_z_8(k) + Indm_pipm(i,j,k)) - Cstv_tstr_8
*
Indm_tplm(i,j,k) = Indm_tplm(i,j,k) + pr2 * Indm_sm(i,j)
*
* TLM
* ---
Ind_gp (i,j,k) = Ind_fip(i,j,k) + pr1 * Ind_s(i,j)
Ind_tpl(i,j,k) =
% ( Ind_tp (i,j,k) ) *
% (1.0+Geomg_dpib(k)*(exp(Indm_sm (i,j))-1.) ) *
% Geomg_z_8(k) / (Geomg_z_8(k) + Indm_pipm(i,j,k)) +
*
% ( Cstv_tstr_8+Indm_tpm (i,j,k) ) *
% ( Geomg_dpib(k)* exp(Indm_sm (i,j))*Ind_s(i,j) ) *
% Geomg_z_8(k) / (Geomg_z_8(k) + Indm_pipm(i,j,k)) +
*
% (-1)*(
% ( Cstv_tstr_8+Indm_tpm (i,j,k) ) *
% (1.0+Geomg_dpib(k)*(exp(Indm_sm (i,j))-1.) ) *
% Geomg_z_8(k) / (Geomg_z_8(k) + Indm_pipm(i,j,k))**2
% ) * Ind_pip(i,j,k)
*
Ind_tpl(i,j,k) = Ind_tpl(i,j,k) + pr2 * Ind_s(i,j)
*
end do
end do
end do
!$omp end do
*
!$omp end parallel
*
* TRAJECTORY
* ----------
if(.not.(V4dg_4dvar_L.or.V4dg_sgvc_L)) call v4d_uv2img_tr
*
if(.not.(V4dg_4dvar_L.or.V4dg_sgvc_L)) call v4d_uv2img
*
* TRAJECTORY
* ----------
if (Hzd_t1_0_L) call hzd_hoffld (Indm_um, LDIST_DIM, G_nk, 1)
if (Hzd_t1_0_L) call hzd_hoffld (Indm_vm, LDIST_DIM, G_nk, 2)
*
* TLM
* ---
if (Hzd_t1_1_L) call hzd_hoffld (Ind_u, LDIST_DIM, G_nk, 1)
if (Hzd_t1_1_L) call hzd_hoffld (Ind_v, LDIST_DIM, G_nk, 2)
*
* Exchange the haloes for computing derivatives
* ---------------------------------------------
*
* TLM of
* Compute total divergence and vertical velocity
* ----------------------------------------------
call uv2tdpsd_tl( Ind_td, Ind_psd, Ind_u, Ind_v, Ind_s,
$ Indm_tdm,Indm_psdm,Indm_um,Indm_vm,Indm_sm,
$ LDIST_DIM, l_nk)
*
* TRAJECTORY
* ----------
if (Hzd_t1_0_L) call hzd_hoffld (Indm_psdm, LDIST_DIM, G_nk, 3)
*
* TLM
* ---
if (Hzd_t1_1_L) call hzd_hoffld (Ind_psd, LDIST_DIM, G_nk, 3)
*
if ( .not. Schm_hydro_L ) then
if ( Schm_theoc_L ) then
*
* TRAJECTORY
* ----------
Indm_wm = 0.
*
* TLM
* ---
Ind_w = 0.
*
else
call initw2_tl( Ind_w, Ind_mul, Ind_mu, Ind_u, Ind_v, Ind_psd, Ind_fi, Ind_t, Ind_s,
$ Indm_wm,Indm_mulm,Indm_mum,Indm_um,Indm_vm,Indm_psdm,Indm_fim,Indm_tm,Indm_sm,
$ LDIST_DIM )
endif
endif
*
1003 format(//,'TLM of PREPROCESSING DATA: (S/R V4D_PREDAT_TL PART 3)',
% /,'=====================================================',//)
*
* __________________________________________________________________
return
end