copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
logical function bcastc (),3
implicit none
*
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "rec.cdk"
#include "grd.cdk"
#include "mtn.cdk"
#include "nesting.cdk"
#include "nbcpu.cdk"
#include "levels.cdk"
#include "physcom.cdk"
#include "solver.cdk"
#include "lcldim.cdk"
#include "nestpnt.cdk"
#include "lesbus.cdk"
#include "cdate.cdk"
#include "semilag.cdk"
#include "hinterpo.cdk"
#include "vinterpo.cdk"
#include "partopo.cdk"
#include "topo.cdk"
*
include "mpif.h"
*
logical inictes
integer nw,fact,ierr,lunout,bidon(2), l2, l1
real*8 dayfrac,sec_in_day
parameter (sec_in_day=86400.0d0)
*------------------------------------------------------------------
bcastc = .false.
*
l2 = loc(bidon(2))
l1 = loc(bidon(1))
fact = l2 - l1
*
l2 = loc(endgrdi)
l1 = loc(Grd_ni )
nw = ( l2 - l1 ) / fact
call MPI_bcast (Grd_ni ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
l2 = loc(endydi )
l1 = loc(gnmaphy )
nw = ( l2 - l1 ) / fact
call MPI_bcast (gnmaphy ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
call RPN_COMM_bcst_world ( yomdyn1_i_first, yomdyn1_i_last, 0 )
call RPN_COMM_bcst_world ( rec_i_first, rec_i_last, 0 )
call RPN_COMM_bcst_world ( nesting_i_first, nesting_i_last, 0 )
l2 = loc(endnesti )
l1 = loc(hblen_x )
nw = ( l2 - l1 ) / fact
call MPI_bcast(hblen_x ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
l2 = loc(endldimi )
l1 = loc(gni )
nw = ( l2 - l1 ) / fact
call MPI_bcast (gni ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
*
l2 = loc(endsoli )
l1 = loc(maxite )
nw = ( l2 - l1 ) / fact
call MPI_bcast (maxite ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
l2 = loc(endsl_i )
l1 = loc(Tsl_iter)
nw = ( l2 - l1 ) / fact
call MPI_bcast (Tsl_iter ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
l2 = loc(endtopo )
l1 = loc(nblocx )
nw = ( l2 - l1 ) / fact
call MPI_bcast (nblocx ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
l2 = loc(endmtn_i )
l1 = loc(mtn_hwx )
nw = ( l2 - l1 ) / fact
call MPI_bcast (mtn_hwx ,nw,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast (geotop ,1 ,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast (geospc ,1 ,MPI_INTEGER,0,MPI_COMM_WORLD,ierr )
*
l2 = loc(endgrdr )
l1 = loc(Grd_latr )
nw = ( l2 - l1 ) / fact
call MPI_bcast (Grd_latr ,nw,MPI_REAL ,0,MPI_COMM_WORLD,ierr )
call MPI_bcast (grtstar ,nw,MPI_REAL ,0,MPI_COMM_WORLD,ierr )
call RPN_COMM_bcst_world ( yomdyn1_r_first, yomdyn1_r_last, 0 )
call RPN_COMM_bcst_world ( rec_r_first, rec_r_last, 0 )
call RPN_COMM_bcst_world ( nesting_r_first, nesting_r_last, 0 )
l2 = loc(endtopo_r )
l1 = loc(topo_flt_nu)
nw = ( l2 - l1 ) / fact
call MPI_bcast (topo_flt_nu,nw,MPI_REAL ,0,MPI_COMM_WORLD,ierr )
l2 = loc(endnestr )
l1 = loc(grpilver )
nw = ( l2 - l1 ) / fact
call MPI_bcast (grpilver ,nw,MPI_REAL ,0,MPI_COMM_WORLD,ierr )
l2 = loc(endlvlr )
l1 = loc(zt )
nw = ( l2 - l1 ) / fact
call MPI_bcast (zt ,nw,MPI_REAL ,0,MPI_COMM_WORLD,ierr )
l2 = loc(endsolr )
l1 = loc(hsolvpre)
nw = ( l2 - l1 ) / fact
call MPI_bcast (hsolvpre ,nw,MPI_REAL ,0,MPI_COMM_WORLD,ierr )
l2 = loc(endmtn_r )
l1 = loc(mtn_heigth)
nw = ( l2 - l1 ) / fact
call MPI_bcast (mtn_heigth ,nw,MPI_REAL ,0,MPI_COMM_WORLD,ierr )
call RPN_COMM_bcst_world ( nesting_r8_first, nesting_r8_last, 0 )
*
call RPN_COMM_bcst_world ( nesting_l_first, nesting_l_last, 0 )
l2 = loc(endydl )
l1 = loc(glconta )
nw = ( l2 - l1 ) / fact
call MPI_bcast (glconta ,nw,MPI_LOGICAL ,0,MPI_COMM_WORLD,ierr )
l2 = loc(endsoll )
l1 = loc(diagres )
nw = ( l2 - l1 ) / fact
call MPI_bcast (diagres ,nw,MPI_LOGICAL ,0,MPI_COMM_WORLD,ierr )
l2 = loc(endsl_L )
l1 = loc(Tsl_ic )
nw = ( l2 - l1 ) / fact
call MPI_bcast (Tsl_ic ,nw,MPI_LOGICAL ,0,MPI_COMM_WORLD,ierr )
*
call MPI_bcast
$ (Grd_proj_S, 1, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr)
call MPI_bcast
$ (gcrunstrt, 64, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast
$ (theocase , 24, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast
$ (precond, 8, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
*
call RPN_COMM_bcst_world ( yomdyn1_c_first, yomdyn1_c_last, 0 )
call RPN_COMM_bcst_world ( rec_c_first, rec_c_last, 0 )
call RPN_COMM_bcst_world ( nesting_c_first, nesting_c_last, 0 )
*
call MPI_bcast
$ (hint_ntr, 64, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast
$ (v_interp, 32, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast
$ (Grdc_trnm_S,max_trnm*4,MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast
$ (Grdc_nfe, 12, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast
$ (Grdc_runstrt_S,16, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
call MPI_bcast
$ (mtn_typ, 1, MPI_CHARACTER,0,MPI_COMM_WORLD,ierr )
dayfrac=dble(gnstepno)*dble(grdt)/sec_in_day
call incdatsd(gcjobstrt,gcrunstrt,dayfrac)
dayfrac=dble(gnstepno+gnnrstrt)*dble(grdt)/sec_in_day
call incdatsd(gcjobend,gcrunstrt,dayfrac)
dayfrac=dble(gnnt)*dble(grdt)/sec_in_day
call incdatsd(gcrunend,gcrunstrt,dayfrac)
*
if (.not.go4it) then
if (myproc.eq.0) write (6,9100)
goto 9988
endif
*
lunout=-1
if (myproc.eq.0) lunout=6
if (.not.inictes(lunout)) then
if (myproc.eq.0) write (6,9110)
goto 9988
endif
*
bcastc = .true.
*
9100 format (/,' --ABORT--ABORT--ABORT-- in BCASTC'/)
9110 format (/,' PROBLEM INITIALIZATING PHYSICAL CONSTANTS',/)
*
*------------------------------------------------------------------
*
9988 return
end