      SUBROUTINE TAIL (SECS)
C     ****
C     ****     ROUTINE TO CALCULATE AURORAL CONSTANTS AS FUNCTION OF
C     ****      TIME FOR THE NORMAL CASE USING THE REVISED ALFA (10/86)
C     ****      AND THE NEW POLAR CAP CONVECTION (5/87)
C     ****     SECS=UNIVERSAL TIME IN SECONDS WHERE
C     ****          0.12 (MDAY.IHR) = 0.0  (UTMDAY.UTHR)
C     ****          1.0  (MDAY.IHR) = 0.12 (UTMDAY.UTHR)
C     ****          1.12 (MDAY.IHR) = 1.0  (UTMDAY.UTHR)
C     ****
      PARAMETER (NAURPX=55,NLEX=600)
      SAVE
      COMMON/AURDAT/ AURPS(NLEX,2,NAURPX), NPTS(NAURPX),IPR, NAURP,
     | PARAMV(NAURPX), JSWOLDA, JDITH, JDIDK
      EQUIVALENCE (PARAMV(1),HP), (PARAMV(2),CP), (PARAMV(3),BY)
      include "params.h"
      include "cons.h"
      common/ingpi/ f107,f107a,ctpoten,hpower,byimf
C  AURORAL PARAMETERS IN DEGREES ETC.
      COMMON /PARAMD/ THETA0(2),OFFA(2),OFFC(2),DSKOFA(2),DSKOFC(2),
     1 PHID(2),PHIN(2),PHIDP0(2),PHIDM0(2),PHINP0(2),PHINM0(2),
     2 PSIM(2),PSIE(2),PCEN(2)
     |, ARAD(2),H1,H2,ROTH,E1,E2,ROTE,EC,ED,ALFA1,ALFA2,TWAK,TWA6,TWA21,
     | ROT6,ROT21,D6,D21,H6,H21,T6,T21
C  AURORAL PARAMETERS IN RADIANS ETC FOR FLOWV3
      COMMON /IONCR/ ISTAR,IHEM,RDEG(22),PSIV(6),R1(2)
     1  ,DDUUMM(IMAXMP*JMX0+IMX0*JMX0+2)
C    1, RTHC(2),R2(2)
      COMMON /OVALR/ RRAD(2),H0,RH,RROTH,E0,REE,RROTE,FC,ALFAC,FD,ALFAD
     |, ALFK,ALF6,ALF21,RROT6,RROT21,RD6,RD6V,RD21,RH6,RH21,RT6,RT21
     |, ALFA0,RALFA,ALFA20,RALFA2,E20,RE2
! Amie common:
      include "amie.h"
!
      DATA CONVRT/3.1211E8/,DTR/1.7453293E-2/,E/1.E-10/,IFRST/0/
      COMMON /RADII/ RHP,RCP,RAURSH,RAURNH,HPGWSH,HPGWNH
      CHARACTER*8 NAMEHA(38)
C  HEELIS CASE PLUS AURORA (ASSYMMETRICAL)
      DATA NAMEHA/ ' H POWER', ' C POTEN', '  IMF BY', '      R1',
     | '   PHIDM', '   PHIDP', '   PHINM', '   PHINP', ' ARADP,N',
     | ' ARADN,S', ' OFFAP,N', ' OFFAN,S', '  DKAP,N', '  DKAN,S',
     | ' PHIDP,N', ' PHIDN,S', ' PHINP,N', ' PHINN,S', ' PCEPP,N',
     | ' PCEPN,S', ' PCENP,N', ' PCENN,S', 'DPC/DKPN', 'DPC/DKNS',
     | ' DP/THPN', ' DP/THNS', ' OFFCP,N', ' OFFCN,S',
     | '    E1  ', '    E2  ', '    H1  ', '    H2  ', '  ROTE  ',
     | '  ROTH  ', '  TWA6  ', '  TWA21 ', '  ALFA1 ', '  ALFA2 '/
      DATA PI/3.14159265358979/
C
      IFRST = IFRST + 1
      IF (IFRST .GT. 1 .AND. IPR .EQ. 0) RETURN
C
C     ****
C     ****     UNIVERSAL TIME IN HOURS
C     ****
      UT = SECS/3600.
