!-------------------------------------- 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 set_world_view * #include "model_macros_f.h"*
subroutine set_world_view 1,20 * implicit none * *author * Michel Desgagne * *revision * v2_00 - Desgagne M. - initial MPI version * v2_10 - Lee V. - added watch_pid mechanism (returnpid) * v2_10 - Desgagne M. - Add partitioning checks * v2_20 - Desgagne M. - remove watch_dog (MPISUSPEND=ON) * v2_21 - Dugas B. - possibly initialize convip * v2_21 - Lee V. - modifications for LAM version and slab outputs * v2_30 - Dugas B. - add call to gemtim * v2_30 - Desgagne M. - entry vertical interpolator in gemdm * v2_32 - Desgagne M. - option for FST2000 encoding of ip1 * v3_00 - Desgagne & Lee - Lam configuration * v3_03 - Desgagne M. - new procedure for call to set_dcst8 * v3_10 - Corbeil & Desgagne & Lee - AIXport+Opti+OpenMP * v3_11 - Lee V. - place output in local PE directory * v3_21 - Desgagne M. - using RMNLIB to access constants * v3_30 - Desgagne M. - Cleaner approach to model startup * v3_30 - Desgagne & Winger - Initialize variable for VMM files * v3_31 - Desgagne M. - new coupling interface to OASIS * *object * *implicits #include "lun.cdk"
#include "cst_lis.cdk"
#include "dcst.cdk"
#include "ptopo.cdk"
#include "grd.cdk"
#include "schm.cdk"
#include "glb_ld.cdk"
#include "path.cdk"
#include "vmmlist.cdk"
#include "itf_phy_config.cdk"
#include "itf_cpl.cdk"
#include <clib_interface.cdk>
* character*512 fn logical set_dcst_8 integer gem_nml,var4d_nml,v4d_config,gemdm_config,grid_nml, $ itf_cpl_nml external pe_zero_topo, set_dcst_8, gem_nml, var4d_nml, $ v4d_config, gemdm_config, grid_nml, itf_cpl_nml ** integer ierr,cte_ok,f1,f2,f3,f4 * *------------------------------------------------------------------- * * Initializing MPI and processor topology (pe_zero_topo on PE #0 only) * call rpn_comm_init ( pe_zero_topo, Ptopo_myproc, Ptopo_numproc, $ Ptopo_npex , Ptopo_npey ) call base_dir_env
call gem_stop
('TASK_INPUT',clib_isdir(Path_input_S)) * * Continue initialization steps * ierr= clib_chdir (Path_work_S ) call pe_all_topo
cte_ok = 0 if ( .not. set_dcst_8 ( Dcst_cpd_8,liste_S,cnbre, $ Lun_out,Ptopo_numproc ) ) cte_ok=-1 call gem_stop
('set_dcst_8',cte_ok) * if ( Schm_theoc_L ) then * call theo_cfg
* else * * Initializes physical constants * * Read namelist gem_cfgs and var4d from file 'model_settings' * fn = 'model_settings' f1 = grid_nml
(fn) G_lam = Grd_typ_S(1:1).eq.'L' f2 = gem_nml
(fn) f3 = itf_cpl_nml
(fn) f4 = var4d_nml
(fn) call gem_stop
('SET_WORLD_VIEW_SET',min(f1,f2,f3,f4)) * endif * * Establish final configuration * f1 = gemdm_config
( ) f2 = v4d_config
( ) call gem_stop
('SET_WORLD_VIEW',min(f1,f2)) * ierr = grid_nml
('print') ierr = gem_nml
('print') ierr = itf_cpl_nml
('print') ierr = var4d_nml
('print') * call gemtim2
(Lun_out,.false.,0,ierr) * * Establish domain decomposition (mapping subdomains and processors) * call domain_decomp
* * Initializes schemes control comdeck * call set_schm
* * Initialize variable for VMM files * vmm_read_done_L = .false. * *------------------------------------------------------------------- * return end