!-------------------------------------- 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 hatoprg_ad - ADJ of hatoprg * (variant for OPENMP LAM) * #include "model_macros_f.h"*
subroutine hatoprg0_ad (F_gg, F_ff, F_con, F_hz_8, ng, Nk) 3 * implicit none * integer ng, Nk real F_gg(ng,Nk),F_ff(ng,Nk),F_con real*8 F_hz_8(Nk) * *author * M.Tanguay * *revision * v2_10 - Tanguay M. - initial MPI version * v3_00 - Tanguay M. - adapt to restructured hatoprg * v3_21 - Tanguay M. - Revision Openmp * v3_30 - Tanguay M. - Revision Openmp LAM * *object * see id section * *arguments * Name I/O Description *---------------------------------------------------------------- * F_gg O resulting vertical integration * F_ff I input field to be integrated * F_con I mutiplication coefficient * F_hz_8 I intervals in z-direction *---------------------------------------------------------------- *implicits #include "glb_ld.cdk"
* integer i, j, k real*8 wk(G_nk-1),r * real*8 ZERO_8 parameter (ZERO_8=0.0) * * __________________________________________________________________ * wk(: ) = .5*F_con*F_hz_8(:) * r=0. * !$omp parallel do private (r) do i= 1, ng * r = F_gg(i,1) + r F_gg(i,1) = ZERO_8 * do k= 1,G_nk-1 * F_ff(i,k+1) = wk(k)*( r ) + F_ff(i,k+1) F_ff(i,k) = wk(k)*( r ) + F_ff(i,k) * r = F_gg(i,k+1) + r F_gg(i,k+1) = ZERO_8 * end do * r=0. * end do !$omp end parallel do * return end