FUNCTION VFSTLIR(fld8, iun, ni, nj, nk, datev, etiket, 59 $ ip1, ip2, ip3, typvar, nomvar) * #if defined (DOC) * ***s/r VFSTLIR -real*8 interface for real*4 function FSTLIR. * *Author : JM Belanger *CMDA/SMC Aug 2000 *Revision: * S. Pellerin *ARMA/SMC Nov. 2001 * . Additionnal return key check * *Arguments: See FSTLIR code for documentation * Input: * iun * datev * etiket * ip1 * ip2 * ip3 * typvar * nomvar * * Output: * fld8 * ni * nj * nk * #endif IMPLICIT NONE *implicits integer vfstlir real*8 fld8(*) integer iun, ni, nj, nk, datev, ip1, ip2, ip3 character*(*) etiket character*(*) nomvar character*(*) typvar * integer key1,key2, ierr, ilen, jk1, jk2, jk3, la real buffer4 pointer (pxbuffer4,buffer4(*)) * integer fstluk, fstinf external fstluk, fstinf *-----7---------------------------------------------------------------- * Get field dimensions and allow memory for REAL copy of fld8. key1 = fstinf(iun, ni, nj, nk, datev, etiket, $ ip1, ip2, ip3, typvar, nomvar) if(key1 >= 0) then ilen = ni*nj*nk call hpalloc(pxbuffer4,max(1,ilen),ierr,1) * Read field key2 = fstluk(buffer4, key1, ni, nj, nk) if(key2 >= 0) then do jk3 = 1,nk do jk2 = 1,nj do jk1 = 1,ni la=jk1+(jk2-1)*ni+(jk3-1)*ni*nj fld8(la) = buffer4(la) enddo enddo enddo endif call hpdeallc(pxbuffer4,ierr,1) endif vfstlir=key1 return end