1
2      SUBROUTINE MAXVALUE
3!***********************************************************************
4!                 MAXVALUE Module of the AMS/EPA Regulatory Model - AERMOD
5!
6!        PURPOSE: Update Overall Maximum Value Arrays
7!                 NMAX = 50 Assigned in PARAMETER Statement
8!                 Note: For duplicate values, the earlier occurrence keeps
9!                       its rank within the array
10!
11!        PROGRAMMER: Roger Brode, Jeff Wang
12!
13!        DATE:    March 2, 1992
14!
15!        INPUTS:  Maximum Value Table Options
16!                 Array of CONC or DEPOS Averages
17!                 Averaging Period
18!
19!        OUTPUTS: Updated Maximum Value Array
20!                 Updated Maximum Date Array
21!                 Updated Maximum Receptor Array
22!
23!        CALLED FROM:   HIVALS
24!***********************************************************************
25
26!     Variable Declarations
27      USE MAIN1
28      IMPLICIT NONE
29      CHARACTER MODNAM*12
30
31      SAVE
32      INTEGER :: J
33
34!     Variable Initializations
35      MODNAM = 'MAXVALUE'                                               !   1620
36
37!     Begin Source Group LOOP
38      DO IGRP = 1 , NUMGRP
39!        Begin Receptor LOOP
40         RECEPTOR_LOOP:DO IREC = 1 , NUMREC                             !   1620
41            IF ( NMXVAL.GT.1 ) THEN                                     ! 233280
42               IF ( AVEVAL(IREC,IGRP,IAVE,ITYP)                         &
43     &              .GT.RMXVAL(NMXVAL,IGRP,IAVE,ITYP) ) THEN
44                  DO J = NMXVAL - 1 , 1 , -1                            !   1408
45                     IF ( AVEVAL(IREC,IGRP,IAVE,ITYP)                   &
46     &                    .LE.RMXVAL(J,IGRP,IAVE,ITYP) ) THEN
47                        RMXVAL(J+1,IGRP,IAVE,ITYP)                      &
48     &                     = AVEVAL(IREC,IGRP,IAVE,ITYP)
49                        IF ( NUMCLM(IAVE).EQ.0 .AND. NUMMSG(IAVE).EQ.0 )&
50     &                       THEN
51                           MCLMSG(J+1,IGRP,IAVE,ITYP) = ' '             !    590
52                        ELSE
53!                          Set Indicator Of Calm and Msg    ---   CALL MSETFG
54                           CALL MSETFG(0,J)                             !    764
55                        ENDIF
56                        MXDATE(J+1,IGRP,IAVE,ITYP) = KURDAT             !   1354
57                        MXLOCA(J+1,IGRP,IAVE,ITYP) = IREC
58!                       Exit Block
59                        GOTO 50
60                     ELSE
61                        RMXVAL(J+1,IGRP,IAVE,ITYP)                      &
62     &                     = RMXVAL(J,IGRP,IAVE,ITYP)
63                        MXDATE(J+1,IGRP,IAVE,ITYP)                      &
64     &                     = MXDATE(J,IGRP,IAVE,ITYP)
65                        MCLMSG(J+1,IGRP,IAVE,ITYP)                      &
66     &                     = MCLMSG(J,IGRP,IAVE,ITYP)
67                        MXLOCA(J+1,IGRP,IAVE,ITYP)                      &
68     &                     = MXLOCA(J,IGRP,IAVE,ITYP)
69                        IF ( J.EQ.1 ) THEN
70                           RMXVAL(1,IGRP,IAVE,ITYP)                     &
71     &                        = AVEVAL(IREC,IGRP,IAVE,ITYP)
72                           IF ( NUMCLM(IAVE).EQ.0 .AND. NUMMSG(IAVE)    &
73     &                          .EQ.0 ) THEN
74                              MCLMSG(1,IGRP,IAVE,ITYP) = ' '            !     28
75                           ELSE
76!                             Set Indicator Of Calm and Msg ---   CALL MSETFG
77                              CALL MSETFG(1,1)                          !     26
78                           ENDIF
79                           MXDATE(1,IGRP,IAVE,ITYP) = KURDAT            !     54
80                           MXLOCA(1,IGRP,IAVE,ITYP) = IREC
81                        ENDIF
82                     ENDIF
83                  ENDDO
84               ENDIF
85            ELSEIF ( NMXVAL.EQ.1 ) THEN
86               IF ( AVEVAL(IREC,IGRP,IAVE,ITYP)                         &
87     &              .GT.RMXVAL(1,IGRP,IAVE,ITYP) ) THEN
88                  RMXVAL(1,IGRP,IAVE,ITYP) = AVEVAL(IREC,IGRP,IAVE,ITYP)!      0
89                  IF ( NUMCLM(IAVE).EQ.0 .AND. NUMMSG(IAVE).EQ.0 ) THEN
90                     MCLMSG(1,IGRP,IAVE,ITYP) = ' '                     !      0
91                  ELSE
92!                    Set Indicator Of Calm and Missing      ---   CALL MSETFG
93                     CALL MSETFG(1,1)                                   !      0
94                  ENDIF
95                  MXDATE(1,IGRP,IAVE,ITYP) = KURDAT                     !      0
96                  MXLOCA(1,IGRP,IAVE,ITYP) = IREC
97               ENDIF
98            ENDIF
99 50      ENDDO RECEPTOR_LOOP
100!        End Receptor LOOP
101      ENDDO
102!     End Source Group LOOP
103
104      CONTINUE                                                          !   1620
105      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