!-------------------------------------- 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_xnbit - initialize list of variables required different compaction * #include "model_macros_f.h"*
integer function set_xnbit (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 "xnbit" 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: xnbit([Z0,MX],bits,24) * * 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 bits,varmax integer i, j, k, m, pndx, ii, jj, kk * *---------------------------------------------------------------- * write(Lun_out,*) write(Lun_out,*) F_argv_S set_xnbit=0 Out3_xnbits_max = Out3_xnbits_max + 1 if (Out3_xnbits_max.gt.MAXELEM) then write(Lun_out,*)'set_xnbit WARNING: Too many definitions XNBITS' Out3_xnbits_max = Out3_xnbits_max - 1 set_xnbit = 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_xnbit WARNING: syntax incorrect' set_xnbit=1 Out3_xnbits_max = Out3_xnbits_max - 1 return endif * * Obtain compaction bits request * bits=0 do i=varmax+2, F_argc if (F_argv_S(i).eq.'bits') read(F_argv_S(i+1),*) bits enddo if (bits.le.0) then write(Lun_out,*) 'set_xnbit WARNING: Number of bits not chosen' set_xnbit=1 Out3_xnbits_max = Out3_xnbits_max - 1 return endif * * Store variables in variable sets * j = Out3_xnbits_max + varmax if (j.gt.MAXELEM) then write(Lun_out,*) 'set_xnbit WARNING: too many variables for xnbits' set_xnbit=1 return endif * jj=Out3_xnbits_max do ii=1,varmax jj = jj+1 Out3_xnbits_S(jj) = F_argv_S(ii+1) Out3_xnbits(jj) = bits enddo Out3_xnbits_max = jj * *---------------------------------------------------------------- * return end