!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- !SUBROUTINE VEZSINT(zout8, zin8, nio, njo, nko, nii, nji, nki) * #if defined (DOC) * ***s/r VEZSINT -real*8 interface for real*4 subroutine EZSINT. * *Author : JM Belanger *CMDA/SMC Aug 2000 *Revision: * *Arguments: See EZSINT code for documentation * Input: * zin8 * nii * nji * nki * nio * njo * nko * * Output: * zout8 #endif IMPLICIT NONE *implicits integer nii, nji, nki, nio, njo, nko real*8 zout8(nio,njo,nko),zin8(nii,nji,nki) * integer ierr, ileni, ileno, jk1, jk2, jk3 real bufferi4, buffero4 pointer (pxbufferi4,bufferi4(nii,nji,nki)) pointer (pxbuffero4,buffero4(nio,njo,nko)) * integer ezsint external ezsint *-----7---------------------------------------------------------------- ileni = nii*nji*nki ileno = nio*njo*nko call hpalloc(pxbufferi4,max(1,ileni),ierr,1) call hpalloc(pxbuffero4,max(1,ileno),ierr,1) do jk3 = 1,nki do jk2 = 1,nji do jk1 = 1,nii bufferi4(jk1,jk2,jk3) = zin8(jk1,jk2,jk3) enddo enddo enddo ierr = ezsint(buffero4,bufferi4) do jk3 = 1,nko do jk2 = 1,njo do jk1 = 1,nio zout8(jk1,jk2,jk3) = buffero4(jk1,jk2,jk3) enddo enddo enddo call hpdeallc(pxbufferi4,ierr,1) call hpdeallc(pxbuffero4,ierr,1) return end