William.Hatheway
Active member
I found some very old code on the WRF User's Forum: https://forum.wrfforum.com/viewtopic.php?f=8&t=948
from Robert Rosumalski.
SUBROUTINE CALGUST(LPBL,ZPBL,GUST)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . .
C SUBPROGRAM: CALGUST COMPUTE MAX WIND LEVEL
C PRGRMMR: MANIKIN ORG: W/NP2 DATE: 97-03-04
C
C ABSTRACT:
C THIS ROUTINE COMPUTES SURFACE WIND GUST BY MIXING
C DOWN MOMENTUM FROM THE LEVEL AT THE HEIGHT OF THE PBL
C
C
C PROGRAM HISTORY LOG:
C 03-10-15 GEOFF MANIKIN
C 05-03-09 H CHUANG - WRF VERSION
C 05-06-30 R ROZUMALSKI - DYNAMIC MEMORY ALLOCATION AND SMP
C THREAD-SAFE VERSION
C
C USAGE: CALL CALGUST(GUST)
C INPUT ARGUMENT LIST:
C NONE
C
C OUTPUT ARGUMENT LIST:
C GUST - SPEED OF THE MAXIMUM SFC WIND GUST
C
C OUTPUT FILES:
C NONE
C
C SUBPROGRAMS CALLED:
C UTILITIES:
C H2V
C
C LIBRARY:
C COMMON -
C LOOPS
C OPTIONS
C MASKS
C INDX
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE : CRAY C-90
C$$$
C
C
use vrbls3d
use vrbls2d
C
C INCLUDE ETA GRID DIMENSIONS. SET/DERIVE PARAMETERS.
C
!
INCLUDE "params"
C
INCLUDE "CTLBLK.comm"
C
C DECLARE VARIABLES.
C
INTEGER :: LPBL(IM,JM)
REAL :: GUST(IM,JM)
REAL ZPBL(IM,jsta_2l:jend_2u)
C
C
C*****************************************************************************
C START CALMXW HERE.
C
C LOOP OVER THE GRID.
C
DO J=JSTA,JEND
DO I=1,IM
! GUST(I,J) = SPVAL
GUST(I,J) = 0.
ENDDO
ENDDO
C
C ASSUME THAT U AND V HAVE UPDATED HALOS
C
!$omp parallel do
!$omp& private(ie,iw,mxww,u0,v0,wind)
DO 20 J=JSTA_M,JEND_M
DO 20 I=2,IM-1
L=LPBL(I,J)
IF(MODELNAME .EQ. 'NMM')THEN
IE=I+MOD(J+1,2)
IW=I+MOD(J+1,2)-1
USFC=D25*(U10(I,J-1)+U10(IW,J)+
X U10(IE,J)+U10(I,J+1))
VSFC=D25*(V10(I,J-1)+V10(IW,J)+
X V10(IE,J)+V10(I,J+1))
SFCWIND=SQRT(USFC**2 + VSFC**2)
U0 = D25*(U(I,J-1,L)+U(IW,J,L)+
X U(IE,J,L)+U(I,J+1,L))
V0 = D25*(V(I,J-1,L)+V(IW,J,L)+
X V(IE,J,L)+V(I,J+1,L))
WIND=SQRT(U0**2 + V0**2)
ELSE IF(MODELNAME .EQ. 'NCAR')THEN
USFC=U10(I,J)
VSFC=V10(I,J)
SFCWIND=SQRT(USFC**2 + VSFC**2)
U0=U(I,J,L)
V0=V(I,J,L)
WIND=SQRT(U0**2 + V0**2)
END IF
DELWIND=WIND - SFCWIND
ZSFC=FIS(I,J)*GI
DELWIND=DELWIND*(1.0-AMIN1(0.5,ZPBL(I,J)/2000.))
GUST(I,J)=SFCWIND+DELWIND
10 CONTINUE
20 CONTINUE
C END OF ROUTINE.
C
RETURN
END
from Robert Rosumalski.
SUBROUTINE CALGUST(LPBL,ZPBL,GUST)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . .
C SUBPROGRAM: CALGUST COMPUTE MAX WIND LEVEL
C PRGRMMR: MANIKIN ORG: W/NP2 DATE: 97-03-04
C
C ABSTRACT:
C THIS ROUTINE COMPUTES SURFACE WIND GUST BY MIXING
C DOWN MOMENTUM FROM THE LEVEL AT THE HEIGHT OF THE PBL
C
C
C PROGRAM HISTORY LOG:
C 03-10-15 GEOFF MANIKIN
C 05-03-09 H CHUANG - WRF VERSION
C 05-06-30 R ROZUMALSKI - DYNAMIC MEMORY ALLOCATION AND SMP
C THREAD-SAFE VERSION
C
C USAGE: CALL CALGUST(GUST)
C INPUT ARGUMENT LIST:
C NONE
C
C OUTPUT ARGUMENT LIST:
C GUST - SPEED OF THE MAXIMUM SFC WIND GUST
C
C OUTPUT FILES:
C NONE
C
C SUBPROGRAMS CALLED:
C UTILITIES:
C H2V
C
C LIBRARY:
C COMMON -
C LOOPS
C OPTIONS
C MASKS
C INDX
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE : CRAY C-90
C$$$
C
C
use vrbls3d
use vrbls2d
C
C INCLUDE ETA GRID DIMENSIONS. SET/DERIVE PARAMETERS.
C
!
INCLUDE "params"
C
INCLUDE "CTLBLK.comm"
C
C DECLARE VARIABLES.
C
INTEGER :: LPBL(IM,JM)
REAL :: GUST(IM,JM)
REAL ZPBL(IM,jsta_2l:jend_2u)
C
C
C*****************************************************************************
C START CALMXW HERE.
C
C LOOP OVER THE GRID.
C
DO J=JSTA,JEND
DO I=1,IM
! GUST(I,J) = SPVAL
GUST(I,J) = 0.
ENDDO
ENDDO
C
C ASSUME THAT U AND V HAVE UPDATED HALOS
C
!$omp parallel do
!$omp& private(ie,iw,mxww,u0,v0,wind)
DO 20 J=JSTA_M,JEND_M
DO 20 I=2,IM-1
L=LPBL(I,J)
IF(MODELNAME .EQ. 'NMM')THEN
IE=I+MOD(J+1,2)
IW=I+MOD(J+1,2)-1
USFC=D25*(U10(I,J-1)+U10(IW,J)+
X U10(IE,J)+U10(I,J+1))
VSFC=D25*(V10(I,J-1)+V10(IW,J)+
X V10(IE,J)+V10(I,J+1))
SFCWIND=SQRT(USFC**2 + VSFC**2)
U0 = D25*(U(I,J-1,L)+U(IW,J,L)+
X U(IE,J,L)+U(I,J+1,L))
V0 = D25*(V(I,J-1,L)+V(IW,J,L)+
X V(IE,J,L)+V(I,J+1,L))
WIND=SQRT(U0**2 + V0**2)
ELSE IF(MODELNAME .EQ. 'NCAR')THEN
USFC=U10(I,J)
VSFC=V10(I,J)
SFCWIND=SQRT(USFC**2 + VSFC**2)
U0=U(I,J,L)
V0=V(I,J,L)
WIND=SQRT(U0**2 + V0**2)
END IF
DELWIND=WIND - SFCWIND
ZSFC=FIS(I,J)*GI
DELWIND=DELWIND*(1.0-AMIN1(0.5,ZPBL(I,J)/2000.))
GUST(I,J)=SFCWIND+DELWIND
10 CONTINUE
20 CONTINUE
C END OF ROUTINE.
C
RETURN
END