!-------------------------------------- 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/p calF_omeg - compute vertical velocity in pressure coordinates * #include "model_macros_f.h"*
subroutine calzz(F_zz, F_fit1, F_fit2, DIST_DIM, Nk) 1 * implicit none * integer DIST_DIM, Nk real F_zz(DIST_SHAPE,Nk) real F_fit1(DIST_SHAPE,Nk), F_fit2(DIST_SHAPE,Nk) * *author * Richard Moffet - cmc - nov 2001 - * *revision * v3_03 - Moffet R. - add ZZ calc at step=0 * v3_22 - Lee V. - correct calc for LAM,remove F_i0,F_j0.. * *object * compute vertical velocity in z coordinates *arguments * Name I/O Description *---------------------------------------------------------------- * F_zz O - dz/dt * *implicits #include "glb_ld.cdk"
#include "dcst.cdk"
#include "cstv.cdk"
#include "lctl.cdk"
* ** integer i,j,k * __________________________________________________________________ * if ( Lctl_step .ne. 0 )then do k=2,l_nk do j= 1+pil_s, l_nj-pil_n do i= 1+pil_w, l_ni-pil_e F_zz (i,j,k) = (F_fit1(i,j,k) - F_fit2(i,j,k)) % / (Cstv_dt_8*Dcst_grav_8) end do end do end do * do j= 1, l_nj do i= 1, l_ni F_zz (i,j,1) = 0. end do end do else do k=1,l_nk do j= 1, l_nj do i= 1, l_ni F_zz (i,j,k) = 0.0 end do end do end do * endif * __________________________________________________________________ * return end