!-------------------------------------- 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 pe_all_topo - First initialization steps
*
#include "model_macros_f.h"
*
subroutine pe_all_topo 1,5
implicit none
*
*author
* Michel Desgagne - Summer 2006
*
*revision
* v3_30 - Desgagne M. - initial version
* v3_31 - Desgagne/Lee - adaptation to new scripts
*
*implicits
#include "ptopo.cdk"
#include "path.cdk"
#include "lun.cdk"
#include "schm.cdk"
#include <clib_interface.cdk>
*
integer rpn_comm_bloc,ouvrstrt,wkoffit
external rpn_comm_bloc,ouvrstrt,wkoffit
*
character*3 mycol_S,myrow_S
character*12 dumc1_S
character*500 fn
integer err,n1,n2,n3,n4,n5,n6,n7,bufnml(10000),bufcte(10000),unf
*
*-------------------------------------------------------------------
*
call tmg_init0 ( Ptopo_myproc, 'GEMDM' )
call tmg_start0 ( 1, 'GEMDM' )
*
* Initializes I/O Fortran units
*
lun_out = -1
lun_in = 5
lun_lab = -1
Lun_zonl = -1
Lun_cte = -1
lun_tsrs = 61
lun_pilot= 62
lun_waphy= 65
lun_wapta= 66
Lun_rstrt= -1
Lun_debug_L=.false.
*
* Broadcasts processor topology
*
COMMON_BROADCAST (Ptopo_i)
*
* Initializes Path_nml_S
*
Path_nml_S = trim(Path_work_S)//'/model_settings.nml'
*
* Initializes PEs block partitions for the PEs (grouping PEs)
*
Ptopo_numpe_perb = Ptopo_npex/Ptopo_nblocx*Ptopo_npey/Ptopo_nblocy
call rpn_comm_mype (Ptopo_myproc, Ptopo_mycol, Ptopo_myrow)
err = RPN_COMM_bloc ( Ptopo_nblocx, Ptopo_nblocy )
call gem_stop ('rpn_comm_bloc',err)
*
call RPN_COMM_carac ( Ptopo_npex,Ptopo_npey,Ptopo_myproc,
$ n1,n2,n3,n4,n5,n6,n7 ,Ptopo_mybloc,
$ Ptopo_myblocx,Ptopo_myblocy,Ptopo_blocme,dumc1_S )
*
* Initializes OpenMP
*
call pe_rebind (Ptopo_smtdyn,Ptopo_myproc.eq.0)
*
* Reading namelist file Path_nml_S (blind read)
*
if (Ptopo_myproc.eq.0) then
call array_from_file(bufnml,size(bufnml),Path_nml_S)
call array_from_file(bufcte,size(bufcte),trim(Path_input_S)//'/constantes')
lun_out = 6
endif
*
* Changing directory to local Ptopo_mycol_Ptopo_myrow
*
write(mycol_S,10) Ptopo_mycol
write(myrow_S,10) Ptopo_myrow
10 format(i3.3)
err= clib_mkdir(mycol_S//'-'//myrow_S)
err= clib_chdir(mycol_S//'-'//myrow_S)
*
* Writing local namelist file Path_nml_S (blind write)
*
call RPN_COMM_bcast(bufnml,size(bufnml),"MPI_INTEGER",0,
$ "grid",err )
call RPN_COMM_bcast(bufcte,size(bufcte),"MPI_INTEGER",0,
$ "grid",err )
call array_to_file (bufnml,size(bufnml),'model_settings')
call array_to_file (bufcte,size(bufcte),'constantes' )
*
Lun_rstrt = ouvrstrt( )
*
* Determine theoretical mode with presence of file ${TASK_WORK}/theoc
*
unf=0
Schm_theoc_L = .false.
fn=trim(Path_work_S)//'/theoc'
if (wkoffit(fn).gt.-3) then
if (Ptopo_myproc.eq.0) write (Lun_out,*)
$ 'Assume Theoretical case'
Schm_theoc_L = .true.
else
call fclos (unf)
endif
*
*-------------------------------------------------------------------
*
return
end