      subroutine general_rank_auto(IYR,MON,IDAY)
c Subroutine to compute National temperature ranks for current month
c last three months, and year-to-date
c Written by Richard Heim, 12-23-2009
c Modified by Trevor Wallis, May 2016
c ----------------------------------------------------------------------
       COMMON /COMPATHS/ PATHCPC,PATHDRD,PATHDRDW,cMeanpath,PATHWDATA,
     :                   cOdata,cIndata
       CHARACTER PATHCPC*42,PATHDRD*34,PATHDRDW*40,cMeanpath*36,
     :           PATHWDATA*41,cIndata*38,cOdata*38,LINE*70,MAIL*210

      open (19,file=cOdata//'trrank.',status='unknown')
      open (20,file=cOdata//'trrankb.',status='unknown')
C
C---WANT NATIONAL TEMPERATURE
       IST=110
       IDV=0
       IELEM=2
       LSTYR=IYR
       ME=MON
C---GET RANKS FOR CURRENT MONTH
       MB=MON
       call monr(LSTYR,IST,IDV,IELEM,MB,ME)
C---GET RANKS FOR THREE-MONTH SEASON
       IF (ME.GE.3) MB=ME-2
       IF (ME.LE.2) MB=ME+10
       if (MB.lt.ME) then
         call seasr(LSTYR,IST,IDV,IELEM,MB,ME)
       ELSE if (MB.gt.ME) then
         call winr(LSTYR,IST,IDV,IELEM,MB,ME)
       endif

C---GET RANKS FOR YEAR-TO-DATE
       MB=1
       if (MB.eq.ME) then 
         call monr(LSTYR,IST,IDV,IELEM,MB,ME)
       ELSE if (MB.lt.ME) then
         call seasr(LSTYR,IST,IDV,IELEM,MB,ME)
       endif

      close (19)
      close (20)
C---CREATE EMAIL MESSAGE
       OPEN (39,FILE=PATHDRDW//'mailrank.',STATUS='UNKNOWN')
       open (19, file=cOdata//'trrank.',status='OLD')
       open (20,file=cOdata//'trrankb.',status='OLD')
       WRITE (39,2900) IYR,MON,IDAY
2900   FORMAT (' Ranks for contiguous U.S. temperature for current'/
     *         ' month, 3-month season, and year-to-date.'/
     *         I5,2I3.2//25('-')/)
1      READ (20,1001,END=2)  LINE
1001   FORMAT (A63)
       WRITE (39,1001) LINE
       GO TO 1
2      CLOSE (20)
       WRITE (39,2901)
2901   FORMAT (/25('-')/)
3      READ (19,1001, END=4) LINE
       WRITE (39,1001) LINE
       GO TO 3
4      CLOSE (19)
       WRITE (39,2990)
2990   FORMAT (/'subroutine general_rank_auto SUCCESSFUL COMPLETION')
       CLOSE (39)
C---SEND EMAIL MESSAGE
       MAIL = 'mail -s "US temperature ranks from Weekly Palmer" '//
     :  ' Richard.Heim@noaa.gov < '//PATHDRDW//'mailrank. '

      CALL SYSTEM ('/bin/'//MAIL)

      return
      end
C
C23456789012345678901234567890123456789012345678901234567890123456789012
      subroutine monr(LSTYR,IST,IDV,IELEM,MB,ME)     

       COMMON /COMPATHS/ PATHCPC,PATHDRD,PATHDRDW,cMeanpath,PATHWDATA,
     :                   cOdata,cIndata
       CHARACTER PATHCPC*42,PATHDRD*34,PATHDRDW*40,cMeanpath*36,
     :           PATHWDATA*41,cIndata*38,cOdata*38
       integer IARANK(200),IAYR(200),IDRANK(200),IDYR(200)
       real ADATA(200),DDATA(200),DATA(200,14)

       MONTH=MB
       WRITE (19,1) MONTH
1      FORMAT ('   MONTH = ',I4/' IST,IDV,IELEM,ASCENDING-RANK-YR-',    
     *   'VALUE,DESCENDING-RANK-YR-VALUE')
       WRITE (20,1) MONTH     
C DEFINE BEGINNING YEAR
       IYRB=1895  
       IF (IST.EQ.50) IYRB=1931     
C READ P.O.R. VALUES FOR THE STATE/DIVISION/ELEMENT DESIRED---  
      call GETPOR(IST,IDV,IELEM,DATA)
      do 10 J=1,200
       IYR=INT(DATA(J,14))
       if (IYR.lt.IYRB.or.IYR.gt.LSTYR) go to 10
       I=IYR-IYRB+1  
       IARANK(I)=I
       IDRANK(I)=I
       IAYR(I)=IYR
       IDYR(I)=IYR
       ADATA(I)=DATA(J,MONTH)   
       DDATA(I)=DATA(J,MONTH)   
10    CONTINUE   
      NYRS=I     
C SORT IN ASCENDING ORDER---
      DO 20 I=1,NYRS   
       IP1=I+1    
       DO J=IP1,NYRS 
        IF (ADATA(J).LE.ADATA(I)) THEN     
          AT=ADATA(I)   
          IT=IAYR(I)    
          ADATA(I)=ADATA(J)   
          IAYR(I)=IAYR(J)     
          ADATA(J)=AT   
          IAYR(J)=IT    
        ENDIF
      enddo   
20    CONTINUE   
C SORT IN DESCENDING ORDER---     
      DO 30 I=1,NYRS   
       IP1=I+1    
       DO J=IP1,NYRS 
        IF (DDATA(J).GE.DDATA(I)) THEN     
          AT=DDATA(I)   
          IT=IDYR(I)    
          DDATA(I)=DDATA(J)   
          IDYR(I)=IDYR(J)     
          DDATA(J)=AT   
          IDYR(J)=IT    
        ENDIF   
      enddo 
30    CONTINUE   
C STORE SORTED VALUES---    
      DO 40 I=1,NYRS   
        IF ((IAYR(I).EQ.LSTYR).OR.(IDYR(I).EQ.LSTYR))     
     *    WRITE (20,2) IST,IDV,IELEM,IARANK(I),IAYR(I),  
     *           ADATA(I),IDRANK(I),IDYR(I),DDATA(I)  
       WRITE (19,2) IST,IDV,IELEM,IARANK(I),IAYR(I),ADATA(I),
     *    IDRANK(I),IDYR(I),DDATA(I)
40     continue
2      FORMAT (I3,I3,I3,2(2X,I4,I5,F7.2)) 

       return
       end  
C ---------------------------------------------------------------------- 
      subroutine seasr(LSTYR,IST,IDV,IELEM,MB,ME)

       COMMON /COMPATHS/ PATHCPC,PATHDRD,PATHDRDW,cMeanpath,PATHWDATA,
     :                   cOdata,cIndata
       CHARACTER PATHCPC*42,PATHDRD*34,PATHDRDW*40,cMeanpath*36,
     :           PATHWDATA*41,cIndata*38,cOdata*38
       integer IARANK(200),IAYR(200),IDRANK(200),IDYR(200)
       real ADATA(200),DDATA(200),DATA(200,14)

       WRITE (19,1) MB,ME
1      FORMAT ('   MONTHS = ',I2,' - ',I2/' IST,IDV,IELEM,ASCENDING-',  
     *   'RANK-YR-VALUE,DESCENDING-RANK-YR-VALUE')    
       WRITE (20,1) MB,ME     
C---DEFINE BEGINNING YEAR     
       IYRB=1895  
       IF (IST.EQ.50) IYRB=1931     
C---READ P.O.R. VALUES FOR THE STATE/DIVISION/ELEMENT DESIRED---  
      call GETPOR(IST,IDV,IELEM,DATA)
      do 10 J=1,200
       IYR=INT(DATA(J,14))
       if (IYR.lt.IYRB.or.IYR.gt.LSTYR) go to 10
       I=IYR-IYRB+1   
       IARANK(I)=I
       IDRANK(I)=I
       IAYR(I)=IYR
       IDYR(I)=IYR
       ADATA(I)=0.0     
       DDATA(I)=0.0     
       DO 11 L=MB,ME    
        ADATA(I)=ADATA(I)+DATA(J,L)    
        DDATA(I)=DDATA(I)+DATA(J,L)    
11      continue    
        IF (IELEM.EQ.2) THEN   
          ADATA(I)=ADATA(I)/(ME-MB+1.0)   
          DDATA(I)=DDATA(I)/(ME-MB+1.0)   
        ENDIF   
10    CONTINUE   
      NYRS=I     
C---SORT IN ASCENDING ORDER---
      DO 20 I=1,NYRS   
      IP1=I+1    
      DO J=IP1,NYRS 
       IF (ADATA(J).LE.ADATA(I)) THEN     
          AT=ADATA(I)   
          IT=IAYR(I)    
          ADATA(I)=ADATA(J)   
          IAYR(I)=IAYR(J)     
          ADATA(J)=AT   
          IAYR(J)=IT    
       ENDIF   
       enddo
20    CONTINUE   
C---SORT IN DESCENDING ORDER---     
      DO 30 I=1,NYRS   
      IP1=I+1    
      DO J=IP1,NYRS 
       IF (DDATA(J).GE.DDATA(I)) THEN     
          AT=DDATA(I)   
          IT=IDYR(I)    
          DDATA(I)=DDATA(J)   
          IDYR(I)=IDYR(J)     
          DDATA(J)=AT   
          IDYR(J)=IT    
       ENDIF   
       enddo
30    CONTINUE   
C---STORE SORTED VALUES---    
      DO 40 I=1,NYRS   
       IF ((IAYR(I).EQ.LSTYR).OR.(IDYR(I).EQ.LSTYR))  
     *    WRITE (20,2) IST,IDV,IELEM,IARANK(I),IAYR(I),ADATA(I),  
     *       IDRANK(I),IDYR(I),DDATA(I)   
       WRITE (19,2) IST,IDV,IELEM,IARANK(I),IAYR(I),ADATA(I),
     *    IDRANK(I),IDYR(I),DDATA(I)
40     continue
2      FORMAT (I3,I3,I3,2(2X,I4,I5,F7.2)) 
 
      return 
      END

C ----------------------------------------------------------------------     
      subroutine winr(LSTYR,IST,IDV,IELEM,MB,ME)     

       COMMON /COMPATHS/ PATHCPC,PATHDRD,PATHDRDW,cMeanpath,PATHWDATA,
     :                   cOdata,cIndata
       CHARACTER PATHCPC*42,PATHDRD*34,PATHDRDW*40,cMeanpath*36,
     :           PATHWDATA*41,cIndata*38,cOdata*38
       integer IARANK(200),IAYR(200),IDRANK(200),IDYR(200)
       real ADATA(200),DDATA(200),DATA(200,14)            

       WRITE (20,1) MB,ME     
       WRITE (19,1) MB,ME
1      FORMAT ('   MONTHS = ',I2,'-',I2/' IST,IDV,IELEM,ASCENDING-',    
     *   'RANK-YR-VALUE,DESCENDING-RANK-YR-VALUE')    
C---DEFINE BEGINNING YEAR     
       IYRB=1895  
       IF (IST.EQ.50) IYRB=1931        
C---READ P.O.R. VALUES FOR THE STATE/DIVISION/ELEMENT DESIRED---  
      call GETPOR(IST,IDV,IELEM,DATA)
C---Compute the seasonal values ---------  
      WP=0.0
      do 10 J=1,200
       IYR=INT(DATA(J,14))
       if (IYR.lt.1895.or.IYR.gt.LSTYR) go to 10
       if (IYR.eq.IYRB) then
        WP=0.0
        do 13 IM=MB,12
        WP=WP+DATA(J,IM)
   13   continue
       else
        I=IYR-IYRB 
        IARANK(I)=I
        IDRANK(I)=I
        IAYR(I)=IYR
        IDYR(I)=IYR
        ADATA(I)=WP     
        DDATA(I)=WP        
        DO 11 L=1,ME   
        ADATA(I)=ADATA(I)+DATA(J,L)    
        DDATA(I)=DDATA(I)+DATA(J,L)    
   11   continue  
         IF ((IELEM.EQ.2).OR.(IELEM.EQ.7)) THEN   
          ADATA(I)=ADATA(I)/(ME+13.0-MB)  
          DDATA(I)=DDATA(I)/(ME+13.0-MB)  
         ENDIF   
C---PUT THIS YEAR'S DATA INTO LAST YEAR'S ARRAY FOR NEXT READ---  
        WP=0.0
        do 14 IM=MB,12
        WP=WP+DATA(J,IM)
   14   continue
       endif 
10    CONTINUE   
      NYRS=I     
C---SORT IN ASCENDING ORDER---
      DO 20 I=1,NYRS   
       IP1=I+1    
       DO J=IP1,NYRS 
        IF (ADATA(J).LE.ADATA(I)) THEN     
          AT=ADATA(I)   
          IT=IAYR(I)    
          ADATA(I)=ADATA(J)   
          IAYR(I)=IAYR(J)     
          ADATA(J)=AT   
          IAYR(J)=IT    
        ENDIF   
        enddo
20    CONTINUE   
C---SORT IN DESCENDING ORDER---     
      DO 30 I=1,NYRS   
       IP1=I+1    
       DO J=IP1,NYRS 
        IF (DDATA(J).GE.DDATA(I)) THEN     
          AT=DDATA(I)   
          IT=IDYR(I)    
          DDATA(I)=DDATA(J)   
          IDYR(I)=IDYR(J)     
          DDATA(J)=AT   
          IDYR(J)=IT    
        ENDIF   
        enddo
30    CONTINUE   
C---STORE SORTED VALUES---    
      DO 40 I=1,NYRS   
       IF ((IAYR(I).EQ.LSTYR).OR.(IDYR(I).EQ.LSTYR))    
     *  WRITE (20,2) IST,IDV,IELEM,IARANK(I),IAYR(I),ADATA(I),    
     *      IDRANK(I),IDYR(I),DDATA(I) 
       WRITE (9,2) IST,IDV,IELEM,IARANK(I),IAYR(I),ADATA(I),
     *    IDRANK(I),IDYR(I),DDATA(I)
40     enddo
2      FORMAT (I3,I3,I3,2(2X,I4,I5,F7.2))  

      return     
      END   
