copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
***s/r nest_intt -- Linear interpolation in time of nesting data
*
subroutine nest_intt (stepno,trname,ntrname,dtf,whenby1) 1,26
implicit none
*
logical whenby1
integer stepno,ntrname
character*8 trname(ntrname)
real dtf
*
*ARGUMENTS
* NAMES I/O TYPE A/S DESCRIPTION
* stepno I I S numero du pas de temps en cours
*
*IMPLICIT
#include "dynmem.cdk"
#include "bcsdim.cdk"
#include "bcsmem.cdk"
#include "bcsgrds.cdk"
#include "ifd.cdk"
#include "lun.cdk"
#include "cdate.cdk"
#include "nesting.cdk"
#include "partopo.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "halo.cdk"
#include "nbcpu.cdk"
*
**
integer bcs_ftype
external bcs_ftype
character*16 datev
character*22 root_filename,filename
character*256 fn
logical nav
integer i,j,k,n,pniterp,nia,nja,nka,open_bmf,i0,in,j0,jn,unf,err,
$ errft(3)
integer yy,mo,dd,hh,mm,ss,dum,ifb,id
real, dimension (:), allocatable :: pa,ua,va,wa,ba,hua,tra
real*8 a,b,dayfrac,tx,dt,pt5,one,sid,rsid
parameter(pt5=0.5d0, one=1.0d0, sid=86400.0d0)
common /DUMMY1/ rsid,dt,tx,dayfrac
*-----------------------------------------------------------------------
*
!$omp single
rsid=one/sid
dt = dble(grdt)
dayfrac = dble(stepno)*abs(dt)*rsid
call incdatsd (datev,gcrunstrt,dayfrac)
call prsdate (yy,mo,dd,hh,mm,ss,dum,datev)
call pdfjdate2 (tx,yy,mo,dd,hh,mm,ss)
*
if (datev.gt.current_nest) then
*
dtf = (tx-tf_nest) * sid / dt
dayfrac = dble(Pil_nesdt)*rsid
call incdatsd (datev,current_nest,dayfrac)
current_nest = datev
call prsdate (yy,mo,dd,hh,mm,ss,dum,current_nest)
call pdfjdate2 (tf_nest,yy,mo,dd,hh,mm,ss)
*
if (stepno.gt.1) then
do i=1,(ntr+6)*bcs_sz+bcs_sz/gnk
bcs_pp(i) = bcs_ppa(i)
end do
else
if (pazta.gt.0) ifd_ftype = '3DF'
endif
*
errft = 0
unf = 76
nav = .false.
err = bcs_ftype (ifd_ftype,errft,datev(1:15),nav,unf)
*
if ((ifd_ftype.eq.'BCS').or.(ifd_ftype.eq.'3DF')) then
*
if (ifd_ftype.eq.'3DF') then
call casc_bcs (trname,datev(1:15),unf)
else if (ifd_ftype.eq.'BCS') then
call casc_bcsh (trname,datev(1:15),unf)
else
write (6,1001)
call mc2stop(-1)
endif
*
else
*
allocate (pa(dim3d+dim2d), ua(dim3d),va(dim3d),wa(dim3d),
$ ba(dim3d),hua(dim3d),tra(dim3d*ntr))
root_filename='../bm'//datev(1:15)//'_'
err = 0
*
if (south_L) then
filename = root_filename(1:21)//'s'
err = open_bmf (filename,nia,nja,nka,gngalsig,halo)
call s_rdvint (ua,va,wa,ba,hua,
$ pa,tra,trname,ntrname,datev,
$ minx,maxx,miny,maxy,gnk,nia,nja,nka,1)
endif
*
if (north_L) then
filename = root_filename(1:21)//'n'
err = open_bmf (filename,nia,nja,nka,gngalsig,halo)
call s_rdvint (ua,va,wa,ba,hua,
$ pa,tra,trname,ntrname,datev,
$ minx,maxx,miny,maxy,gnk,nia,nja,nka,2)
endif
*
if (west_L) then
filename = root_filename(1:21)//'w'
err = open_bmf (filename,nia,nja,nka,gngalsig,halo)
call s_rdvint (ua,va,wa,ba,hua,
$ pa,tra,trname,ntrname,datev,
$ minx,maxx,miny,maxy,gnk,nia,nja,nka,3)
endif
*
if (east_L) then
filename = root_filename(1:21)//'e'
err = open_bmf (filename,nia,nja,nka,gngalsig,halo)
call s_rdvint (ua,va,wa,ba,hua,
$ pa,tra,trname,ntrname,datev,
$ minx,maxx,miny,maxy,gnk,nia,nja,nka,4)
endif
*
call mc2stop (min(err,0))
*
call trnes (ua,bcs_uua(bcs_is),bcs_uua(bcs_in),
$ bcs_uua(bcs_iw),bcs_uua(bcs_ie),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes (va,bcs_vva(bcs_is),bcs_vva(bcs_in),
$ bcs_vva(bcs_iw),bcs_vva(bcs_ie),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes (wa,bcs_wwa(bcs_is),bcs_wwa(bcs_in),
$ bcs_wwa(bcs_iw),bcs_wwa(bcs_ie),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes (ba,bcs_bba(bcs_is),bcs_bba(bcs_in),
$ bcs_bba(bcs_iw),bcs_bba(bcs_ie),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
call trnes (pa,bcs_ppa(bcs_is),bcs_ppa(bcs_inq),
$ bcs_ppa(bcs_iwq),bcs_ppa(bcs_ieq),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk+1)
call trnes (hua,bcs_hua(bcs_is),bcs_hua(bcs_in),
$ bcs_hua(bcs_iw),bcs_hua(bcs_ie),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
do n = 1, ntr
id = (n-1)*bcs_sz+1
call trnes(tra((n-1)*dim3d+1),bcs_tra(id),
$ bcs_tra(id+bcs_in-1),bcs_tra(id+bcs_iw-1),
$ bcs_tra(id+bcs_ie-1),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
end do
*
deallocate (pa,ua,va,wa,ba,hua,tra)
endif
whenby1 = .true.
else
*
dtf = 1.0
*
endif
!$omp end single
!$omp barrier
*
a = (tf_nest-tx)/ (tf_nest - tx + (dble(dtf)*dt * rsid) )
b = one - a
*
do i=1,(ntr+6)*bcs_sz+bcs_sz/gnk
bcs_pp(i) = a*bcs_pp(i) + b*bcs_ppa(i)
end do
*
1001 format (/' WORNG ifd_ftype in nest_intt: --- ABORT ---'/)
*-----------------------------------------------------------------------
return
end