!-------------------------------------- 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 bin2com - reads parameters from labfl * #include "model_macros_f.h"*
integer function bin2com () 1 implicit none * *author * michel desgagne - Jan 2000 * *revision * v2_00 - Desgagne/Lee - initial MPI version (from setgeom v1_03) * v2_20 - Lee V. - broadcast changes due to physics 3.66 * v2_30 - Edouard S. - replace Schm_elast_L by Schm_cptop_L * v2_30 introduce Geomg_pia and Geomg_pib * v2_30 - A. Methot - introduction of a new stretch grid design * v2_30 with upper limits on grid point spacing * v2_31 - Desgagne/Lee - Clean up, introduce tracers and remove * v2_31 references to vertical levels * v3_00 - Desgagne & Lee - Lam configuration * v3_11 - Tanguay M. - Introduce Grd_gauss_L * v3_12 - Winger K. - transfer Anal_cond_L * v3_20 - Pellerin P. - Introduce: Hblen_wfct_S, schm_offline_L * v3_21 - Lee V. - Remove Tr2d * v3_30 - Lee/Desgagne - Reduced number of variables passed from * gemntr to gemdm. * *object * See above id * *arguments - none * #include "glb_ld.cdk"
#include "anal.cdk"
#include "schm.cdk"
#include "tr3d.cdk"
#include "offline.cdk"
#include "path.cdk"
#include "modconst.cdk"
#include "out3.cdk"
#include "lun.cdk"
* integer fnom,wkoffit external fnom,wkoffit character*512 fn integer k, unf, ierr ** * --------------------------------------------------------------- * bin2com = -1 * unf = 0 fn = trim(Path_input_S)//'/INIT_SFC/labfl.bin' ierr = wkoffit(fn) * if (ierr.ge.-1) then if ( fnom (unf, fn, 'SEQ+FTN+UNF+OLD',ierr ) .eq. 0 ) then read(unf) Mod_runstrt_S * read(unf) Tr3d_userntr, $ (Tr3d_username_S(k),k=1,Tr3d_userntr), $ (Tr3d_usersval (k),k=1,Tr3d_userntr) * read(unf) Anal_cond_L, schm_offline_L, $ Offline_ip1a, Offline_int_accu_S * call fclos (unf) * bin2com = 0 * endif endif * if (bin2com .lt. 0) then if (G_lam) then Mod_runstrt_S='@#$%' Out3_date = 0 Tr3d_userntr = 0 bin2com = 0 else if (Lun_out.gt.0) write (6,1001) trim(fn) endif endif * 1001 format (/' File ',a,' not available - ABORT -'/) * --------------------------------------------------------------- * return end *