1
2      SUBROUTINE LTOPG(ISTAB)
3!***********************************************************************
4!               LTOPG Module of AERMOD Model
5!
6!        PURPOSE: Converts Monin-Obukhov length to PG stability class
7!                 for use with AREADPLT option, based on Golder (1972)
8!
9!        PROGRAMMER: R. Brode
10!
11!        DATE:       November 21, 1997
12!
13!        INPUTS:  Monin-Obukhov lenght, OBULEN
14!                 Surface roughness length, SFCZ0
15!
16!
17!        OUTPUTS: HRVAL, Concentration or Deposition for Particular
18!                 Source/Receptor Combination
19!
20!        CALLED FROM:   SETSZMN
21!***********************************************************************
22
23!     Variable Declarations
24      USE MAIN1
25      IMPLICIT NONE
26      CHARACTER MODNAM*12
27
28      SAVE
29      REAL LNZ0 , LNZ02 , OBUINV
30      REAL AB , BC , CD , DE , EF , AA , BB , CC , DD , EE , FF
31      INTEGER ISTAB
32
33!     Variable Initializations
34      MODNAM = 'LTOPG'                                                  !   4320
35
36!     Initialize local variables
37
38      IF ( ZI.EQ.0. .OR. OBULEN.EQ.0. .OR. SFCZ0.LE.0. ) THEN
39         ISTAB = 9                                                      !      0
40         GOTO 999
41      ENDIF
42
43      LNZ0 = ALOG(SFCZ0)                                                !   4320
44      LNZ02 = LNZ0*LNZ0
45      AA = -0.1360107 + 0.0118433*LNZ0 + 0.00021242*LNZ02
46      BB = -0.08608128 + 0.0118433*LNZ0 + 0.00021242*LNZ02
47      CC = -0.0390887 + 0.009030514*LNZ0 - 0.0005869182*LNZ02
48      DD = -0.0116834 + 0.00182343*LNZ0 - 0.000002247867*LNZ02
49      EE = -DD
50      FF = -CC
51
52!     Interpolate to get 1./L values to define boundaries between
53!     stability classes.
54      AB = (AA+BB)/2.
55      BC = (BB+CC)/2.
56      CD = (CC+DD)/2.
57      DE = (DD+EE)/2.
58      EF = (EE+FF)/2.
59
60!     Calculate stability class ISTAB
61
62      OBUINV = 1./OBULEN
63
64      IF ( OBUINV.LE.AB ) THEN
65         ISTAB = 1                                                      !      8
66      ELSEIF ( OBUINV.LE.BC ) THEN
67         ISTAB = 2                                                      !     16
68      ELSEIF ( OBUINV.LE.CD ) THEN
69         ISTAB = 3                                                      !     50
70      ELSEIF ( OBUINV.LE.DE ) THEN
71         ISTAB = 4                                                      !   1700
72      ELSEIF ( OBUINV.LE.EF ) THEN
73         ISTAB = 5                                                      !   2004
74      ELSE
75         ISTAB = 6                                                      !    542
76      ENDIF
77
78 999  CONTINUE                                                          !   4320
79      END


HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use