!-------------------------------------- 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 -------------------------------------- ! ! ! X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X !subroutine asymmetrize(pin,pout,kni,knj,knk) 3 ! !**s/r asymmetrize - Adjoint of sub. symmetrize. ! !Author : Luc Fillion - MSC/CAN - 14 Oct 04. !Revision: ! ! ------------------- ! !Arguments ! IMPLICIT NONE #include "taglam4d.cdk"
! integer kni,knj,knk real*8 pin(kni,knk,knj) real*8 pout(-1:kni+2,knk,-1:knj+2) ! integer ji,jj,jk INTEGER myid,numthd,omp_get_thread_num,omp_get_num_threads ! !! !$OMP PARALLEL PRIVATE(ji,jj,jk,myid,numthd) myid=omp_get_thread_num()+1 numthd=omp_get_num_threads() do jk = myid,knk,numthd do ji = kni+2, -1, -1 pout(ji,jk,2) = pout(ji,jk,2)+pout(ji,jk,knj+2) ! pout(ji,jk,knj+2) = 0.0 pout(ji,jk,1) = pout(ji,jk,1)+pout(ji,jk,knj+1) ! pout(ji,jk,knj+1) = 0.0 enddo do jj = knj, -1, -1 pout(2,jk,jj) = pout(2,jk,jj)+pout(kni+2,jk,jj) ! pout(kni+2,jk,jj) = 0.0 pout(1,jk,jj) =pout(1,jk,jj)+pout(kni+1,jk,jj) ! pout(kni+1,jk,jj) = 0.0 enddo do jj = knj, -1, -1 pout(kni-1,jk,jj) = pout(kni-1,jk,jj)+pout(-1,jk,jj) ! pout(-1,jk,jj) = 0.0 pout(kni,jk,jj) = pout(kni,jk,jj)+pout(0,jk,jj) ! pout(0,jk,jj) = 0.0 enddo do ji = kni, 1, -1 pout(ji,jk,knj-1) = pout(ji,jk,knj-1)+pout(ji,jk,-1) ! pout(ji,jk,-1) = 0.0 pout(ji,jk,knj) = pout(ji,jk,knj)+pout(ji,jk,0) ! pout(ji,jk,0) = 0.0 enddo enddo !$OMP END PARALLEL ! do jj = 1, knj do jk = 1, knk do ji = 1, kni pin(ji,jk,jj) = pin(ji,jk,jj) + pout(ji,jk,jj) enddo enddo enddo ! return end