copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
**s/r doninip
*
subroutine doninip ( refip1,lnk,unf,datestp,ip3,donut ) 1,15
implicit none
*
integer ng,lnk,unf,datestp,ip3,donut
integer refip1(lnk+1,3)
*
#include "tracers.cdk"
#include "yomdyn.cdk"
#include "hinterpo.cdk"
*
integer maxnvar
parameter (maxnvar=500)
character*4 trname
character*8 nv(500,2),dum
*
logical flag
integer i,k,inv,nkuv,kind
real pref(lnk)
*
*---------------------------------------------------------------------
*
do i=1,maxnvar
nv(i,1) = '!@#$%^&*'
end do
*
nkuv = lnk
if (gngalsig.eq.1) nkuv = lnk+1
*
if(hint_ntr.eq.'NEAREST') then
* interpolation scalaire des vents
nv(1,2) = 'UU'
call rsdata
( refip1(1,1),nkuv,unf,'UU ',datestp,ip3,nv(1,1),
$ donut )
call rsdata
( refip1(1,1),nkuv,unf,'VV ',datestp,ip3,nv(1,1),
$ donut )
else
* interpolation vectorielle des vents
nv(1,2) = 'UV'
call ruvdata
(refip1(1,1),nkuv,unf,datestp,ip3,nv(1,1),donut)
endif
if (gngalsig.ne.1) then
nv(2,2) = 'TT'
call rsdata
(refip1(1,2),lnk,unf,'TT ',datestp,ip3,nv(2,1),donut)
if (nv(2,1).eq.'!@#$%^&*') then
nv(2,2) = 'VT'
call rsdata
( refip1(1,2),lnk,unf,'VT ',datestp,ip3,nv(2,1),
$ donut )
endif
else
nv(2,2) = 'BUOY'
call rsdata
(refip1(1,2),lnk,unf,'BUOY',datestp,ip3,nv(2,1),donut)
endif
*
nv(3,2) = 'HU'
call rsdata
(refip1(1,2),lnk,unf,'HU ',datestp,ip3,nv(3,1),donut)
if ((nv(3,1).eq.'!@#$%^&*').and.(gngalsig.eq.0)
$ .and.(nv(2,1)(1:2).eq.'TT')) then
nv(3,2) = 'ES'
call rsdata
( refip1(1,2),lnk,unf,'ES ',datestp,ip3,nv(3,1),
$ donut )
endif
*
inv = 4
if (gngalsig.ne.1) then
nv(inv,2) = 'GZ'
call rsdata
(refip1,lnk,unf,'GZ ',datestp,ip3,nv(inv,1),donut)
if (gngalsig.eq.2) then
inv = inv + 1
nv(inv,2) = 'P0'
call rsdata
(0,1,unf,'P0 ',datestp,ip3,nv(inv,1),donut)
else
do i=1,lnk
call convip ( refip1(i,1),pref(i),kind,-1,dum,.false. )
end do
call wrpref
(pref,lnk,donut)
endif
else
nv(inv,2) = 'PREG'
call rsdata
(refip1,nkuv,unf,'PREG',datestp,ip3,nv(inv,1),donut)
call wrht
(unf,donut)
endif
*
flag=.false.
do i=1,inv
if (nv(i,1).eq.'!@#$%^&*') then
write (6,1000) nv(i,2)
flag=.true.
endif
end do
if (flag) stop
*
if (gngalsig.eq.1)
$ call rsdata
( refip1(1,3),lnk,unf,'WZ ',datestp,ip3,nv(inv,1),
$ donut )
*
trname=' '
do i=1,n_tracers
trname = trpil(i)
if (trpil(i).ne."WZ") then
call rsdata
(refip1(1,2),lnk,unf,trname,datestp,
$ ip3,nv(inv+i,1),donut)
endif
end do
*
write (6,1010)
*
1000 format (/' Missing data: ',a,' --- ABORT ---'/)
1010 format (' doninip complete')
*---------------------------------------------------------------------
return
end