!-------------------------------------- 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 e_coefdgf - Precomputations for horizontal digital filter *subroutine e_coefdgf ( fnptx, frl, frlc, frcoeff ) 2 * #include "impnone.cdk"
* integer fnptx real frl, frlc, frcoeff(fnptx+1) * *author andre methot - cmc - may 95 * after setinic.ftn v0_15, Alain Patoine * *revision * v0_16 - andre methot - Digital filter initial version * v1_96 - V. Lee - replaced "cddcst.cdk" with "dcst.cdk" * v1_97 - V. Lee - replaced "cdlun.cdk" with "e_times.cdk" * *object * see above ID * *arguments * *______________________________________________________________________ * | | * NAME | DESCRIPTION | *--------------------|-------------------------------------------------| * fnptx | SPAN: half of the number of neighbouring | * | points to be used by the filter. | * | | * frl | half of the shortest wave length resolved | * | | * frlc | cut off wavelength | * | | * frcoeff | digital filter coefficients(output) | * ______________________________________________________________________ * *implicits #include "model_macros_f.h"
#include "dcst.cdk"
* *modules * real promegc, prwin1, prsum, prwin2, prn integer n ** promegc = (2.0 * Dcst_pi_8) / frlc prwin1 = Dcst_pi_8 / real(fnptx + 1) frcoeff(1)= promegc*frl / Dcst_pi_8 prsum = frcoeff(1) * do n = 1, fnptx prn = real(n) prwin2 = prn * prwin1 prwin2 = sin(prwin2) / prwin2 frcoeff(n+1) = prwin2 * sin(prn*promegc*frl) / (prn*Dcst_pi_8) prsum = prsum + 2.0 * frcoeff(n+1) enddo * do n = 1, fnptx+1 frcoeff(n) = frcoeff(n) / prsum enddo * return end