FUNCTION VFSTECR(fld8, work, npak, iun, dateo, deet, 153 $ npas, ni, nj, nk, ip1, ip2, ip3, typvar, $ nomvar, etiket, grtyp, ig1, ig2, ig3, ig4, $ datyp, rewrit) * #if defined (DOC) * ***s/r VFSTECR -real*8 interface for real*4 function FSTECR. * *Author : JM Belanger *CMDA/SMC Aug 2000 *Revision: * *Arguments: See FSTECR code for documentation * Input: * all * * Output: * none * #endif IMPLICIT NONE *implicits integer vfstecr real work(*) real*8 fld8(ni,nj,nk) integer iun, ni, nj, nk, datev, ip1, ip2, ip3, ig1, ig2, ig3, ig4 integer npak, dateo, deet, npas, datyp, rewrit character*(*) etiket character*(*) typvar character*1 grtyp character*(*) nomvar * integer ikey, ierr, ilen, jk1, jk2, jk3 real buffer4 pointer (pxbuffer4,buffer4(ni,nj,nk)) * integer fstecr external fstecr *-----7---------------------------------------------------------------- ilen = ni*nj*nk call hpalloc(pxbuffer4,max(1,ilen),ierr,1) do jk3 = 1,nk do jk2 = 1,nj do jk1 = 1,ni buffer4(jk1,jk2,jk3) = fld8(jk1,jk2,jk3) enddo enddo enddo ikey = fstecr(buffer4, work, npak, iun, dateo, deet, $ npas, ni, nj, nk, ip1, ip2, ip3, typvar, nomvar, $ etiket, grtyp, ig1, ig2, ig3, ig4, datyp, rewrit) call hpdeallc(pxbuffer4,ierr,1) vfstecr=ikey return end