!-------------------------------------- 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 maxmin(pfield,kni,knj,knk,pmin,pmax, 174 & kimin,kimax,kjmin,kjmax,cdsub,cdfield) * ***s/r maxmin - Finds max and min of input field. * *Author : L. Fillion - CGD/NCAR - 15 oct 99 *Revision: * L. Fillion - ARMA/EC - 16 Sept 2009 - Print kni,knj,knk to facilitate understanding of printout!. * IMPLICIT NONE character*15 cdsub character*3 cdfield integer kimax,kjmax,kkmax,kimin,kjmin,kkmin integer kni,knj,knk real*8 pmax,pmin,pfield(kni,knk,knj) *implicits #include "taglam4d.cdk"
#include "comlun.cdk"
* logical llprint integer ji,jj,jk real*8 zoldmax,zoldmin * ** llprint = .true. pmax=-1.e32 pmin=1.e32 kimax=1 kjmax=1 kkmax=1 kimin=1 kjmin=1 kkmin=1 do ji=1,kni do jj=1,knj do jk=1,knk zoldmax=pmax zoldmin=pmin if(pfield(ji,jk,jj).gt.pmax) then pmax=pfield(ji,jk,jj) kimax=ji kjmax=jj kkmax=jk endif if(pfield(ji,jk,jj).lt.pmin) then pmin=pfield(ji,jk,jj) kimin=ji kjmin=jj kkmin=jk endif enddo enddo enddo c if(llprint) then write(nulout,*) ' ' write(nulout,*) 'maxmin: calling subroutine ',cdsub write(nulout,*) '*******************************************' write(nulout,*) 'maxmin: Field name = ',cdfield write(nulout,*) 'maxmin: kni,knj,knk = ',kni,knj,knk write(nulout,*) 'maxmin: (i,j,k)min = ',kimin,kjmin,kkmin write(nulout,*) 'maxmin: (i,j,k)max = ',kimax,kjmax,kkmax write(nulout,*) 'maxmin: min, max = ',pmin,pmax write(nulout,*) ' ' write(nulout,*) 'maxmin: Dimensions: kni,knj,knk=',kni,knj,knk if(kimin.gt.kni) then write(nulout,*) 'maxmin: problem: kimin.gt.kni',kimin,kni else if(kimax.gt.kni) then write(nulout,*) 'maxmin: problem: kimax.gt.kni',kimax,kni endif if(kjmin.gt.knj) then write(nulout,*) 'maxmin: problem: kjmin.gt.knj',kjmin,knj else if(kjmax.gt.knj) then write(nulout,*) 'maxmin: problem: kjmax.gt.knj',kjmax,knj endif if(kkmin.gt.knk) then write(nulout,*) 'maxmin: problem: kkmin.gt.knk',kkmin,knk else if(kkmax.gt.knk) then write(nulout,*) 'maxmin: problem: kkmax.gt.knk',kkmax,knk endif endif c return end