flowht.f

Go to the documentation of this file.

C*******************************************************************
        SUBROUTINE flowht
C******************************************************************
C
C  THIS SUBROUTINE DETERMINES THE WEIGHTED AVERAGE FLOW SURFACE HEIGHTS
C  BASED ON THE VALUES THAT WOULD BE OBTAINED FROM THE INDIVIDUAL
C  TEMPERATURE PROFILES--F LUDWIG, JANUARY 1988
C
          include 'NGRIDS.PAR'
C
          include 'ANCHOR.CMM'
          include 'FLOWER.CMM'
          include 'LIMITS.CMM'
          include 'STALOC.CMM'
          include 'TSONDS.CMM'
C
    REAL RYZVAR(nsites),XVAR(nsites),YVAR(nsites)
    INTEGER NRYZ
C
C  DZMAX(IT,IZ) = MAXIMUM RISE FOR IZTH FLOW SFC AS DETERMINED FROM
C
        DO 220 ix = 1,ncol
           xx = float(ix)
           DO 200 iy = 1,nrow
          yy=float(iy)
              here=sfcht(ix,iy)
              DO 175 l = 1,nlvl
         IF (numtmp .GT. 1) THEN
C
C  IF THE SITE HAD VALID DATA (NTHTS >0)) THEN GET WEIGHTED AVERAGE RISE
C  AFTER GETTING RELATION FOR LOCAL TOPOGRAPHY HEIGHT VERSUS MAXIMUM 
C  RISE FROM FUNCTION SLOPER.
C
                nryz=0
                    DO 150 it = 1,numtmp
                       IF (nthts(it) .GT. 0 .AND. 
     $                                 dzmax(it,l).GT.-9998.) THEN
                          zratio=sloper(here,sfclow,zrise)
              nryz=nryz+1
              xvar(nryz)=xtmp(it)
              yvar(nryz)=ytmp(it)
                          zratio=sloper(here,sfclow,zrise)
                          ryzvar(nryz)= zratio*dzmax(it,l)
                       END IF
150                 CONTINUE
                    IF (nryz .GT. 0) THEN
               CALL rinvmod(rhere,xx,yy,xvar,yvar,nryz,ryzvar)
                       rhs(ix,iy,l) = 
     $                    rhere+avthk*sigma(l)+sfclow-here
                ELSE
C
C  IF NO SOUNDING REACHES THIS HIGH THEN USE SAME RISE AS NEXT 
C  LOWER LEVEL -- IF NO SOUNDING AT ALL USE A RISE = TO 3/4 THE 
C  TERRAIN RISE.
C
                   IF (l.GT.1) THEN
                  rhere=rhs(ix,iy,l-1)-
     $                          (avthk*sigma(l-1)+sfclow-here)
                          rhs(ix,iy,l)= 
     $                         rhere+avthk*sigma(l)+sfclow-here
               ELSE
                          rhs(ix,iy,l)= 
     $                       avthk*sigma(l)-0.25*(here-sfclow)
               END IF
            END IF
                 ELSE IF (numtmp .LT.1) THEN
C
C  IF NO SOUNDING USE SFC THAT RISES 3/4 AS FAST AS THE  TERRAIN.
C
                WRITE (*,*) 'BE WARY -- NO SOUNDING'
                    rhs(ix,iy,l)= avthk*sigma(l)-0.25*(here-sfclow)
         ELSE IF (numtmp.EQ.1) THEN
            IF (dzmax(1,l) .GT. -9998.) THEN
C
C  IF ONE SOUNDING REACHES THIS LEVEL, USE IT
C
               rhere=sloper(here,sfclow,zrise)*dzmax(1,l)
                       rhs(ix,iy,l)=rhere+avthk*sigma(l)+sfclow-here
            ELSE 
              IF (l.GT.1 .AND. dzmax(1,l-1).GT.-9998.) THEN
C
C  IF ONLY ONE SOUNDING AND IT DOESN'T REACH THIS LEVEL, USE HIGHEST
C  AVAILABLE DZMAX FOR UPPER LEVELS
C
                     dzmax(1,l)=dzmax(1,l-1)
                 rhere=sloper(here,sfclow,zrise)*dzmax(1,l)
                         rhs(ix,iy,l)=rhere+avthk*sigma(l)+sfclow-here
              ELSE
C
C  IF NO SONDE THIS LEVEL OR THE ONE BELOW USE SFC THAT RISES 3/4 
C  AS FAST AS THE  TERRAIN.
C
                         rhs(ix,iy,l)=avthk*sigma(l)-
     $                                    0.25*(here-sfclow)
              END IF                    
            END IF                    
         END IF
C
C  SETTING FLOW SURFACE THAT CLEARS TERRAIN TO CLEAR IT BY AT LEAST
C  20 M.
C
         IF (rhs(ix,iy,l).GE.z0 .AND. 
     $                rhs(ix,iy,l) .LT. 20.0) rhs(ix,iy,l)=20.0
175           CONTINUE
          DO 178 l=2,nlvl
             levbot(ix,iy)=l
             IF (rhs(ix,iy,l).GT.z0) GO TO 200
178       CONTINUE
200    CONTINUE
220 CONTINUE
C
        RETURN
        END