!-------------------------------------- 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 set_filt - initialize list of variables for filtering before output * #include "model_macros_f.h"*
integer function set_filt (F_argc,F_argv_S,F_cmdtyp_S,F_v1,F_v2) * implicit none * integer F_argc,F_v1,F_v2 character *(*) F_argv_S(0:F_argc),F_cmdtyp_S * *author Vivian Lee - rpn - July 2004 * *revision * v3_20 - Lee V. - initial MPI version * *object * initialization of the common blocks OUT3. This function is * called when the keyword "filtre" is found in the first word * of the directives in the input file given in the statement * "process_f_callback". This feature is enabled by the * ARMNLIB "rpn_fortran_callback" routine (called in "srequet") * which allows a different way of passing user directives than * the conventional FORTRAN namelist. This function will process * the following example command read from the named input file. * * ie: filtre([UU,VV,TT],coef,.1,pass,3) * * The "rpn_fortran_callback" routine will process the above * statement and return 5 arguments to this function. For more * information to how this is processed, see "SREQUET". * * *arguments * Name I/O Description *---------------------------------------------------------------- * F_argc I - number of elements in F_argv_S * F_argv_S I - array of elements received * if F_argv_S(ii) contains "[", the value in this * argument indicates number of elements following it * F_cmdtyp_S I - character command type - not used * F_v1 I - integer parameter 1 - not used * F_v2 I - integer parameter 2 - not used *---------------------------------------------------------------- * * *implicits #include "glb_ld.cdk"
#include "lun.cdk"
#include "out3.cdk"
* ** * character*5 stuff_S character*16 varname_S integer pass, varmax real coef integer i, j, k, m, pndx, ii, jj, kk * *---------------------------------------------------------------- * write(Lun_out,*) write(Lun_out,*) F_argv_S set_filt=0 Out3_filtpass_max = Out3_filtpass_max + 1 if (Out3_filtpass_max.gt.MAXELEM) then write(Lun_out,*)'SET_FILT WARNING: Too many definitions filter' Out3_filtpass_max = Out3_filtpass_max - 1 set_filt = 1 return endif if (index(F_argv_S(1),'[').gt.0) then stuff_S=F_argv_S(1) read(stuff_S(2:4),*) varmax else write(Lun_out,*) $ 'set_filt WARNING: syntax incorrect' set_filt=1 Out3_filtpass_max = Out3_filtpass_max - 1 return endif * * Obtain coef,npass values for filter * pass=0 coef=0.0 do i=varmax+2, F_argc if (F_argv_S(i).eq.'coef') then read(F_argv_S(i+1),*) coef else if (F_argv_S(i).eq.'pass') then read(F_argv_S(i+1),*) pass endif enddo if (pass.le.0) then write(Lun_out,*) 'set_filt WARNING: Number of passes not chosen' set_filt=1 Out3_filtpass_max = Out3_filtpass_max - 1 return endif if (coef.eq.0.0) then write(Lun_out,*) 'set_filt WARNING: Filtering coefficient=0.0' set_filt=1 Out3_filtpass_max = Out3_filtpass_max - 1 return endif * * Store variables in variable sets * j = Out3_filtpass_max + varmax if (j.gt.MAXELEM) then write(Lun_out,*) 'set_filt WARNING: too many variables to filt' set_filt=1 return endif * jj=Out3_filtpass_max do ii=1,varmax jj = jj+1 Out3_filt_S(jj) = F_argv_S(ii+1) Out3_filtpass(jj) = pass Out3_filtcoef(jj) = coef enddo Out3_filtpass_max = jj * *---------------------------------------------------------------- * return end