!-------------------------------------- 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 -------------------------------------- ! C C X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X Csubroutine outhoriz2d(pfield,cdfile,cdfield,klev, 7 & ibeg,iend,jbeg,jend,kni,knj,knk) * ***s/r outhoriz2d - Output (ni,nj) field on desired level klev. * . * *Author : L. Fillion *CGD/NCAR - 15 apr 05 * . *Revision: *Arguments * . pfield : Field to be written on file. * . cdfile : name of the output file. * . cdfield : name of the output field. * implicit none character*14 cdfile character*2 cdfield integer ibeg,iend,jbeg,jend integer kni,knj,knk,klev real*8 pfield(kni,knk,knj) * #include "taglam4d.cdk"
#include "comct0.cdk"
#include "comlun.cdk"
#include "comlunla.cdk"
! integer ji,jj,jk,idim,jdim ! !! idim=iend-ibeg+1 jdim=jend-jbeg+1 close(nutemp) open (unit=nutemp,file=cdfile) write(nutemp,910) idim,jdim,knk write(nutemp,'(A2)') cdfield jk = klev write(nutemp,920) jk do ji = ibeg, iend do jj = jbeg, jend-1 if(iend.eq.1) then write(nutemp,800) (pfield(ji,jj,jk)) else write(nutemp,900) (pfield(ji,jj,jk)) endif enddo jj = jend write(nutemp,901) (pfield(ji,jj,jk)) enddo close(nutemp) ! 800 format(E13.7) 900 format(E13.7,1X,$) 901 format(E13.7) 910 format(3(I4,1X)) 920 format(I4) ! return end