utils.f

Go to the documentation of this file.

C*********************************************************************
         REAL FUNCTION degdif(A1,A2)
C*********************************************************************
C
C  GETS THE DIFFERENCE BETWEEN TWO ANGLES (A1-A2, DEGREES)
C
C     FLUDWIG, 7/2002
C
    degdif=a2-a1
    IF (degdif .LT. -180.0) degdif=degdif+360.0
    IF (degdif .GT.  180.0) degdif=degdif-360.0
C
    RETURN
C
    END
C
C**********************************************
    REAL FUNCTION sp(UU,VV)
C**********************************************
C
C  FUNCTION TO GET SPEED FROM COMPONENTS
C
    sp=sqrt(uu*uu+vv*vv)
C
    RETURN
    END
C
C**********************************************
    REAL FUNCTION dd(UU,VV)
C**********************************************
C
C  FUNCTION TO GET DIRECTION (DEGREES) FROM COMPONENTS
C
    parameter(rad2d=180./3.14159)
C
    IF (sp(uu,vv).GT.0.0) THEN
       dd=amod(540.+ rad2d*atan2(uu,vv),360.)
    ELSE
       dd=0.0
    END IF
C
    RETURN
    END
C
C***************************************************************
    REAL FUNCTION xlintr(X0,X1,Z,ZZ0,Z1)
C***************************************************************
C
C  FUNCTION FOR LINEAR INTERPOLATION OF X TO PT Z BETWEEN ZZ0
C  AND Z1, WHERE ITS VALUES ARE X0 AND X1
C
        IF (z.EQ.zz0) THEN
       xlintr=x0
    ELSE IF (z.EQ.z1) THEN
       xlintr=x1
    ELSE
       xlintr=x0+(x1-x0)*(z-zz0)/(z1-zz0)
    END IF
C
    RETURN
C
    END
C
C**************************************************
    REAL FUNCTION tpot (PP,TT)
C**************************************************
C
C  POTENTIAL TEMPERATURE (DEGREES K) FROM PRESSURE (PP, HP OR MB) 
C  AND TEMPERATURE (TT, DEGREES CELSIUS).
C
C
    tpot=(tt+273.13)*((1000./pp)**0.288)
C
    RETURN
C
    END
C
C**************************************************
    REAL  FUNCTION pt2t (PP,TT)
C**************************************************
C
C  TEMPERATURE (DEGREES K) FROM PRESSURE (PP, HP OR MB) 
C  AND POTENTIAL TEMPERATURE (TT, DEGREES K).
C
C
    pt2t=tt*((pp/1000.)**0.288)
C
    RETURN
C
    END
C
C*************************************************************
    REAL FUNCTION altset(Z,P)
C*************************************************************
C 
C  GETS LOCAL ALTIMETER SETTING (IN HG.) FROM STATION PRESSURE (NOT 
C  REDUCED TO SEA LEVEL) AND THE STATION ELEVATION IN METERS.
C  
C  FROM A FORMULA PROVIDED BY MICHAEL SPLITT OF THE U. OF UTAH.
C
C   FLUDWIG, 4/01
C
    parameter(badat=-9999.0,p0=1013.3,fact=44308.0)
    parameter(xpon=0.19028,cv2mb=1013.25/29.921)
C
C     ALTIM IS THE ALTIMETER IN INCHES OF HG
C     ELEV IS THE STATION ELEVATION IN METERS
C
C     ALTIMETER IN INCHES, CONVERT TO MB (HP) AS FOLLOWS:
C
    REAL Z,ALTMB,P
C
C  CONVERT HECTOPASCAL TO INCHES 
C
    altmb=p/(1.0-(0.0065*z/288.0))**5.256
        altset=altmb/cv2mb
C 
C  DISCARD EXTREME VALUES, I.E. SEALEVEL PRESSURES OUTSIDE THE 
C  APPROXIMATE RANGE 965 TO 1063 HP (MB)
C
    IF (altset.GT.31.4 .OR. altset.LT.28.5 ) altset=badat
C
    RETURN
C
    END    
C
C**************************************************
    REAL FUNCTION cvt2p(ALTIM,ELEV)
C**************************************************
C 
C  GETS LOCAL STATION PRESSURE (NOT REDUCED TO SEA LEVEL)
C  USING THE LOCAL ALTIMETER SETTING IN INCHES OF HG AND THE
C  STATION ELEVATION IN METERS.
C  
C  FROM A FORMULA PROVIDED BY MICHAEL SPLITT OF THE U. OF UTAH.
C
C   FLUDWIG, 4/01
C
    parameter(badat=-999.9,p0=1013.3,fact=44308.0)
    parameter(xpon=0.19028,cv2mb=1013.25/29.921)