C
C     ****     INTERPOLATE NAURP PARAMETERS
      if (npts(54).ne.0) then ! f107 was not defined by getgpi
        I = 54
        F107 = TERP( AURPS(1,1,I), AURPS(1,2,I), UT, NPTS(I) )
        IF (NPTS(I) .GT. 1) THEN
          IF (UT .LT. AURPS(1,1,I) .OR. UT .GT. AURPS(NPTS(I),1,I)) THEN
            WRITE(6,"(1X,'TAIL:  STOP---UT OUT OF BOUNDS, UT',
     +        ' UTMIN UTMAX =',3F7.2,'  F107')") 
     +        UT,AURPS(1,1,I),AURPS(NPTS(I),1,I)
            STOP
          ENDIF
        ENDIF
      endif
      if (npts(55).ne.0) then ! f107a was not defined by getgpi
        I = 55
        F107A = TERP( AURPS(1,1,I), AURPS(1,2,I), UT, NPTS(I) )
        IF (NPTS(I) .GT. 1) THEN
          IF (UT .LT. AURPS(1,1,I) .OR. UT .GT. AURPS(NPTS(I),1,I)) THEN
            WRITE(6,"(1X,'TAIL:  STOP---UT OUT OF BOUNDS, UT',
     +        ' UTMIN UTMAX =',3F7.2,'  F107A')") 
     +        UT,AURPS(1,1,I),AURPS(NPTS(I),1,I)
           STOP
          ENDIF
        ENDIF
      endif
      DO 100 I=1,NAURP
        if (npts(i).eq.0) goto 100 ! parameter was defined by getgpi
        IF (NPTS(I).EQ.1) GO TO 99
        IF (UT .LT. AURPS(1,1,I) .OR. UT .GT. AURPS(NPTS(I),1,I)) THEN
          WRITE(6,"(1X,'TAIL:  STOP---UT OUT OF BOUNDS, UT UTMIN ',
     +      'UTMAX =',3F7.2,2X,A8)") UT,AURPS(1,1,I),AURPS(NPTS(I),1,I),
     +      NAMEHA(I)
          STOP
        ENDIF
  99    PARAMV(I) = TERP(AURPS(1,1,I),AURPS(1,2,I),UT,NPTS(I))
 100  continue
C
C  REPLACE HP AND CP WITH N. HEM. VALUES FROM THE AMIE VOLUME
      IF (IAMIE .EQ. 1) THEN
       SECA = AMAX1(SECUTA(1),SECS)
       SECA = AMIN1(SECUTA(2),SECA)
       F1 = SECA - SECUTA(1)
       F2 = SECUTA(2) - SECA
       HP = (F2*HPNHA(1) + F1*HPNHA(2)) / FLOAT(NSPSEC)
       CP = (F2*CPNHA(1) + F1*CPNHA(2)) / FLOAT(NSPSEC)
       CLAT = (F2*CUSPSLA(1) + F1*CUSPSLA(2)) / FLOAT(NSPSEC)
       CMLT = (F2*CUSPSTA(1) + F1*CUSPSTA(2)) / FLOAT(NSPSEC)
       CRAD(1) = (90.-CLAT)*PI/180.
       PHIDA(1) = (CMLT - 12.) * PI / 12.
       CLAT = (F2*CUSPNLA(1) + F1*CUSPNLA(2)) / FLOAT(NSPSEC)
       CMLT = (F2*CUSPNTA(1) + F1*CUSPNTA(2)) / FLOAT(NSPSEC)
       CRAD(2) = (90.-CLAT)*PI/180.
       PHIDA(2) = (CMLT - 12.) * PI / 12.
C  Compute variables for eflx2
       PLEVEL = 2.09 * ALOG(HP)
       H1 = AMIN1 (2.35, 0.83 + 0.33 * PLEVEL )
       H2 = 2.87 + 0.15 * PLEVEL
       ROTH = (12.18 - 0.89*PLEVEL) * 15.
       ROTE = (2.62 - 0.55*PLEVEL) * 15.
      ENDIF
C
      PLEVEL = 0.
      IF (HP .GE. 0.01) PLEVEL = 2.09 * ALOG(HP)
C     **** PUT F107,F107A INTO CONSTANT ARRAY
      C(61) = F107
      C(62) = F107A
C
C  FIND LIMITS OF BY WHICH ARE VALID FOR MODEL OF (3/89)
      BYGD = AMIN1(7.,BY)
      BYGD = AMAX1(-11.,BYGD)
      IHP = 1
      IHN = 2
      IF (BY .GT. 0.) THEN
       IHP = 2
       IHN = 1
      ENDIF
C  ASSUME THAT WE ARE ALWAYS DEALING WITH S AND N HEM IN PARAMV
       INH = 2
       ISH = 1

C

      HP35 = AMIN1(HP,35.)
      HPM35 = AMAX1(0.,HP-35.)

