!-------------------------------------- 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 optriss7_ad - ADJ of optriss for Z axis only
*
#include "model_macros_f.h"
*
subroutine optriss7_ad ( F_r, F_rhs, F_ideb,F_jdeb,F_ifin,F_jfin,F_nk, 1,2
% F_axis, F_a_8, F_b_8, F_c_8, F_period_L,
% NIS, NJS, NKS, SKIP )
*
#include "impnone.cdk"
*
integer F_ideb,F_jdeb,F_ifin,F_jfin, F_nk, NIS, NJS, NKS, SKIP
real F_r(SKIP,NIS,NJS,NKS), F_rhs(SKIP,NIS,NJS,NKS)
real*8 F_a_8(*), F_b_8(*), F_c_8(*)
character*1 F_axis
logical F_period_L
*
*author
* M.Tanguay
*
*revision
* v2_10 - Tanguay M. - initial MPI version
* v2_31 - Tanguay M. - adapt to f90 native dynamic memory allocation
* v3_01 - Lee V - to call optriss7 instead of optriss6
*
*object
* see id section
* Based on optrsad (v1_02 - s polavarapu)
* ----------------------------------------------------
* REMARK:F_r and F_rhs can NOT share same memory space
* ----------------------------------------------------
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_r IO - result
* F_rhs IO - right-hand-side
* F_ideb I - starting index on I (x-direction)
* F_jdeb I - starting index on J (y-direction)
* F_ifin I - ending index on I (x-direction)
* F_jfin I - ending index on J (y-direction)
* F_nk I - number of levels in z-direction
* F_axis I - along the x-, y- or z-axis
* F_a_8 I - lower diagonal of operator
* F_b_8 I - middle diagonal of operator
* F_c_8 I - upper diagonal of operator
* F_period_L I - .true. if periodic in x direction
* NIS I - field dimension in x-direction
* NJS I - field dimension in y-direction
* NKS I - field dimension in z-direction
* SKIP I - distance between elements of F_rhs (and F_r)
*
*implicits
#include "glb_ld.cdk"
*
integer i, n
*
real*8 ZERO_8
parameter( ZERO_8 = 0.0 )
*
real*8 pra_8 (F_nk)
real*8 prc_8 (F_nk)
*
*******************************************************************************
* *
* ONLY for solving along z direction *
* *
*******************************************************************************
if ( F_axis.eq.'Z' ) then
*
do i = 1,F_nk-1
pra_8(i+1) = F_c_8(i)
enddo
pra_8(1) = ZERO_8
do i = 2,F_nk
prc_8(i-1) = F_a_8(i)
enddo
prc_8(F_nk) = ZERO_8
if ( F_period_L ) then
pra_8(1) = F_c_8(F_nk)
prc_8(F_nk) = F_a_8(1)
endif
call optriss7
% (F_rhs, F_r,F_ideb,F_jdeb,F_ifin,F_jfin, F_nk,
% F_axis, pra_8,F_b_8,prc_8,F_period_L ,
% NIS ,NJS ,NKS ,SKIP )
else
print *,'ERROR: OPTRISS7_AD is only correct for Z axis'
call stopmpi(-1)
endif
*
return
end