copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r sid3df *integer function sid3df (xpaq,ypaq,xpau,ypav,unf,done, 2 $ nia,nja,nka,ntra) implicit none * logical done integer unf,nia,nja,nka,ntra real*8 xpaq(nia), ypaq(nja), xpau(nia), ypav(nja) * #include "ifd.cdk"
#include "bcsgrds.cdk"
#include "partopo.cdk"
* character*4 nomvar integer i,j,k,ni1,nj1,iscala(2),err real htopa real, dimension (: ), allocatable :: zt1 real*8, dimension (: ), allocatable :: xp1,yp1 *----------------------------------------------------------------------- * sid3df = -1 * if (.not.done) then * if (pazta.gt.0) call hpdeallc (pazta, err, 1) pazta = 0 * read (unf,end=33) nomvar,ni1,nj1,ntra allocate (xp1(ni1),yp1(nj1)) read (unf,end=33) xp1,yp1 read (unf,end=33) nomvar,nka,iscala,htopa allocate (zt1(nka)) call hpalloc (pazta ,nka+3 , err,1) read (unf,end=33) zt1 do k=1,nka zta(k) = zt1(k) end do zta (nka+1) = htopa zta (nka+2) = iscala(1) zta (nka+3) = iscala(2) do i=1,nia xpaq(i) = xp1(ifd_niad+i) xpau(i) = 0.5 * (xp1(ifd_niad+i-1) + xp1(ifd_niad+i)) end do do j=1,nja ypaq(j) = yp1(ifd_njad+j) ypav(j) = 0.5 * (yp1(ifd_njad+j-1) + yp1(ifd_njad+j)) end do deallocate (xp1,yp1,zt1) else read (unf,end=33) read (unf,end=33) read (unf,end=33) read (unf,end=33) endif * sid3df = 0 * *----------------------------------------------------------------------- 33 return end