C
C     ALTIM IS THE ALTIMETER IN INCHES OF HG
C     ELEV IS THE STATION ELEVATION IN METERS
C
C     ALTIMETER IN INCHES, CONVERT TO MB (HP) AS FOLLOWS:
C
    REAL ALTIM,ELEV,ALTMB
C
C  CONVERT INCHES TO HECTOPASCAL
C
        altmb=altim*cv2mb
    cvt2p=altmb*(1.0-(0.0065*elev/288.0))**5.256
C
C  CHECK ELEVATION AGAINST STANDARD ATMOSPHERE -- SEE:
C
C       HOLMBOE, FORSYTHE & GUSTIN, 1945: "DYNAMIC METEOROLOGY,"
C       J. WILEY & SONS, NEW YORK, P 120.
C
C  REJECT IF DIFFERENCE EXCEEDS 450 M -- THE EQUIVALENT OF 
C  HAVING SEA LEVEL PRESSURE BETWEEN ABOUT 978 & 1058 MB)
C
    zstd=fact*(1.0-(cvt2p/p0)**xpon)
    IF (abs(zstd-elev) .GT. 450.0) cvt2p=badat
C
    RETURN
C
    END
C
C****************************************************************
    INTEGER FUNCTION julmin (KYEAR,IMO,MDATE,IHOUR,IMIN) 
C****************************************************************
C
C  GETS MINUTE SINCE 0000 ON 1 JANUARY CORRESPONDING TO YEAR 
C  KYEAR (FROM 1901 TO 2099) AND JULIAN DAY JD.  
C
C   FLUDWIG 3/02
C
    INTEGER LASTD (12),KYEAR,IMO,MDATE,IHOUR,IMIN
C
    DATA lastd /0,31,59,90,120,151,181,
     $              212,243,273,304,334/
C
C  CORRECT FOR LEAP YEAR EFFECT -- GOOD UNTIL 2100
C
    jadj=lastd(imo)
    IF (mod(kyear,4) .EQ.0. and. imo.GT.2) THEN
      jadj=jadj+1
    END IF
C
    idajul=jadj+mdate-1
    julmin=1440*idajul+60*ihour+imin

    RETURN
    END
C
C**********************************************************************
        SUBROUTINE lgntrp(Y,X0,X1,X,Y0,Y1)
C**********************************************************************
C
C DOES LOG-LINEAR INTERPOLATION OF Y VS. LOG X.
C
        IF (x1.EQ.x0 .OR. x.EQ.x0) THEN
       y=y0   
        ELSE IF (x.EQ.x1) THEN
       y=y1
        ELSE
           ratio = alog10(x/x0)/alog10(x1/x0)
           y = y0 + ratio * (y1-y0)
        END IF
C
        RETURN
        END
C
C**********************************************************************
        REAL FUNCTION wndwt(X,Y,XOBS,YOBS)
C**********************************************************************
C
C   THIS VERSION DETERMINES THE SQUARED DISTANCE BETWEEN
C   THE 2 PTS (X,Y) & (XOBS,YOBS).  
C
C       F. L. LUDWIG,  10/97
C
       include 'NGRIDS.PAR'
C
       include 'LIMITS.CMM'
C
    xdif=xobs-x
    ydif=yobs-y
        dist=sqrt(xdif**2 + ydif**2)
C
        IF (dist.LT.d2min) dist=d2min
C
        wndwt=1.0/(dist**dtwt)
C
        RETURN
        END
C
C*********************************************************************
        SUBROUTINE setint(IVALUE,IARRAY,NUM1,NUM2)
C*********************************************************************
C
C       INITIALIZES ALL ELEMENTS OF ARRAY TO VALUE. (THIS SUBPROGRAM
C       IS IDENTICAL TO 'SETMAT,' EXCEPT WITH INTEGER ARGUMENTS)
C       REVISED 11/87
C
       include 'NGRIDS.PAR'
C
        dimension iarray(nxgrd,nygrd)
        DO 10 i=1,num1
        DO 10 j=1,num2
           iarray(i,j)=ivalue
   10   CONTINUE
        RETURN
        END
C
C*******************************************************************
        SUBROUTINE setmat(VALUE,ARRAY,NUM1,NUM2)
C*******************************************************************
C
C       INITIALIZES ALL ELEMENTS OF ARRAY TO VALUE.(THIS SUBPROGRAM IS
C       IDETICAL TO 'SETINT,' EXCEPT WITH REAL ARGUMENTS.
C       REVISED 11/87
C
        include 'NGRIDS.PAR'
C
        dimension array(nxgrd,nygrd)
        DO 10 i=1,num1
        DO 10 j=1,num2
           array(i,j)=VALUE
   10   CONTINUE
        RETURN
        END
C