#include "dims.h" ! subroutine tail(iprint) use input_module,only: power,ctpoten,byimf,f107,f107a, | rd_alfa30,rd_e30,rd_ed2,rd_alfad2 ! ! Set auroral parameters. Most of these are optionally read by ! input (time-dependent input of these is not yet available) ! ! This version of tail assumes naurp=3 (only hp,cp,by are input), ! and constant hp,cp,by in time. It also assumes JSWOLD=1 (OLDALFA) ! from the old tail. ! implicit none #include "params.h" #include "amie.h" ! ! Parameters from /ovalr/ that are set here (or received from input), ! and referenced by orora: fc,alfac,fd,alfad, e30,fd2,alfad2 ! #include "ovalr.h" ! ! The first 15 parameters in ioncr.h are optional inputs (see input): #include "ioncr.h" ! ! Define /ovalpos/ here rather than in flowv3 real :: cosofa,sinofa,aslona,pi,pi2 COMMON /OVALPOS/ COSOFA(2),SINOFA(2),ASLONA(2),PI,PI2 ! ! Args: integer,intent(in) :: iprint ! ! Local: real :: ec,ed,dtr,e1,e2,rote,h1,h2,roth,rhp,rcp,raur,twak, | twa6,twa21,rot6,rot21,t6,t21,d6,d21,h6,h21, | raursh,raurnh,thetsh,alfa1,alfa2,e,ut,p0,hpgwsh,hpgwnh, | plevel,hp,cp,arad(2),ofda,f1,f2,clat,cmlt,bygd,hp35,hpm35,e21, | e22,alfa21,alfa22,ut24,dispc,disp,d6v real,parameter :: convrt=3.1211e+8 integer,parameter :: ish=1,inh=2 ! south,north hemispheres integer :: i,iut,n ! ! write(6,"('enter tail: /ingpi/ ctpoten, power, byimf=', ! | 3e12.4)") ctpoten,power,byimf ! ! pi,pi2 in /ovalpos/, referenced by flowv3 pi = 4.*atan(1.) PI2=2.*PI dtr = pi/180. e = 1.e-10 ! ! Set cusp and drizzle parameters alfac, alfad, fc, fd (ovalr.h): ! (power, from input, is in ingpi.h) ! ! ec = 0.1+0.9*power/100. ! pre-13mt ! ec = 0.01+0.09*power/100. ! kibo ! alfac = 0.5 ! kibo ec = 0.5 ! snoe alfac = 1.0 ! snoe ! ed = 0.1+2.*power/100. ! pre-13mt ! ed = 0.01+0.2*power/100. ! kibo ! alfad = 0.75 ! kibo ! ed = 0.5 ! tiegcm ! ed = 0.5 ! time-gcm ! 12/11/00: ed and alfad as per kibo12 (no change): ed = 0.25 ! tgcm22mt+kibo12 alfad = 2.0 ! snoe fc = convrt * ec / alfac fd = convrt * ed / alfad C SECOND ALFA REPRESENTING LOW ENERGIES AT HIGH ALTITUDES E21 = 1.E-20 E22 = 1.E-20 ALFA21=0.075 ALFA22=0.075 ALFA20 = 0.5 * (ALFA21 + ALFA22) RALFA2 = (ALFA22 - ALFA21) / (ALFA21 + ALFA22 + E) ! C 12/91 Add proton drizzle and high energy aurora C alpha = 0.5*mean energy in keV, flux in ergs/cm-2 C To eliminate, just set flux to 1.e-20 C **** C C **** PROTON CHARACTERISTIC ENERGY IN THE POLAR CAP (SOLAR PROTONS C **** ALFAD2 IN MEV AND ED2 IN ERGS CM-2 S-1 C C **** ELECTRON CHARACTERISTIC ENERGY IN THE AURORAL OVAL C **** ALFA30 IN KEV AND E30 IN ERGS CM-2 S-1 C **** ! 12/00: Assign from input: alfa30 = rd_alfa30 alfad2 = rd_alfad2 e30 = rd_e30 ed2 = rd_ed2 FD2 = ED2/1.602E-6 ! do i=ish,inh if (iamie==0) then theta0(i) = -3.80 + 8.48 * (ctpoten**0.1875) else theta0(i) = -1.92 + 8.10 * (ctpoten**0.1875) endif theta0(i) = theta0(i) C offc(i) = 1.1 C phidp0(i) = 85. C phidm0(i) = 50. C phinp0(i) = 57.5 C phinm0(i) = 100. C psim(i) = 0.44 * ctpoten C psie(i) = -0.56 * ctpoten offc(i) = 1. phidp0(i) = 90. phidm0(i) = 90. phinp0(i) = 90. phinm0(i) = 90. psim(i) = 0.5 * ctpoten psie(i) = -0.5 * ctpoten enddo C offa(ish) = 4.3 C offa(inh) = 3.7 C dskofa(ish) = (-1.26 + 0.15 * byimf) C dskofa(inh) = (-1.26 - 0.15 * byimf) C dskofc(ish) = (-0.08 + 0.15 * byimf) C dskofc(inh) = (-0.08 - 0.15 * byimf) offa(ish) = 1. offa(inh) = 1. dskofa(ish) = 0. dskofa(inh) = 0. dskofc(ish) = 0. dskofc(inh) = 0. ! phid(ish) = ((9.39 + 0.21 * byimf - 12.) *15.) ! phid(inh) = ((9.39 - 0.21 * byimf - 12.) *15.) ! phin(ish) = ((23.5 + 0.15 * byimf - 12.) *15.) ! phin(inh) = ((23.5 - 0.15 * byimf - 12.) *15.) C **** MODS FOR STRAIGHT ON NOON-MIDNIGHT CONVECTION phid(:) = 0. phin(:) = 180. C ! pcen(ish) = (-0.168 - 0.027 * byimf) * ctpoten ! pcen(inh) = (-0.168 + 0.027 * byimf) * ctpoten C pcen(ish) = (-0.168 + 0.027 * byimf) * ctpoten C pcen(inh) = (-0.168 - 0.027 * byimf) * ctpoten pcen(ish) = 0. pcen(inh) = 0. rr1(:) = -2.6 ! ! Report auroral parameters in degrees: ! if (iprint > 0) then ! write(6,"(/'Tail: input variables:')") write(6,"(' f107 =',e12.4,' f107a=',e12.4)") f107,f107a write(6,"(' ctpoten=',e12.4)") ctpoten write(6,"(' power =',e12.4)") power write(6,"(' byimf =',e12.4)") byimf ! write(6,"(' fkp =',e12.4)") fkp ! write(6,"(/'Tail: /ioncr/ variables (deg south,north):')") write(6,"(' theta0 = ',2e12.4)") theta0 write(6,"(' offa = ',2e12.4)") offa write(6,"(' offc = ',2e12.4)") offc write(6,"(' dskofa = ',2e12.4)") dskofa write(6,"(' dskofc = ',2e12.4)") dskofc write(6,"(' phid = ',2e12.4)") phid write(6,"(' phin = ',2e12.4)") phin write(6,"(' phidp0 = ',2e12.4)") phidp0 write(6,"(' phidm0 = ',2e12.4)") phidm0 write(6,"(' phinp0 = ',2e12.4)") phinp0 write(6,"(' phinm0 = ',2e12.4)") phinm0 write(6,"(' psim = ',2e12.4)") psim write(6,"(' psie = ',2e12.4)") psie write(6,"(' pcen = ',2e12.4)") pcen write(6,"(' ')") endif plevel = 0. if (power >= 0.01) plevel = 2.09 * alog(power) C E1 = AMAX1( 0.50, -2.15 + 0.62 * PLEVEL) C E2 = 0.95 + 0.117 * power C **** SNOE PARTICLE ENERGY FLUX ! E1 = AMAX1( 0.50, -2.15 + 0.62 * PLEVEL)*1.5 ! kibo C E1 = (0.95 + 0.117 * power) ! E2 = (0.95 + 0.117 * power) ! kibo C E1 = (1.0 + 0.15* power) C E2 = (1.0 + 0.15* power) ! E1 = (1.0 + 0.25* power) ! tiegcm snoe ! E2 = (1.0 + 0.25* power) ! tiegcm snoe E1 = (0.5 + 0.15* power) ! timegcm E2 = (1.5 + 0.25* power) ! timegcm ! ! 1/2/00: change ROTE and ROTH as per kibo12: ! ROTE = (2.62 - 0.55 * PLEVEL) * 15. ! ROTH = (12.18 - 0.89 * PLEVEL) * 15. ROTE = (2.62 - 0.55 * PLEVEL) ROTH = (12.18 - 0.89 * PLEVEL) ! ! H1 = AMIN1( 2.35, 0.83 + 0.33 * PLEVEL ) ! kibo ! H2 = 2.87 + 0.15 * PLEVEL ! kibo ! H1 = 3.+0.1*power ! tiegcm snoe ! H2 = 3.+0.1*power ! tiegcm snoe H1 = 2.+0.05*power ! timegcm H2 = 3.+0.2*power ! timegcm C AURORAL PRECIPITATION 135 RHP = 14.20 + 0.96*PLEVEL C FORMULA FOR AMIE POTENTIALS RCP = 3.06 + 8.49 * (ctpoten**0.1875) C FORMULA FOR IMF POTENTIALS RCP = -0.43 + 9.69 * (ctpoten**0.1875) RAUR = max(RCP,RHP) arad(1) = max(rcp,rhp) arad(2) = max(rcp,rhp) C ELECTRON MEAN ENERGIES TWAK = 0.50 TWA6 = 0. TWA21 = 0. 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 E21 = 1.e-20 E22 = 1.e-20 IF (power .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 ALFA1 = 2. ! 12/11/00: alfa2=2. as per kibo12 (and "old alpha": ALFA2 = 2. ! kibo ! ALFA2 = 3. ! kibo ! ALFA2 = 2. ! snoe ALFA0 = 0.5 * (ALFA1 + ALFA2) RALFA = (ALFA2 - ALFA1) / (ALFA1 + ALFA2 + E) C 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) ! ! Convert to radians: theta0(:) = theta0(:) * dtr offa(:) = offa(:) * dtr offc(:) = offc(:) * dtr dskofa(:) = dskofa(:) * dtr dskofc(:) = dskofc(:) * dtr phid(:) = phid(:) * dtr phin(:) = phin(:) * dtr phidp0(:) = phidp0(:) * dtr phidm0(:) = phidm0(:) * dtr phinp0(:) = phinp0(:) * dtr phinm0(:) = phinm0(:) * dtr ! psim(:) = psim(:) * 1000. psie(:) = psie(:) * 1000. pcen(:) = pcen(:) * 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 ! ! Define shared common /ovalpos/ and parts of shared common /ioncr/ ! (this was moved from flowv3 where it was based on ISTAR) ! ! OFDA is local, OFFA, and DSKOFA are in reg common /IONCR/ (ioncr.h) ! (OFFA and DSKOFA were defined above) ! DO 50 N=1,2 OFDA = SQRT(OFFA(N)**2 + DSKOFA(N)**2) ! ! COSOFA, SINOFA, ASLONA are in reg common /OVALPOS/. ! These are used in flowv3 before calls to aurht and polht. ! COSOFA(N) = COS(OFDA) SINOFA(N) = SIN(OFDA) ASLONA(N) = ASIN(DSKOFA(N)/OFDA) ! ! PHIN is in /IONCR/ (was defined by tail.f) ! IF (PHIN(N).LT.PHID(N)) PHIN(N)=PHIN(N)+PI2 50 CONTINUE ! if (iprint > 0) then write(6,"('Tail: /ovalr/ variables:')") write(6,"(' rrad =',2e12.4)") rrad write(6,"(' h0 =',e12.4)") h0 write(6,"(' rh =',e12.4)") rh write(6,"(' rroth =',e12.4)") rroth write(6,"(' e0 =',e12.4,' (e1,e2=',2e12.4,')')") e0,e1,e2 write(6,"(' ree =',e12.4)") ree write(6,"(' rrote =',e12.4)") rrote write(6,"(' fc =',e12.4,' fd =',e12.4)") fc,fd write(6,"(' alfac =',e12.4,' alfad =',e12.4,' alfk=',e12.4)") | alfac,alfad,alfk write(6,"(' alf6 =',e12.4,' alf21 =',e12.4)") alf6,alf21 write(6,"(' rrot6 =',e12.4,' rrot21=',e12.4)") rrot6,rrot21 write(6,"(' rd6 =',e12.4,' rd6v =',e12.4)") rd6,rd6v write(6,"(' rd21 =',e12.4)") rd21 write(6,"(' rh6 =',e12.4,' rh21 =',e12.4)") rh6,rh21 write(6,"(' rt6 =',e12.4,' rt21 =',e12.4)") rt6,rt21 write(6,"(' alfa0 =',e12.4,' alfa20=',e12.4)") alfa0,alfa20 write(6,"(' ralfa =',e12.4,' ralfa2=',e12.4)") ralfa,ralfa2 write(6,"(' e20 =',e12.4)") e20 write(6,"(' re2 =',e12.4)") re2 write(6,"(' alfa30=',e12.4,' e30 =',e12.4)") alfa30,e30 write(6,"(' alfad2=',e12.4,' ed2 =',e12.4)") alfad2,ed2 write(6,"(' ')") endif end subroutine tail