!-------------------------------------- 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 hzd_exhrdif_ad - ADJ of hzd_exhrdif_tl
*
#include "model_macros_f.h"
subroutine hzd_exhrdif_ad ( F_u, F_v, F_psd, F_td, DIST_DIM, Nk ) 1,12
*
implicit none
*
integer DIST_DIM, Nk
*
real F_u(DIST_SHAPE,Nk), F_v(DIST_SHAPE,Nk),
% F_psd(DIST_SHAPE,Nk), F_td(DIST_SHAPE,Nk)
*
*author
* M.Tanguay
*
*revision
* v3_30 - Tanguay M. - initial MPI version
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
#include "hzd.cdk"
*
integer nn, mm, i, j, k
real*8 pt25,nu_dif,epsilon,khdim,lnr,visco
parameter (epsilon = 1.0d-12, pt25=0.25d0)
real smu (LDIST_SHAPE,Nk),smv (LDIST_SHAPE,Nk),
$ smpsd(LDIST_SHAPE,Nk),smtd(LDIST_SHAPE,Nk)
*
real*8, parameter :: ZERO_8 = 0.0
**
* __________________________________________________________________
*
nu_dif = 0.d0
lnr = 1.0d0 - exp(Hzd_lnr)
if (Hzd_pwr.gt.0) nu_dif = pt25*lnr**(2.d0/Hzd_pwr)
nu_dif = min(nu_dif,pt25-epsilon)
if (nu_dif.lt.1.0e-10) return
*
visco = min ( nu_dif, pt25 )
*
nn=Hzd_pwr/2
*
* Zero adjoint variables
* ----------------------
!$omp parallel do
do k=1,G_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
smu (i,j,k) = ZERO_8
smv (i,j,k) = ZERO_8
smpsd(i,j,k) = ZERO_8
smtd (i,j,k) = ZERO_8
end do
end do
end do
!$omp end parallel do
*
* -------------
do mm=nn,1,-1
* -------------
*
if(mm.ne.nn) then
*
call rpn_comm_adj_halo( smtd , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
call rpn_comm_adj_halo( smpsd, LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
call rpn_comm_adj_halo( smv , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
call rpn_comm_adj_halo( smu , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
*
!$omp parallel do
do k= 1,G_nk
call v4d_zerohalo ( smtd (l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
call v4d_zerohalo ( smpsd(l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
call v4d_zerohalo ( smv (l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
call v4d_zerohalo ( smu (l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
enddo
!$omp end parallel do
*
endif
*
call hzd_nudeln_ad (F_td ,smtd ,LDIST_DIM,Nk,visco,0,0,mm,nn)
call hzd_nudeln_ad (F_psd,smpsd,LDIST_DIM,Nk,visco,0,0,mm,nn)
call hzd_nudeln_ad (F_v ,smv ,LDIST_DIM,Nk,visco,0,1,mm,nn)
call hzd_nudeln_ad (F_u ,smu ,LDIST_DIM,Nk,visco,1,0,mm,nn)
*
* ------
end do
* ------
*
call rpn_comm_adj_halo( F_td , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
call rpn_comm_adj_halo( F_psd, LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
call rpn_comm_adj_halo( F_v , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
call rpn_comm_adj_halo( F_u , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
*
!$omp parallel do
do k= 1,G_nk
call v4d_zerohalo ( F_td (l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
call v4d_zerohalo ( F_psd(l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
call v4d_zerohalo ( F_v (l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
call v4d_zerohalo ( F_u (l_minx,l_miny,k),l_ni,l_nj,LDIST_DIM,1)
enddo
!$omp end parallel do
* __________________________________________________________________
*
return
end