copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
***s/r set_world_view
*
integer function set_world_view () 1,8
implicit none
*
#include "lun.cdk"
#include "lcldim.cdk"
#include "grd.cdk"
#include "physnml.cdk"
#include "physcom.cdk"
#include "path.cdk"
#include "nbcpu.cdk"
#include "partopo.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
*
character*6 dummy,mype
character*7 mexmey
character*12 dumc1
character*250 lacommande
logical bcastc
integer RPN_COMM_option_L,RPN_COMM_bloc,longueur,cnt,i,k,err,
$ n1,n2,n3,n4,n5,n6,n7,set_run_dir_xy2,mode
external set_world_view1,RPN_COMM_option_L,RPN_COMM_bloc
integer gnthread
*
*-------------------------------------------------------------------
*
un_geo = -1
un_rstrt = 41
un_ser = -1
un_zono = -1
un_gbusper = 85
*
set_world_view = -1
go4it = .false.
*
call rpn_comm_init ( set_world_view1, myproc, numproc,
$ npex , npey )
err = RPN_COMM_option_L ('halo_ew_ext',.true.)
*
* * Broadcasting commons
*
if (.not.bcastc()) goto 9910
*
call getenvc('rep_from_which_model_is_launched',dfwmil)
*
numpe_perb = npex/nblocx * npey/nblocy
call hpalloc (pagcl , 4*numproc, err,1)
*
* * Processor's topology
*
call rpn_comm_mype ( myproc, myrow, mycol )
err = RPN_COMM_bloc ( nblocx, nblocy )
call RPN_COMM_carac ( npex,npey,myproc,n1,n2,n3,n4,n5,n6,n7,
$ mybloc, myblocx,myblocy,blocme,dumc1 )
npeOpenMP = gnthread()
*
* * Data topology
*
call topoinit ()
*
nk = gnk - 1
ntr = 0
bghyd = 0
edhyd = -1
grdx = Grd_dx
grdy = grdx
satuco = .true.
*
mode = 1
if (modrstrt) mode = 0
cES specific
c if (modrstrt) then
c write (mexmey,'((i3.3),a1,(i3.3))') myrow, '-', mycol
c lacommande='mv process/node*/process/'//mexmey//
c $ ' process 2> /dev/null'
c call system (lacommande)
c endif
*
err = set_run_dir_xy2 (myrow, mycol, mode)
call mc2stop(err)
*
cES specific
c if (modrstrt) then
c lacommande='/bin/rm -rf ../node* 2> /dev/null'
c call system (lacommande)
c endif
*
call set_transpose
*
err = 0
if (modrstrt.and.(myproc.gt.0)) then
open (un_rstrt,file='restart',access='SEQUENTIAL',
$ iostat=err,status='OLD',form='UNFORMATTED')
if (err.ne.0)
$ print*, ' UNABLE TO OPEN RESTART FILE --- ABORT ---'
endif
call mc2stop (err)
*
call gllvls (gnk)
*
call set_sor
*
call nes_initwh
*
call set_solver
*
set_world_view = 0
*
*-------------------------------------------------------------------
9910 return
end
*
***s/r set_world_view1
*
subroutine set_world_view1 (npx,npy),7
implicit none
*
integer npx,npy
*
#include "lun.cdk"
#include "lcldim.cdk"
#include "lesbus.cdk"
#include "partopo.cdk"
#include "path.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "version.cdk"
*
character*256 f_rst
integer err,exdb,longueur,statmc2,statmc2_t,statmc2_s
external exdb,longueur
*
*-------------------------------------------------------------------
*
call open_status_file2 ('status_mod.dot')
call write_status_file2 ('_status=ABORT' )
err = exdb(Version_mod_S//Version_dstp_S,Version_S, 'NON')
*
statmc2_t = 0
un_geo = 33
un_ser = 82
un_zono = 83
*
f_rst='process/000-000/restart'
open (un_rstrt,file=f_rst,access='SEQUENTIAL',iostat=err,
$ status='OLD',form='UNFORMATTED')
if (err.eq.0) then
modrstrt = .true.
else
modrstrt = .false.
endif
*
if (.not.modrstrt) then
theoc = .false.
open (un_geo,file='process/geophy.bin',access='SEQUENTIAL',
$ status='OLD',iostat=err,form='UNFORMATTED')
if (err.ne.0) then
un_geo = -1
theoc = .true.
endif
if (.not.theoc) then
read (un_geo) gni,gnj,hx,hy
call rpilpar (un_geo)
gni=gni-2*hx
gnj=gnj-2*hy
endif
else
un_geo = -1
rewind (un_rstrt)
read (un_rstrt) theoc
read (un_rstrt) gni,gnj,hx,hy
call rpilpar (un_rstrt)
endif
*
*########### Establishing current run configuration ###########
*########### (see MC2 user guide for descriptions) ###########
*
call getenvc('rep_from_which_model_is_launched',dfwmil)
nml = dfwmil(1:longueur(dfwmil))//'/process/model_settings'
*
call mc2ctrl (.true.,statmc2)
npx = npex
npy = npey
*
if ((theoc).or.(sfc_only)) then
if (.not.modrstrt) call theo_cfg (.true.,statmc2_t)
endif
*
call out_ctrl (statmc2_s)
*
geotop = 0
geospc = 0
if (un_geo.gt.0) read (un_geo,end=2) geotop,geospc
*
2 if ((statmc2.ge.0).and.(statmc2_t.ge.0).and.(statmc2_s.ge.0)) then
go4it = .true.
else
if (statmc2 .lt.0) write (6,925) 'STATMC2',statmc2
if (statmc2_s .lt.0) write (6,925) 'STATMC2_S',statmc2_s
if (statmc2_t .lt.0) write (6,925) 'STATMC2_T',statmc2_t
endif
*
100 format (/10x,'***** MC2DM ',a,' -- RUN TIME *****'//)
919 format (/' FILE ',a,' MUST BE AVAILABLE'/)
920 format (/' NUMPROC=',i4,', NPEX=',i3,', NPEY='/)
925 format (/1x,a,'= ',i2/)
*
*-------------------------------------------------------------------
*
return
end
*
subroutine stop_world_view (flag,run_status) 1,6
implicit none
*
logical flag,run_status
include 'mpif.h'
#include "partopo.cdk"
#include "path.cdk"
#include "version.cdk"
#include "nesting.cdk"
#include "cdate.cdk"
#include "rec.cdk"
#include "yomdyn1.cdk"
*
character*256 msg
character*16 nextbcs
integer err,hh,longueur,exfin
real*8 one,sid,rsid,dayfrac
parameter (ONE=1.0d0, sid=86400.0d0)
*
*-------------------------------------------------------------------
*
if (run_status) then
*
if (myproc.eq.0) then
if (flag) then
call write_status_file2 ('_status=RS')
rsid=one/sid
dayfrac = dble(Pil_nesdt)*rsid
call incdatsd (nextbcs,current_nest,dayfrac)
msg='nextbcs='//nextbcs(1:11)
call write_status_file2 (msg)
hh=gnnrstrt*grdt/3600.
write(msg,'(i5.5)') hh+1
msg='nhourbcs='//msg(1:longueur(msg))
call write_status_file2 (msg)
else
call write_status_file2 ('_status=ED')
endif
call close_status_file2 ()
endif
*
endif
*
if (myproc.eq.0)
$ err = exfin(Version_mod_S//Version_dstp_S,Version_S,'OK')
cES specific call system ('cd ../; /bin/rm -f casc geophy')
call MPI_Barrier(MPI_comm_world, err)
call MPI_FINALIZE(err)
*
*-------------------------------------------------------------------
*
return
end