Paolo Bonzini wrote:
Toon Moene wrote:
H.J. Lu wrote:
If you can provide a testcase, I can take a look. If it isn't easy to
find
a testcase, please disable the second pattern:
(define_peephole2
[(set (match_operand 0 "register_operand" "")
(match_operand 1 "register_operand" ""))
(set (match_dup 0)
(match_operator 3 "commutative_operator"
[(match_dup 0)
(match_operand 2 "memory_operand" "")]))]
"operands[0] != operands[1]
&& ((MMX_REG_P (operands[0]) && MMX_REG_P (operands[1]))
|| (SSE_REG_P (operands[0]) && SSE_REG_P (operands[1])))"
[(set (match_dup 0) (match_dup 2))
(set (match_dup 0)
(match_op_dup 3 [(match_dup 0) (match_dup 1)]))]
"")
to see if it makes a difference.
Thanks. Test case is hard, but this is easy to try. Expect an answer
from me tomorrow (e.g. 12 UTC).
In case it does *not* make a difference, please try this patch:
Ah, but it did: throwing out the second peephole (in stead of both)
fixed the problem too.
Attached you'll find the (preprocessed) source of the routine that
printed the Infinity's (of course, I cannot be completely certain that
it actually resulted in the wrong code, but at least it might be studied
to see if it helps to find the culprit).
Kind regards,
--
Toon Moene, KNMI (Weer/Onderzoek), The Netherlands
Phone: +31 30 2206443; e-mail: mo...@knmi.nl
# 1 "/scratch/hirlam/hl_home/MPI/lib/src/grdy/statin.F"
# 1 "<built-in>"
# 1 "<command-line>"
# 1 "/scratch/hirlam/hl_home/MPI/lib/src/grdy/statin.F"
c Library:grdy $Id: statin.F 6492 2008-12-11 13:32:55Z ksa $
c
SUBROUTINE STATIN(KLON,KLAT,
* PSTRATR,PCONVECR,
* PSENF,PLATF,PMOMF,
* CWPATH,COV2D,CLOUD2D,
* RHXU,RHYV)
C
IMPLICIT NONE
C
C**** *STATIN* - statistical computation of 2D physical quantities
C
C XIAOHUA YANG, DMI, 1998.01.01
C
C PURPOSE
C --------
C
C claculate domain averaged 2D physics fields at each time step
C
C** INTERFACE
C ---------
C
C *STATIN* is called from GEMINI or FULDFI.
C
C INPUT PARAMETERS
C ----------------
C
C *KLON* number of gridpoints in X-direction
C *KLAT* number of gridpoints in X-direction
C *PSTRATR* accumulated stratiform rain
C *PCONVECR* accumulated convective rain
C *PSENF* nsible Heat Flux
C *PLATF* tent Heat Flux
C *PMOMF* mentum Flux
C *CWPATH* iquid water path (integrated liquid water)
C *COV2D* total cloud cover
C *CLOUD2D* 2d high,medium,low,lowest cloud covers and
C cloud base, cloud top heights
C
# 1 "/scratch/hirlam/hl_home/MPI/lib/src/common/include/PARAMM.inc" 1
C Library: common/include $Id: PARAMM.inc 4888 2007-01-26 12:47:16Z xiaohua $
C-------------------------------------------------------------------
C
C* Parameter statement for the maximum number of extra scalars
INTEGER, PARAMETER :: msvar = 2
C* Number of radoro directions
INTEGER, PARAMETER :: nradir = 8
C* Size of COMDDR
INTEGER, PARAMETER :: jpnslfx = 201 + 4*nradir + 2
INTEGER, PARAMETER :: jpnmlfx = 40
INTEGER, PARAMETER :: jplevx = 100
INTEGER, PARAMETER :: jpnmlhf = 8
C--------------------------------------------------------------------
# 41 "/scratch/hirlam/hl_home/MPI/lib/src/grdy/statin.F" 2
# 1 "/scratch/hirlam/hl_home/MPI/lib/src/grdy/COMHKP.inc" 1
C Library:grdy $Id: COMHKP.inc 6720 2009-02-27 08:40:06Z ovignes $
C
C* COMMON *COMHKP* - HOUSE KEEPING PARAMETERS
C
C Temporary we have maximum values given by PARAMETER statement
C
INTEGER
I MLEV_MAX
I , MSVAR_MAX
I , MLEV_VAR_MAX
I , NLEN_COMHKP_int
I , NLEN_COMHKP_rea
I , NLEN_COMHKP_cha
I , NLEN_COMHKP_log
PARAMETER (MLEV_MAX=jplevx,MSVAR_MAX=MSVAR)
PARAMETER (MLEV_VAR_MAX=MLEV_MAX*(5+MSVAR_MAX))
C---------------------------------------------------
c PLEASE DO NOT FORGET TO
c INCREASE ARRAY LENGHTS WHEN ADDING NEW PARAMETERS
C---------------------------------------------------
PARAMETER ( NLEN_COMHKP_int=449 + 2*MSVAR_MAX)
PARAMETER ( NLEN_COMHKP_rea =
$ 139
$ + 3*(MLEV_MAX+1)
$ + 14*MLEV_MAX
$ + 6*MLEV_MAX*MLEV_MAX
$ + 2*MLEV_VAR_MAX)
PARAMETER ( NLEN_COMHKP_log = 31 + 3*MSVAR_MAX)
COMMON / COMHKP_int /
I NSTEP ! time step counter (nstep=0,1,...,nstop)
I , NSTOP ! number of time steps
I , NTYP ! number of surface types
I , NYEAR ! current year (at time step nstep)
I , NMONTH ! current month (at step nstep)
I , NDAY ! current day (at time nstep)
I , NHOUR ! current hour (at time step nstep)
I , NMIN ! current minute (at time step nstep)
I , NSEC ! current second (at timestep nstep)
I , NCBASE ! time for start data set (yymmdd)
I , NTBASE ! hour for start dataset
I , NTDATA ! second for start data set
I , LAMCHO ! choise of lam formulation concerning
! discretization at the uppermost
! level=1 for Eulerian time scheme
! =2 for semi-Lagrangian time scheme
I , NEXP ! switch for experiment name
! =0:experiment name taken from the start
! data set
! =1:experiment name given as input
! (last input line)
I , NWPTR ! pointer to the elements of array nwtime
I , NWTIME(100) ! list of time steps for output model level
! data sets
I , NSTPHI
I , NWMOSV(MSVAR_MAX)
C EXTRACTION OF DATA TO BE PRINTED
I , NEXTRD ! no of gridpoints for print of model level data
I , NEXTRX(40) ! list of gridpoints in x-direction,i=1,nextrd
I , NEXTRY(40) ! list of gridpoints in y-direction,i=1,nextrd
C Horizontal diffusion constants
! degree of impl. horizontal diffusion for
! different variables (can be 2, 4, 6)
I , NDIFU ! horizontal velocity component u
I , NDIFV ! horizontal velocity component v
I , NDIFT ! temperature
I , NDIFQ ! specific humidity
I , NDIFS ! specific cloud water
I , NDIFX(MSVAR_MAX) ! extra scalar prognostic variables
C COMPUTED STATISTICS
I , NMAXWX ! gridpoint in x-direction with max horizontal
! wind velocity
I , NMAXWY ! gridpoint in y-direction with max horizontal
! wind velocity
I , NMAXWK ! vertical level with max horizontal velocity
C BOUNDARY RELAXATIONS CONSTANTS
I , LUBFI1 ! unit for first boundary data set (=lushfi)
I , LUBFI2 ! unit for second boundary data set
! (following boundary data sets are assumed
! to be lubfi2+1,lubfi2+2,...)
I , NBDNUM ! pointer to current boundary data set
I , NBDPTS ! number of gridpoints in the boundary
! relaxation zone for the boundary relaxation
! function alfab
! alfab=1.0 in gridpoint i=1+npbpts
! alfab=0.0 in gridpoint i=nbdpts+1+npbpts
I , NBHOUR(100)
I , NBDDIF
I , NBDTIM ! time counter for interpolation between
! boundary data sets
I , NMLFLD ! number of multi level boundary variables
! (u,v,T,q,s,sdot)
C* COMMON *COMIMP* - CONSTANTS FOR IMPLICIT SCHEMES
I , NFAX(10) ! list of factors for the Fourier transformation
I , NITYPH ! iteration type for iterative Helmholtz solver
I , NPTYPH ! preconditioning type for iterative Helmholtz solver
C* COMMON *COMSLA* - SEMI-LAGRANGIAN CONSTANTS
I , NPBPTS ! number of extra (passive) boundary lines
! where the boundary relaxation function
! alfab=1.0 (the total with of the relaxation
! zone is npbpts+nbdpts, but the list
! bdffunc(i) should be only given for
! i=1,nbdpts sa if npbpts=0) nslext type of
! extrapolation to time n+1/2 in
! semi-Lagrangian scheme
! =1 : f(n+1/2)=f(n)
! =2 : f(n+1/2)=f(n,n-1)
! =2 : f(n+1/2)=f(n,n-1,n-2)
I , NHALO ! number of gridpoints in halo-zone
I , NSLEXT
I , NSLPQI ! number of iterations for calculation of
! displacement in the semi-Lagrangian scheme
I , NSLINC ! type of interpolation at the midpoint
! in the semi-Lagrangian scheme (not used)
I , NSLIND ! type of interpolation at the departure
! point in the semi-Lagrangian scheme
! =1 linear, =2 quadratic =3 mixed linear/cubic
I , NSLINT(100) ! list of interpolation types for each iteration
! i=1,nslpqui
! =1 linear, =2 quadratic =3 mixed linear/cubic
I , NOPTION(20) ! = option array to select schemes in physics
C
INTEGER
I NSTEP , NSTOP , NTYP
I , NYEAR , NMONTH , NDAY , NHOUR , NMIN , NSEC
I , NCBASE , NTBASE , NTDATA
I , LAMCHO , NEXP , NWPTR , NWTIME
I , NSTPHI
I , NEXTRD , NEXTRX , NEXTRY
I , NDIFU , NDIFV , NDIFT , NDIFQ , NDIFS
I , NDIFX
I , NMAXWX , NMAXWY , NMAXWK
I , LUBFI1 , LUBFI2 , NBDNUM , NBDPTS , NBHOUR
I , NBDDIF , NBDTIM
I , NMLFLD , NBDPTR
I , NFAX , NITYPH , NPTYPH
I , NPBPTS , NHALO
I , NSLEXT , NSLPQI , NSLINC , NSLIND , NSLINT
I , NOPTION, NWMOSV
C-------------------------------------------------------------------
COMMON / COMHKP_rea /
R TDATA ! time of the day in seconds
R , TWODT ! douple timestep (2*dt) in seconds
R , EPS ! coefficent for Asselin time filtering and
! time filtering for surface physics fields
R , DTPHYS ! timestep for physics in seconds
R , DTVDIF ! timestep for vertical diffusion in seconds
R , TIMESU ! spinup time in seconds (the physics is called
! at every dynamic timestep during spinup time)
C Geographical area etc
R , ANORTH ! northern boundary (degrees)
R , WEST ! western boundary (degrees)
R , SOUTH ! southern boundary (degrees)
R , EAST ! eastern boundary (degrees)
R , APLON ! longitude of rotated south pole (degrees)
R , APLAT ! latitude of rotated south pole (degrees)
R , DLAMDA ! grid distance in x-direction (degrees)
R , DTHETA ! grid distance in y-direction (degrees)
R , RDLAM ! inverse grid distance in x-direction (radians)
R , RDTH ! inverse grid distance in y-direction (radians)
R , RA ! inverse radius of the earth (meter)
C Vertical constants (replaced in F90)
R , AHYB(MLEV_MAX+1) ! A for model half level definition (p=a+b*ps)
R , BHYB(MLEV_MAX+1) ! B for model half level definition (p=a+b*ps)
R , HYBI(MLEV_MAX+1)
R , HYBK(MLEV_MAX)
C Horizontal diffusion constants
R , RPRERS
R , RTEMRS ! reference temperature Trs
R , RTEMRT ! reference temperature Trt
R , AK4 ! diffusion coefficient for 2nd order hor. diffu
R , ATCREF(MLEV_MAX)! list of coefficients for temperature
! along pseudo pressure levels
R , CDIFU(MLEV_MAX)
R , CDIFV(MLEV_MAX)
R , CDIFT(MLEV_MAX)
R , CDIFQ(MLEV_MAX)
R , CDIFS(MLEV_MAX)
R , AK4LEV(MLEV_VAR_MAX)
R , CDIFX(MLEV_VAR_MAX)
C COMPUTED STATISTICS
R , STPS ! area mean surface pressure
R , STQ ! area mean vertically integrated specific humid
R , STS ! area mean vertically integrated cloud water
R , STPE ! area mean vertically integrated potential ener
R , STKE ! area mean vertically integrated kinetic energy
R , STTE ! area mean vertically integrated total energy
R , CMAXWI ! maximum horizontal velocity (m/s)
R , CABSDP ! mean absolute pressure tendency (hPa/3 hours)
C BOUNDARY RELAXATIONS CONSTANTS
R , TIMRAT ! time rate for interpolation between boundary
! data sets
R , BDFUNC(100) ! list of values for boundary relaxation functio
! alfab if ntalnh=.false. in the interval
! [1.0 ... 0.0>
! bdfunc = 1.0 in gridpoint i=i+1npbpts
! bdfunc = 0.0 in gridpoint i=nbdpts+1+npbpts
C* CONSTANTS USED NORMAL MODE INITALIZATION
R , EDEPTH(MLEV_MAX) ! list of depths for vertical normal modes
R , GMAT (MLEV_MAX*MLEV_MAX)
! vertical structure function G
R , GMATI (MLEV_MAX*MLEV_MAX)
! inverse vertical structure function
R , PMAT (MLEV_MAX*MLEV_MAX)
! vertical coupling matrix gamma for the
! auxillary variable P
R , PMATI (MLEV_MAX*MLEV_MAX)
! inverse of vertical coupling matrix
R , FFMEAN ! mean value of Coriolis parameter
R , RHXUMM ! inverse mean of mapfactor in x-direction
R , RHYVMM ! inverse mean of mapfactor in y-direction
C* CONSTANTS FOR IMPLICIT SCHEMES
R , SIT0 ! reference temperature (Kelvin)
R , SIP0 ! reference surface presssure (Pa)
R , SITAU1(MLEV_MAX) ! list of level dependent coefficients in the
! linear term in the thermodynamic equation
R , SITAU2(MLEV_MAX) ! list of level dependent coefficients in the
! linear term in the thermodynamic equation
R , SIGAM1(MLEV_MAX) ! list of level dependent coefficients in the
! linear term in the hydrostatic equation
R , SIGAM2(MLEV_MAX) ! list of level dependent coefficients in the
! linear term in the hydrostatic equation
R , SIDPK0(MLEV_MAX) ! list of level dependent coefficients in the
! linear term in the continuity equation
R , EIG(MLEV_MAX*MLEV_MAX)
! eigenvector matrix for vertical decoupling
R , EIGINV(MLEV_MAX*MLEV_MAX)
! eigenvector matrix for vertical coupling
R , C2 (MLEV_MAX) ! eigenvalues for normal modes
R , EPSG ! coefficient fot the gravity wave damper in
! the semi-Lagrangian sckeme
R , AERRIH ! abs. error tol. for iterative Helmholtz solver
R , RERRIH ! rel. error tol. for iterative Helmholtz solver
C* SEMI-LAGRANGIAN CONSTANTS
R , EPSN
REAL
R TDATA , TWODT , EPS
R , DTPHYS , DTVDIF , TIMESU
R , ANORTH , WEST , SOUTH , EAST , APLON , APLAT
R , DLAMDA , DTHETA , RDLAM , RDTH , RA
R , AHYB , BHYB
R , RPRERS , RTEMRS , RTEMRT
R , AK4 , ATCREF , AK4LEV
R , CDIFU , CDIFV , CDIFT , CDIFQ
R , CDIFS , CDIFX
R , STPS , STQ , STS , STPE , STKE , STTE
R , CMAXWI
R , CABSDP
R , TIMRAT , BDFUNC
R , EDEPTH
R , GMAT , GMATI
R , PMAT , PMATI
R , FFMEAN , RHXUMM , RHYVMM
R , SIT0 , SIP0 , SITAU1 , SITAU2
R , SIGAM1 , SIGAM2 , SIDPK0
R , EIG , EIGINV , C2
R , EPSG , AERRIH , RERRIH
R , EPSN
R , HYBI , HYBK
C-------------------------------------------------------------------
COMMON / COMHKP_log /
L NLGRIB ! .true. if grib input format
L , NLEUL ! .true. if Eulerian time scheme
L , NLSAPP ! .true. if stand-alone post-processing
L , NLSIMP ! .true. if semi-implicit sheme
L , NLPHYS ! .true. if physical paramerization
L , NLSTAT ! .true. if computation and print of statics
L , NLHDIF ! .true. if explicit hor. diffusion in dynamics
L , NLTVIR ! .true. if virtual temperature in dynamics
L , NLHUMC ! .true. if check of critical humidity for
! input data
L , NLDYNVD ! .true. if dynamic tendency used in the
! vertical diffusion scheme
L , NLSTPH ! .true. if statistics computations in physics
L , NLSTPH2D ! .true. if statistics computations for 2D
! physics quantites
L , NLPOST ! .true. if postprocessing at current time step
L , NLUSUG
C HORIZONTAL DIFFUSION
L , NLTCRF ! .true. if correctionfor horizontal diffusion
! of temperature and humidity along pseud
! pressure levels
L , NLDIFU ! .true. if impl. hor. diffusion for u
L , NLDIFV ! .true. if impl. hor. diffusion for v
L , NLDIFT ! .true. if impl. hor. diffusion for T
L , NLDIFQ ! .true. if impl. hor. diffusion for q
L , NLDIFS ! .true. if impl. hor. diffusion for cloud wate
L , NLDIFX(MSVAR_MAX)
! .true. if impl. hor. diffusion for extra
! passive scalars
C BOUNDARY RELAXATIONS CONSTANTS
L , NLTANH ! .true. if tanh-shape boundary relaxation
! function
L , NLPWEI ! .true. if print of boundary relaxation
! function 'alfab'
L , NLBDUV ! .true. if the lateral boundaries are situated
! at velocity points
L , LCW(2) ! indicator of cloud water in boundary data
L , LSV(MSVAR_MAX,2)
! indicator of extra scalars in boundary data
C* COMMON *COMSLA* - SEMI-LAGRANGIAN CONSTANTS
L , NLSLAN ! .true. if semi-lagrangian advection
L , NLSL3D ! .true. if 3-dim. semi-lagrangian advection
C* PARAMETER FOR SETTLS
L , NLSETTLS ! .true. if SETTLS advection
C* PARAMETER FOR ITERATIVE HELMHOLTZ SOLVER
L , NLITRH ! .true. if iterative Helmholtz solver
C* NONLINEAR NORMAL MODE AND DIGITAL FILTER INITIALIZATION
L , LDFI ! .true. if DFI required
L , LNMI ! .true. if implicit nonlinear normal mode
LOGICAL
L NLEUL , NLSAPP , NLSIMP , NLPHYS , NLSTAT , NLHDIF
L , NLTVIR
L , NLHUMC , NLDYNVD, NLSTPH , NLSTPH2D, NLPOST
L , NLUSUG , NLTCRF
L , NLDIFU , NLDIFV , NLDIFT , NLDIFQ , NLDIFS
L , NLDIFX
L , NLTANH , NLPWEI , NLBDUV
L , NLSLAN , NLSL3D , NLGRIB, NLSETTLS, NLITRH
L , LCW , LSV
L , LDFI , LNMI
C
C--------------------------------------------------------------------
# 42 "/scratch/hirlam/hl_home/MPI/lib/src/grdy/statin.F" 2
# 1 "/scratch/hirlam/hl_home/MPI/lib/src/common/include/DECOMP.inc" 1
c Library:common/include $Id: DECOMP.inc 6492 2008-12-11 13:32:55Z ksa $
C-------------------------------------------------------------
C DECOMP.inc
C
c DECOMPOSITION PARAMETERS
C The parameter statements are needed for MPP system to be
C able to define COMMON blocks
C
C Modified:
C
C Jan Boerhout NEC High Performance Computing Europe
C August 2003
C New definition of FFT and TRI decomposition.
C Optimized halo swap routines.
C
C-------------------------------------------------------------
INTEGER MAXPROC
PARAMETER (MAXPROC=2048)
INTEGER MINPROC
PARAMETER (MINPROC=1)
C-----------------------------------------------------------------------
COMMON / DECOMP /
I MYPE ! PE number of the current PE (0...NPROC-1)
I , NPROC ! Total no of PEs
I , NPROCX ! No of PEs in x-direction
I , NPROCY ! No of PEs in y-direction
I , KLON_GLOBAL ! Total no of points in x-direction
I , KLAT_GLOBAL ! Total no of points in x-direction
I , KLEV_GLOBAL ! Total no vertical levels
1 , ATBASE ! .true. if current PE contains south boundary
L , ATTOP ! .true. if current PE contains north boundary
L , ATRIGHT ! .true. if current PE contains east boundary
L , ATLEFT ! .true. if current PE contains west boundary
I , IDATASTART
I , JDATASTART
I , I_PE_GRID
I , J_PE_GRID
I , PE_TOP
I , PE_BASE
I , PE_RIGHT
I , PE_LEFT
I , KLEV_HH
X , IMIN_TRI
X , IMAX_TRI
X , JLEV_TRI
I , KLON_AR (MAXPROC)
I , KLAT_AR (MAXPROC)
X , IDATASTART_AR(MAXPROC)
I , JDATASTART_AR(MAXPROC)
I , KCD_MAX
INTEGER MYPE ,NPROCX ,NPROCY ,NPROC
1 ,IDATASTART ,JDATASTART
1 ,I_PE_GRID ,J_PE_GRID
1 ,PE_TOP ,PE_BASE ,PE_RIGHT ,PE_LEFT
1 ,KLON_GLOBAL,KLAT_GLOBAL,KLEV_GLOBAL
I ,KLEV_HH
I ,IMIN_TRI ,IMAX_TRI ,JLEV_TRI
I ,KLON_AR ,KLAT_AR
I ,IDATASTART_AR,JDATASTART_AR
I ,KCD_MAX
LOGICAL ATBASE,ATTOP,ATRIGHT,ATLEFT
c Common for collecting and distributing special arrays
c------------------------------------------------------------
c COMMUNICATION SPACE AND WORK SPACE FOR HELMHOLZ SOLVER
c-------------------------------------------------------------
real, pointer ::
+ div_fft (:,:), buf_fft (:), div_tri (:,:), buf_tri (:),
+ buf_swap(:), f_buf (:,:), f_buf_1d(:),
+ ws_io (:), wr_io (:)
! Swap buffer indeces
integer, parameter ::
+ SEND = 1, RECV = 2,
+ PNORTH = 1, PSOUTH = 2, PEAST = 3, PWEST = 4
! Sub group communicators
integer :: hl_comm_x, hl_comm_y, mp_method
! Message passing method bitmasks
integer, parameter :: POINT_TO_POINT = 1
integer, parameter :: ALL_TO_ALL = 2
! Buffer sizes, offsets, dimensions for transposition and
! swap operations
integer ::
+ size_buf_fft (maxproc),size_div_fft (maxproc),
+ size_buf_tri (maxproc),size_div_tri (maxproc),
+ offs_fft_inp (maxproc),offs_fft_self(maxproc),
+ offs_fft_peer(maxproc),offs_tri_peer(maxproc),
+ offs_buf_fft (maxproc),offs_buf_tri (maxproc),
+ offs_tri_inp (maxproc),offs_tri_self(maxproc),
+ nrec_fft, nbuf_fft,
+ nrec_tri, nbuf_tri, nbuf_swap,
+ rtype, rsize,
+ klon_local, klat_local, klev_local,
+ nlonx(maxproc), nlony(maxproc),
+ nlaty(maxproc), nlevx(maxproc),
+ offs_swap(SEND:RECV,PNORTH:PWEST)
common /communication/
+ hl_comm_x, hl_comm_y, mp_method,
+ div_fft, buf_fft, f_buf, ws_io, buf_swap,
+ div_tri, buf_tri, f_buf_1d, wr_io,
+ size_buf_fft, size_div_fft,
+ size_buf_tri, size_div_tri,
+ offs_fft_inp, offs_fft_self, offs_fft_peer, offs_buf_fft,
+ offs_tri_inp, offs_tri_self, offs_tri_peer, offs_buf_tri,
+ nrec_fft, nbuf_fft, nbuf_swap,
+ nrec_tri, nbuf_tri,
+ klon_local, klat_local, klev_local,
+ nlonx, nlony, nlaty, nlevx,
+ rtype, rsize,
+ offs_swap
! Used in HHSOLV
real, pointer :: hhdia(:,:)
real :: dtold
common /comhhsolv/ hhdia, dtold
! Used in IMPSUB
logical, pointer :: lat_active(:), lon_active(:)
common /comimpsub/ lat_active, lon_active
c----------------------------------------------------------------
c PARAMETERS FOR IMPLICIT HORIZONTAL DIFFUSION
c----------------------------------------------------------------
real rimpdt
common /c_imp_diffl/rimpdt
# 43 "/scratch/hirlam/hl_home/MPI/lib/src/grdy/statin.F" 2
C
C ---------------------------------------------------------------
C* DECLARATION OF GLOBAL PARAMETERS
C --------------------------------
C
C INPUT
INTEGER KLON,KLAT
REAL PSTRATR(KLON,KLAT),PCONVECR(KLON,KLAT),
* PSENF(KLON,KLAT),PLATF(KLON,KLAT),PMOMF(KLON,KLAT),
* CWPATH(KLON,KLAT), COV2D(KLON,KLAT),
* CLOUD2D(KLON,KLAT,6),
* RHXU(KLON,KLAT), RHYV(KLON,KLAT)
C
C--------------------------------------------------------------------
C
C* DECLARATION OF LOCAL WORK-SPACE
C -------------------------------
C
INTEGER ISTART,ISTOP,JSTART,JSTOP,
+ INFO,I,J
REAL
+ ZHXY(KLON,KLAT),ZHXHY,
+ STTOTRAINR,STSTRATR,STCONVECR,
+ STSENF,STLATF,STMOMF,
+ STCWP,STCOV,
+ STcldhig,STcldmed,STcldlow,
+ STcldfog,STcldbas,STcldtop,
+ ZTTOTRAINR,ZTSTRATR,ZTCONVECR,
+ ZTSENF,ZTLATF,ZTMOMF,ZTCWP,ZTCOV,
+ ZTcldhig,ZTcldmed,ZTcldlow,
+ ZTcldfog,ZTcldbas,ZTcldtop,
+ ZCAPPA,ZRGASD,ZCPD,
+ ACCPERIOD
C
C MPP STUFF
C
integer ztmpmax
parameter (ztmpmax = 15)
c INTEGER, PARAMETER :: ZTMPMAX = 15
REAL ZTMP(ZTMPMAX)
COMMON /RWSTATIN/ ZTMP
C--------------------------------------------------------------------
C
C DEFINE CONSTANTS
ACCPERIOD = 86400.
ZCAPPA = 0.2857143
ZRGASD = 287.04
ZCPD = ZRGASD/ZCAPPA
C
C CHECK PE POSITION AND GET LIMITS
C
ISTART = 2
IF( ATRIGHT ) THEN
ISTOP = KLON - 2
ELSE
ISTOP = KLON - 1
END IF
C
JSTART = 2
IF( ATTOP ) THEN
JSTOP = KLAT - 2
ELSE
JSTOP = KLAT - 1
END IF
C
C-------------------------------------------------------------------
C
C CALC AREA WEIGHT
DO J = JSTART,JSTOP
DO I = ISTART,ISTOP
ZHXY(I,J) = 1./( RHXU(I,J)*RHYV(I,J) )
ENDDO
ENDDO
C
ZHXHY = 0.
DO J = JSTART,JSTOP
DO I = ISTART,ISTOP
ZHXHY = ZHXHY + ZHXY(I,J)
ENDDO
ENDDO
C
C SUM UP FLUXES
C
ZTTOTRAINR = 0.
ZTSTRATR = 0.
ZTCONVECR = 0.
ZTSENF = 0.
ZTLATF = 0.
ZTMOMF = 0.
ZTCWP = 0.
ZTCOV = 0.
ZTcldhig = 0.
ZTcldmed = 0.
ZTcldlow = 0.
ZTcldfog = 0.
ZTcldbas = 0.
ZTcldtop = 0.
C
DO J = JSTART,JSTOP
DO I = ISTART,ISTOP
ZTTOTRAINR = ZTTOTRAINR +
+ (PSTRATR(I,J) + PCONVECR(I,J))*ZHXY(I,J)
ZTSTRATR = ZTSTRATR + PSTRATR(I,J)*ZHXY(I,J)
ZTCONVECR = ZTCONVECR + PCONVECR(I,J)*ZHXY(I,J)
ZTSENF = ZTSENF + PSENF(I,J)*ZHXY(I,J)
ZTLATF = ZTLATF + PLATF(I,J)*ZHXY(I,J)
ZTMOMF = ZTMOMF + PMOMF(I,J)*ZHXY(I,J)
ZTCWP = ZTCWP + CWPATH(I,J)*ZHXY(I,J)
ZTCOV = ZTCOV + COV2D(I,J)*ZHXY(I,J)
ZTcldhig = ZTcldhig + CLOUD2D(I,J,1)*ZHXY(I,J)
ZTcldmed = ZTcldmed + CLOUD2D(I,J,2)*ZHXY(I,J)
ZTcldlow = ZTcldlow + CLOUD2D(I,J,3)*ZHXY(I,J)
ZTcldfog = ZTcldfog + CLOUD2D(I,J,4)*ZHXY(I,J)
ZTcldbas = ZTcldbas + CLOUD2D(I,J,5)*ZHXY(I,J)
ZTcldtop = ZTcldtop + CLOUD2D(I,J,6)*ZHXY(I,J)
ENDDO
ENDDO
C
C COPY TO WORK ARRAY
ZTMP(1)=ZTTOTRAINR
ZTMP(2)=ZTSTRATR
ZTMP(3)=ZTCONVECR
ZTMP(4)=ZTSENF
ZTMP(5)=ZTLATF
ZTMP(6)=ZTMOMF
ZTMP(7)=ZTCWP
ZTMP(8)=ZTCOV
ZTMP(9)=ZTcldhig
ZTMP(10)=ZTcldmed
ZTMP(11)=ZTcldlow
ZTMP(12)=ZTcldfog
ZTMP(13)=ZTcldbas
ZTMP(14)=ZTcldtop
ZTMP(15)=ZHXHY
C COLLECT FROM EACH PROCESSOR
CALL hl_mpi_rsum(ZTMPMAX, ZTMP)
C COPY BACK FROM WORK ARRAY
ZTTOTRAINR = ZTMP(1)
ZTSTRATR = ZTMP(2)
ZTCONVECR = ZTMP(3)
ZTSENF = ZTMP(4)
ZTLATF = ZTMP(5)
ZTMOMF = ZTMP(6)
ZTCWP = ZTMP(7)
ZTCOV = ZTMP(8)
ZTcldhig = ZTMP(9)
ZTcldmed = ZTMP(10)
ZTcldlow = ZTMP(11)
ZTcldfog = ZTMP(12)
ZTcldbas = ZTMP(13)
ZTcldtop = ZTMP(14)
ZHXHY = ZTMP(15)
ZHXHY = 1.0 / ZHXHY
STTOTRAINR = ZHXHY*ZTTOTRAINR * ACCPERIOD
STSTRATR = ZHXHY*ZTSTRATR * ACCPERIOD
STCONVECR = ZHXHY*ZTCONVECR * ACCPERIOD
STSENF = ZHXHY*ZTSENF
STLATF = ZHXHY*ZTLATF
STMOMF = ZHXHY*ZTMOMF
STCWP = ZHXHY*ZTCWP
STCOV = ZHXHY*ZTCOV
STcldhig = ZHXHY*ZTcldhig
STcldmed = ZHXHY*ZTcldmed
STcldlow = ZHXHY*ZTcldlow
STcldfog = ZHXHY*ZTcldfog
STcldbas = ZHXHY*ZTcldbas
STcldtop = ZHXHY*ZTcldtop
IF (MYPE.EQ.0) THEN
WRITE(6,*)
WRITE(6,'(1X,''TOTAL RAIN RATE(mm/d)='',F30.12)')STTOTRAINR
WRITE(6,'(1X,''STRATIFORM PRECIP RATE='',F30.12)')STSTRATR
WRITE(6,'(1X,''CONVECTIVE PRECIP RATE='',F30.12)')STCONVECR
WRITE(6,'(1X,''CWPATH ='',F30.12)') STCWP
WRITE(6,'(1X,''COV2D ='',F30.12)') STCOV
WRITE(6,'(1X,''HIGH CLOUDS ='',F30.12)') STcldhig
WRITE(6,'(1X,''MEDIUM CLOUDS ='',F30.12)') STcldmed
WRITE(6,'(1X,''LOW CLOUDS ='',F30.12)') STcldlow
WRITE(6,'(1X,''LOWEST LEVEL CLOUDS/FOG ='',F30.12)')STcldfog
WRITE(6,'(1X,''AVERAGED CLOUD BASE='',F30.12)') STcldbas
WRITE(6,'(1X,''AVERAGED CLOUD TOP='',F30.12)') STcldtop
WRITE(6,'(1X,''SENF ='',F30.12)') STSENF
WRITE(6,'(1X,''LATF ='',F30.12)') STLATF
WRITE(6,'(1X,''MOMF ='',F30.12)') STMOMF
WRITE(6,*)
ENDIF
C
RETURN
END