C
C  SET CUSP AND DRIZZLE PARAMETERS
C     ****
C     ****     CHANGE CUSP AND DRIZZLE PARAMETERS
C     ****     (IN TGCM3 HAD EC=0.40, ALFAC=0.09, ED=0.05, ALFAD=0.20)
C     ****     (WAS TOO MUCH ED ESPECIALLY.)
C     EC = 0.1+0.9*HP/100.
      EC = 0.01+0.09*HP/100.
      ALFAC = 0.5
C     ED = 0.1+2.*HP/100.
      ED = 0.01+0.2*HP/100.
      ALFAD = 0.75
      FC = CONVRT * EC / ALFAC
      FD = CONVRT * ED / ALFAD
C  SECOND ALFA REPRESENTING LOW ENERGIES AT HIGH ALTITUDES
       E21 = 1.E-80
       E22 = 1.E-80
      ALFA21=0.075
      ALFA22=0.075
      ALFA20 = 0.5 * (ALFA21 + ALFA22)
      RALFA2 = (ALFA22 - ALFA21) / (ALFA21 + ALFA22 + E)
C*****************
      IUT = UT + E
      UT24 = AMOD(UT,24.)
      MDAY = UT/24.
      IF (ABS(UT-IUT) .LT. 0.001) WRITE (6,"(1X,'TAIL:  UT HP CP BY =',
     | F8.2,I3,F8.2,3F7.1/1X,'EC ALFAC FC ED ALFAD FD ALFA21,22 ALFA20
     |RALFA2=',2F7.3,E10.3,2F7.3,E10.3,4F7.3)") UT,MDAY,UT24,HP,CP,BYIMF
     |,EC,ALFAC,FC,ED,ALFAD,FD,ALFA21,ALFA22,ALFA20,RALFA2
       IF (IAMIE .EQ. 1) GO TO 190
C*****************
C  OLD ALFA
      IF (JSWOLDA .EQ. 1) THEN
C     ALFA1 = 0.91
C     ALFA2 = 0.63 + 0.039*HP35 + 0.0022*HPM35
      ALFA1 = 2.0
      ALFA2 = 3.0
C
       TWA6 = 0.
       TWA21 = 0.
      ELSE
       ALFA1 = 0.
       ALFA2 = 0.
      ENDIF

C
      IF (NAURP .GT. 3) THEN
       DO 110 N=1,2
       R1(N) = PARAMV(4)
       PHIDM0(N) = PARAMV(5)
       PHIDP0(N) = PARAMV(6)
       PHINM0(N) = PARAMV(7)
  110  PHINP0(N) = PARAMV(8)
       ARAD(INH) = PARAMV(9)
      ARAD(ISH) = PARAMV(10)
      OFFA(INH) = PARAMV(11)
      OFFA(ISH) = PARAMV(12)
      DSKOFA(INH) = PARAMV(13)
      DSKOFA(ISH) = PARAMV(14)
C  THIS PART IS NEW  (11/10/88)
      PHID(INH) = PARAMV(15)
      PHID(ISH) = PARAMV(16)
      PHIN(INH) = PARAMV(17)
      PHIN(ISH) = PARAMV(18)
      PSIE(INH) = -CP * PARAMV(19)
      PSIM(INH) = CP * (1.-PARAMV(19))
      PSIE(ISH) = -CP * PARAMV(20)
      PSIM(ISH) = CP * (1.-PARAMV(20))
      PCEN(INH) = PARAMV(21) * CP
      PCEN(ISH) = PARAMV(22) * CP
C  CONVERT BACK TO OLDER METHOD TEMPORARILY
C     PHID(IHP) = PARAMV(15)
C     PHID(IHN) = PARAMV(16)
C     PHIN(IHP) = PARAMV(17)
C     PHIN(IHN) = PARAMV(18)
C     PSIE(IHP) = -CP * PARAMV(19)
C     PSIM(IHP) = CP * (1.-PARAMV(19))
C     PSIE(IHN) = -CP * PARAMV(20)
C     PSIM(IHN) = CP * (1.-PARAMV(20))
C     PCEN(IHP) = PARAMV(21) * PSIE(IHP)
C     PCEN(IHN) = PARAMV(22) * PSIM(IHN)
C  END OF CONVERSION
      IF (JDIDK .EQ. 0) THEN
       DISPC = PARAMV(23)
       DSKOFC(INH) = DSKOFA(INH) + DISPC
       DSKOFC(ISH) = DSKOFA(ISH) + DISPC
      ELSE
       DSKOFC(INH) = PARAMV(23)
       DSKOFC(ISH) = PARAMV(24)
       DISPC = DSKOFC(INH) - DSKOFA(INH)
      ENDIF
      IF (JDITH .EQ. 0) THEN
       DISP = PARAMV(25)
       THETA0(INH) = ARAD(INH) - DISP
       THETA0(ISH) = ARAD(ISH) - DISP
      ELSE
       THETA0(INH) = PARAMV(25)
       THETA0(ISH) = PARAMV(26)
       DISP = ARAD(INH) - PARAMV(25)
      ENDIF
      OFFC(INH) = PARAMV(27)
      OFFC(ISH) = PARAMV(28)
      IF(NAURP .GT. 28) THEN
       E1 = PARAMV(29)
       E2 = PARAMV(30)
       H1 = PARAMV(31)
       H2 = PARAMV(32)
       ROTE = PARAMV(33)
       ROTH = PARAMV(34)
       IF (JSWOLDA .EQ. 0) THEN
        TWA6 = PARAMV(35)
        TWA21 = PARAMV(36)
       ELSE
      ALFA1 = 2.0
      ALFA2 = 3.0
       ENDIF
       GO TO 135
      ENDIF           !  FOR NAURP .GT. 3
      ELSE
C  MADE NEW MODEL IN 3/89
C  ION CONVECTION PARAMETERS:
       DSKOFC(INH) = -0.08 - 0.15*BYGD
       DSKOFC(ISH) = -0.08 + 0.15*BYGD
       PHID(INH) = (9.39 - 0.21 * BYGD - 12.) * 15.
       PHID(ISH) = (9.39 + 0.21 * BYGD - 12.) * 15.
       PHIN(INH) = (23.50 - 0.15 * BYGD - 12.) * 15.
       PHIN(ISH) = (23.50 + 0.15 * BYGD - 12.) * 15.
       PCEN(INH) = (-0.168 - 0.027 * BYGD) * CP
       PCEN(ISH) = (-0.168 + 0.027 * BYGD) * CP
       DO 3010 IH=1,2
       R1(IH) = -2.6
       IF (IAMIE .EQ. 1) THEN
C  FORMULA FOR AMIE POTENTIALS
        THETA0(IH) = -1.92 + 8.10 * (CP**0.1875)
       ELSE
C  FORMULA FOR IMF POTENTIALS
        THETA0(IH) = -3.80 + 8.48 * (CP**0.1875)
       ENDIF
       OFFC(IH) = 1.1
       PSIM(IH) = 0.44 * CP
       PSIE(IH) = -0.56 * CP
       PHIDP0(IH) = 85.
       PHIDM0(IH) = 50.
       PHINP0(IH) = 57.5
       PHINM0(IH) = 100.
C  AURORAL PRECIPITATION
       RHP = 14.20 + 0.96*PLEVEL
       IF (IAMIE .EQ. 1) THEN
C  FORMULA FOR AMIE POTENTIALS
        RCP = 3.06 + 8.49 * (CP**0.1875)
       ELSE
C  FORMULA FOR IMF POTENTIALS
        RCP = -0.43 + 9.69 * (CP**0.1875)
       ENDIF
       ARAD(IH) = AMAX1(RHP,RCP)
 3010  CONTINUE
       OFFA(INH) = 3.7
       OFFA(ISH) = 4.3
       DSKOFA(INH) = -1.26 - 0.15 * BYGD
       DSKOFA(ISH) = -1.26 + 0.15 * BYGD
       DISP = ARAD(1) - THETA0(1)
       DISPC = DSKOFC(1) - DSKOFA(1)
      ENDIF
       E1 = AMAX1( 0.50, -2.15 + 0.62 * PLEVEL)
       E2 = 0.95 + 0.117 * HP
       ROTE = (2.62 - 0.55 * PLEVEL) * 15.
       H1 = AMIN1( 2.35, 0.83 + 0.33 * PLEVEL )
       H2 = 2.87 + 0.15 * PLEVEL
       ROTH = (12.18 - 0.89 * PLEVEL) * 15.
C  AURORAL PRECIPITATION
 135   RHP = 14.20 + 0.96*PLEVEL
C  FORMULA FOR AMIE POTENTIALS
       RCP = 3.06 + 8.49 * (CP**0.1875)
C  FORMULA FOR IMF POTENTIALS
       RCP = -0.43 + 9.69 * (CP**0.1875)
       RAUR = AMAX1(RCP,RHP)
C  ELECTRON MEAN ENERGIES
       TWAK = 0.50
      IF (NAURP .LE. 28 .AND. JSWOLDA .EQ. 0) THEN
        TWA6 = 0.36 + 0.48 * PLEVEL
        TWA21 = AMAX1( 1.00, -1.75 + 0.69 * PLEVEL )
      ENDIF
       ROT6 = (6.00 - 12.) * 15.
       ROT21 = (21.00 - 12.) * 15.
       T6 = 7.00
       T21 = 4.00
       D6 = -4.0
       D6V = 0.
       D21 = 4.0
       H6 = 7.0
       H21 = 10.0
  140 CONTINUE
      IF (HP .LT. 0.01) THEN
       E1 = 1.E-20
       E2 = 1.E-20
       EC = 1.E-20
       ED = 1.E-20
       E21 = 1.E-20
       E22 = 1.E-20
       FD = 1.E-20
       FC = 1.E-20
      ENDIF
C
      RAURSH = ARAD(1)
      RAURNH = ARAD(2)
C  SET SHIELDING RADIUS FOR FOSSIL WIND
C     THETSH = ARAD(2) + H1 + H2
      THETSH = ARAD(2) + H2
C  OLD ALFA
      ALFA0 = 0.5 * (ALFA1 + ALFA2)
      RALFA = (ALFA2 - ALFA1) / (ALFA1 + ALFA2 + E)
C
      IUT = UT + E
      IF (ABS(UT-IUT) .LT. 0.001) WRITE (6,603) UT, HP, CP, BYIMF,
     | RHP, RCP, RAUR, (THETA0(I),I=1,51), DISPC,ARAD(1),ARAD(2),
     | TWA6,TWA21,JSWOLDA,JDIDK,JDITH
  603 FORMAT(1X,'TAIL:  ',4X,'UT HP CP BYIMF RHP RCP RAUR =', 7F6.1/
     |1X,'PARAMD=THETA0(2),OFFA(2),OFFC(2),DSKOFA(2),DSKOFC(2),PHID(2)'/
     |1X,'     PHIN(2),PHIDP0(2),PHIDM0(2),PHINP0(2),PHINM0(2),PSIM(2)'/
     |1X,'   PSIE(2),PCEN(2),ARAD(2),H1,H2,ROTH,E1,E2,ROTE,EC,ED,ALFA1'/
     |1X,'   ALFA2,TWAK,TWA6,TWA21,ROT6,ROT21,D6,D21,H6,H21,T6,T21'/
     | 5X, 'PARAMD(1-10) =', 10E10.3/ 5X, 'PARAMD(11-20)=',10E10.3/
     | 5X, 'PARAMD(21-30)=', 10E10.3/ 5X, 'PARAMD(31-40)=',10E10.3/
     | 5X, 'PARAMD(41-50)=', 10E10.3/ 5X, 'PARAMD(51)=',E10.3/
     | 5X, 'DISPC ARAD(1,2) TWA6 TWA21 JSWOLDA,DIDK,DITH =', 5F6.3,3I3)
C     ****     SET INITIALIZATION FLAG
      ISTAR=0
C     ****
C     ****    INSERT VALUES IN COMMON BLOCK, PARAMS.
C     ****
      RRAD(1) = ARAD(1) * DTR
      RRAD(2) = ARAD(2) * DTR
  190 CONTINUE
      RROTH = ROTH * DTR
      RROTE = ROTE * DTR
      H0 = 0.5 * (H1 + H2) * DTR
      RH = (H2 - H1) / (H1 + H2 + E)
      E20 = 0.5 * (E21 + E22)
      RE2 = (E22 - E21) / (E21 + E22)
      IF (IAMIE .EQ. 1) RETURN
      E0 = 0.5 * (E1 + E2)
      REE = (E2 - E1) / (E1 + E2)
C  CALCULATE HEMISPHERIC POWER
      PI = 3.1415926535898
      P0 = E0 * (2.*PI**1.5) * ((6.37E8+1.E7)**2) * ((ARAD(1)
     1 *PI) / 180.) * H0
      HPGWSH = P0 * (1. + 0.5*REE*RH*COS(RROTH-RROTE) ) / 1.E+16
      HPGWNH = HPGWSH * ARAD(2) / ARAD(1)
C
      DO 200 N=1,22
  200 RDEG(N) = THETA0(N) * DTR
      DO 210 N=1,6
  210 PSIV(N) = PSIM(N) * 1000.
C
C  ADD IN VARIATIONS TO 2*ALFA   (SEP 1986)
      ALFK = TWAK * 0.5
      ALF6 = TWA6 * 0.5
      ALF21 = TWA21 * 0.5
      RROT6 = ROT6 * DTR
      RROT21 = ROT21 * DTR
      RD6 = D6 * DTR
      RD6V = D6V  * DTR
      RD21 = D21 * DTR
      RH6 = H6 * DTR
      RH21 = H21 * DTR
      RT6 = T6 * 15. * DTR
      RT21 = T21 * 15. * DTR
      RETURN
      END
C
