!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%% ***S/P EQUIVMOUNT - compute elliptical mountain parameterssubroutine equivmount (gc,env,sxx,syy,sxy, 2 + ilg,il1,il2, + slope,xcent,mtdir) * #include "impnone.cdk"
#include "phy_macros_f.h"
* integer ilg,il1,il2 real gc(ilg),env(ilg),sxx(ilg),syy(ilg),sxy(ilg) real slope(ilg),xcent(ilg),mtdir(ilg) * *Author * A. Zadra - Feb 2002 * based on formulae by Lott & Miller (1997) * *Object * To calculate the slope, eccentricity and direction * of the equivalent/representative elliptical mountain * using the launching height and the gradient correlation * tensor of the unresolved topography. * *Arguments * * - Input - *GC land-sea mask (between 0(sea) and -1(land)) *ENV launching height *SXX gradient correlation, x-direction *SYY gradient correlation, y-direction *SXY gradient cross-correlation, xy-directions *ILG total horizontal dimension *IL1 index of 1st point to start calculation *IL2 index of last point to stop calculation * * - Output - *SLOPE mountain slope *XCENT mountain eccentricity *MTDIR mountain direction * integer i real*8 zero,unit,piotwo,hmin real*8 spls,smns,scrs,sppr,smpr * zero = 0.0 unit = 1.0 piotwo = .5*acos(-1.) hmin = 3.0 c c Initialize mountain parameters: do i=1,ilg slope(i) = zero xcent(i) = unit mtdir(i) = zero enddo c c Mountain slope, eccentricity and direction: do i=il1,il2 if (gc(i).eq.-1.) then spls = .5*( sxx(i) + syy(i) ) smns = .5*( sxx(i) - syy(i) ) scrs = sxy(i) sppr = spls + sqrt(smns**2 + scrs**2) smpr = abs(spls - sqrt(smns**2 + scrs**2)) c slope(i) = sqrt(sppr) c if (sppr .lt. 1.e-10) then xcent(i) = unit else xcent(i) = sqrt(smpr/sppr) endif c if ( abs(scrs) .lt. 1.e-10 .and. abs(smns) .lt. 1.e-10) then mtdir(i) = zero else mtdir(i) = .5*atan2(scrs,smns) if (mtdir(i).gt. piotwo ) mtdir(i) = mtdir(i) - 2.*piotwo if (mtdir(i).lt.(-piotwo)) mtdir(i) = mtdir(i) + 2.*piotwo endif endif enddo c return c end