copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
***s/r initcond
*
subroutine initcond (geobus,trname,ntrname) 1,16
implicit none
*
integer ntrname
character*8 trname(ntrname)
real geobus(*)
*
*OBJECT
* Obtains initial conditions at gcrunstrt
*
**
#include "cdate.cdk"
#include "nesting.cdk"
#include "dynmem.cdk"
#include "tracers.cdk"
#include "bcsdim.cdk"
#include "bcsmem.cdk"
#include "bcsgrds.cdk"
#include "yomdyn.cdk"
#include "lun.cdk"
#include "partopo.cdk"
*
integer nav_3df
external nav_3df
character*3 nmr,nmc
character*16 datev
character*28 filename
character*256 fn
integer i,j,k,n,dim,halo,nia,nja,nka,open_bmf,err,
$ yy,mo,dd,hh,mm,ss,ncpu,errop,unf,id
real s,d
pointer (pas ,s(*)),(pad ,d(*))
*---------------------------------------------------------------------
*
unf = 76
fn = '../casc/3df_filemap.txt'
open (unf,file=fn,access='SEQUENTIAL',status='OLD',
$ iostat=errop,form='FORMATTED')
*
if ( errop.eq.0 ) then
*
err = nav_3df
(unf,hx,hy,1.2)
call mc2stop
(err)
call casc_3df
(geobus,trname,gni+2*hx,gnj+2*hy,unf)
*
else
*
pazta = 0
write(nmr,'(i3.3)') mycol
write(nmc,'(i3.3)') myrow
filename='../bm'//gcrunstrt(1:15)//'_'//nmc//'_'//nmr
*
err = open_bmf
(filename,nia,nja,nka,gngalsig,halo)
*
err = 0
if ( (nia.ne.(ldni+hx*(west +east )+1)) .and.
$ (nja.ne.(ldnj+hy*(south+north)+1)) ) then
write (6,1005) filename
err = -1
endif
call mc2stop
(err)
*
call s_rdvint
(uup,vvp,wwp,bbp,hup,ppp,trp,trname,ntrname,
$ gcrunstrt,minx,maxx,miny,maxy,gnk,nia,nja,nka,0)
*
endif
*
dim = ndynvar*dim3d+dim2d
pas = pappp
pad = papp0
do i=1,dim
d(i) = s(i)
end do
*
call trnes
(uup,bcs_uu(bcs_is),bcs_uu(bcs_in),bcs_uu(bcs_iw),
$ bcs_uu(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes
(vvp,bcs_vv(bcs_is),bcs_vv(bcs_in),bcs_vv(bcs_iw),
$ bcs_vv(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes
(wwp,bcs_ww(bcs_is),bcs_ww(bcs_in),bcs_ww(bcs_iw),
$ bcs_ww(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes
(bbp,bcs_bb(bcs_is),bcs_bb(bcs_in),bcs_bb(bcs_iw),
$ bcs_bb(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes
(ppp,bcs_pp(bcs_is),bcs_pp(bcs_inq),bcs_pp(bcs_iwq),
$ bcs_pp(bcs_ieq),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk+1)
call trnes
(hup,bcs_hu(bcs_is),bcs_hu(bcs_in),bcs_hu(bcs_iw),
$ bcs_hu(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
*
if ((glconta).and.(iconta.ne.0)) then
id = (iconta-1)*bcs_sz+1
do i=1,bcs_sz
bcs_tr(id+i-1) = 1.
end do
call nesajr
$ (trp(1-hx,1-hy,1,iconta),bcs_tr(id),bcs_tr(id+bcs_in-1),
$ bcs_tr(id+bcs_iw-1),bcs_tr(id+bcs_ie-1),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk,1,1)
endif
*
do 30 n = 1, ntr
if (n.eq.iconta) goto 30
id = (n-1)*bcs_sz+1
call trnes
(trp(1-hx,1-hy,1,n),bcs_tr(id),bcs_tr(id+bcs_in-1),
$ bcs_tr(id+bcs_iw-1),bcs_tr(id+bcs_ie-1),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
30 continue
*
current_nest = gcrunstrt
call prsdate
(yy,mo,dd,hh,mm,ss,err,current_nest)
call pdfjdate2
(tf_nest,yy,mo,dd,hh,mm,ss)
*
if (ctebcs) then
do i=1,(ntr+6)*bcs_sz+bcs_sz/gnk
bcs_ppa(i) = bcs_pp(i)
end do
endif
*
wall = .false. ! open boundaries
*
1005 format (/' WRONG GRID DIMENSION IN BMF FILE: ',a,
$ ' --- ABORT in INITCOND ---'/)
*---------------------------------------------------------------------
return
end