      SUBROUTINE INPUT
      implicit none
C     ****     PERFORMS LEXICAL READ OF PARAMETERS DEFINING TGCM RUN
      include "params.h"
      include "cons.h"
      include "strt.h"
      include "buff.h"
      include "sechis.h"
C     ****     LABEL='LABEL' (UP TO 320 CHARACTERS)
C     ****           LABEL FOR THIS RUN
C     ****     DATE=IYEAR,IDAY(,UT MODEL DAY FOR IDAY)   (INTEGERS)
C     ****          IF HAVE ONLY THE FIRST 2 PARAMETERS, IYEAR AND IDAY
C     ****           ARE THE YEAR (1979, SAY) AND DAYNUMBER OF THE YEAR
C     ****           FOR WHICH THE MODEL IS TO BE APPLIED.
C     ****          IF HAVE 3 PARAMETERS, THE THIRD PARAMETER IS THE UT
C     ****           MODEL DAY WHICH APPLIES TO IYEAR AND IDAY.  THE
C     ****           CODE WILL ADJUST AND ADVANCE THE DAY PROPERLY
C     ****           ACCORDING TO START AND HIST.
C     ****          IYEAR,IDAY = YEAR AND DAY FOR WHICH MODEL IS TO BE
C     ****          APPLIED
C     ****     MAGVOL='USER','ID','FILE'
C     ****          IDENTIFIES VOLUME CONTAINING MAGNETIC DATA
C     ****          USER=USER LOGON               (UP TO 8 CHARACTERS)
C     ****          ID=MASS STORE DIRECTORY NAME  (UP TO 8 CHARECTERS)
C     ****          FILE=MASS STORE FILENAME      (UP TO 7 CHARECTERS)
C     ****     SOURCE='USER','ID','FILE',IDAYSC,IHRSC,MINSC
C     ****          USER, ID, FILE DEFINE SOURCE VOLUME AS UNDER
C     ****            'MAGVOL'.
C     ****          INTEGERS IDAYSC, IHRSC, MINSC GIVE SOURCE TIME.
C     ****          IF SOURCE IS UNDEFINED, MODEL RUN CONTINUES FROM
C     ****          HISTORY ON FIRST OUTPUT VOLUME.  HISTORY TIME IS
C     ****          GIVEN BY 'START'.
C     ****     OUTPUT='USER1','ID1','FILE1',
C     ****            'USER2','ID2','FILE2', - - - -
C     ****          IDENTIFICATION OF UP TO 20 OUTPUT VOLUMES TO BE USED
C     ****          SEQUENTIALLY.  LIMIT OF 13 HISTORIES PER VOLUME.
C     ****          EACH VOLUME IDENTIFIED AS DESCRIBED UNDER 'MAGVOL'.
C     ****     START=IDAYST,IHRST,MINST   (INTEGERS)
C     ****           STARTING TIME: DAY,HOUR,MINUTE
C     ****     STOP=IDAYND1,IHRND1,MINND1(,IDAYND2,IHRND2,MINND2) (INTEG
C     ****           STP TIME1 (AND STP TIME2)
C     ****           HISTORIES MAY BE WRITTEN AT DIFFERENT INTERVAL
C     ****           BETWEEN TIME1 AND TIME2
C     ****     HIST=IDAYH1,IHRH1,MINH1(,IDAYH2,IHRH2,MINH2)       (INTEG
C     ****           INTERVAL(S) AT WHICH HISTORIES TO BE WRITTEN
C     ****           INTERVAL1 BETWEEN START AND STP1
C     ****           INTERVAL2 BETWEEN STP1 AND STP2
C     ****     SAVE=IDAYSV,IHRSV,MINSV    (INTEGERS)
C     ****          SAVE INTERVAL: DAY,HOUR,MINUTE
C     ****     STEP=ISTEP       (INTEGER)
C     ****           STEP IN SECONDS
C     ****     MAG=LATS,LONS,LATN,LONN          (FLOATING)
C     ****           COORDINATES OF S AND N MAGNETIC POLES IN DEGREES
C     ****     DIFHOR=DIFHOR           (INTEGER)
C     ****           DIFHOR = 1 IF HORIZONTAL VARIATION OF EDDY DIFFUSIO
C     ****           IS TO BE CALCULATED BY CALLING USER PROVIDED
C     ****           SUBROUTINE DFACT(T,J,SECS,IMX)
C     ****           DIFHOR = 0 FOR NO HORIZONTAL VARIATION OF EDDY DIFF
C     ****     IUIVI=IUIVI (INTEGER)
C     ****          IUIVI=0 FOR UI=VI=0 IN MOMENTUM EQUATIONS
C     ****          IUIVI=1 FOR UI AND VI INCLUDED
C     ****     TIDE = Z22,Z23,Z24,Z25,Z26,PH22,PH23,PH24,PH25,PH26
C     ****           (FLOATING)
C     ****           Z22,Z23,Z24,Z25,Z26 ARE AMPLITUDES IN CM.,
C     ****           PH22,PH23,PH24,PH25,PH26 ARE PHASES IN HRS.
C     ****           OF 22,23,24,25,26 COMPONENTS.
C     ****           NOTE:  WHEN TIDAL BOUNDARY CONTITION IS USED, BOUND
C     ****           FIELDS FOR T, U, V AND Z ARE PLOTTED.  TO LOOK AT T
C     ****           PLOTS, A SUITABLE DISPOSE OF $PLT SHOULD BE INCLUDE
C     ****           YOUR JCL.
C     ****     AURORA=IAUR     (INTEGER)
C     ****          AURORA=0  FOR NO AURORA
C     ****          AURORA=1  IF AURORA IS PRESENT
C     ****     DISPOSE=IDISP   (INTEGER)
C     ****          DISPOSE=0  FOR NO DISPOSES TO MASS STORE (TESTING)
C     ****          DISPOSE=1  FOR NORMAL OPERATIONAL DISPOSES TO MASS
C     ****                     STORE
C     ****     COLFAC=COLFAC  (FLOATING)
C     ****          COLFAC IS THE FACTOR BY WHICH WE MULTIPLY THE O+-O
C     ****           COLLISION FREQUENCY.  IS USUALLY 1.5
C     ****     TIDE2 = Z11, PH11     (FLOATING)
C     ****          Z11 = AMPLITUDE OF (1,1) TIDAL COMPONENT  (CM)
C     ****          PH11 = PHASE OF (1,1) TIDAL COMPONENT  (HOURS)
C     ****               -12..LE.PH11.LT.12.
C     ****     TIDEANN = ITIDEAN     (INTEGER)
C     ****          ITIDEAN = 0 FOR NO ANNUAL TIDE
C     ****          ITIDEAN = 1 FOR INCLUSION AF ANNUAL TIDE
C     ****          DEFAULT IS ITIDEAN = 1
C     ****
C     ****  THE FOLLOWING LEXICAL READS ARE IN A SEPARATE READLX, AND
C     ****   EXCEPT FOR AMIVOL, CAN BE TIME VARYING.

C     ****          EACH INPUT IS DEFINED BY A TABLE OF VALUES FOR
C     ****          MONOTONICALLY INCREASING TIMES.  VALUE FOR GIVEN
C     ****          TIME IS FOUND BY LINEAR INTERPOLATION.  IF TIME IS
C     ****          OUTSIDE TABLE, LINEAR EXTRAPOLATION OCCURS.  LEXICAL
C     ****          ENTRY IS OF FOLLOWING FORM:
C     ****          PARAM=ID1,IH1,IM1,VAL1,ID2,IH2,IM2,VAL2, - - - - -
C     ****          ,IDN,IHN,IMN,VALN
C     ****          WHERE ID1=DAY1, IH1=HOUR1, IM1=MINUTE1
C     ****          ARE INTEGERS GIVING UNIVERSAL TIME, VAL1 IS
C     ****          CORRESPONDING FLOATING POINT INPUT VALUE.  FOR
C     ****          THIS FORM OF INPUT, N.GE.2, N.LE.50.
C     ****          PARAM=VAL DEFINES A CONSTANT VALUE.
C     ****          NOTE: UT=MT-12.  (HOURS)
C     ****          WHERE UT AND MT ARE UNIVERSAL AND MODEL TIME
C     ****          RESPECTIVELY.  A MODEL DAY RUNS FROM 12.00 TO 12.00
C     ****
C     ****     F107 = F107        (FLOATING)
C     ****          F107 IS THE DAILY 10.7 CM SOLAR FLUX VALUE, WHICH
C     ****           IF VARYING, SHOULD BE CENTERED AT 12 UT.
C     ****     F107A = F107A      (FLOATING)
C     ****          F107A IS THE 3 SOLAR ROTATION (81 DAY) AVERAGE 10.7
C     ****           CM SOLAR FLUX.  IF VARYING, SHOULD BE CENTERED AT
C     ****           12 UT.
C     ****     AMIVOL = 'USER','ID','FILE'
C     ****          IDENTIFIES THE AMIE VOLUME OF AURORAL INPUTS
C     ****          IF THIS PARAMETER IS MISSING, THEN WE USE THE HEELIS
C     ****          MODEL OF ION CONVECTION AND THE ROBLE/RIDLEY/EMERY
C     ****          MODEL OF AURORAL PRECIPITATION AS DEFINED BELOW.
C     ****          IF AMIVOL IS PRESENT, THEN ONLY BYIMF NEED BE
C     ****          REAL SINCE POWER AND CTPOTEN ARE ON AMIVOL.
C     ****          THE OTHER PARAMETERS SHOULD BE OMMITTED.
C     ****          IF START IS BEFORE THE BEGINNING OF THE UT PERIOD
C     ****          OF THE AMIE VOLUME, THE PATTERNS OF THE FIRST TIME
C     ****          WILL BE USED.  IF STOP IS AFTER THE END OF THE UT
C     ****          OF THE AMIE VOLUME, THE PATTERNS OF THE LAST TIME
C     ****          WILL BE USED.  THESE FACTS WILL BE NOTED AND LISTED
C     ****          IN THE OUTPUT LISTING, BUT COULD LEAD TO ERRONEOUS
C     ****          RUNS.  HOWEVER, THE YEAR AND DAY NUMBER WILL BE
C     ****          REQUIRED TO BE WITHIN 1 DAY OF THE PERIOD COVERED
C     ****          BY THE AMIE VOLUME.
C     ****     AURORAL INPUTS
C     ****          THERE IS ONE FLAG (OLDALF) APPROPRIATE FOR THE
C     ****          AURORAL INPUTS (SEE END OF THESE COMMENTS), AND
C     ****          3 LEVELS OF INPUTS.
C     **** (1). THE MINIMUM NUMBER OF AURORAL INPUTS NECESSARY ARE:
C     ****          POWER, CTPOTEN, AND BYIMF (3 INPUTS).
C     **** (2). ASSYMETRIC HEELIS CASE USING NEW POLAR CAP (1987,
C     ****       REVISED 10/88)  (18-28 INPUTS)
C     ****    LEXICAL READ FOR THE AURORAL PARAMETERS OF HP, CP, AND
C     ****     BYIMF (3) PLUS ARAD, DISP/THETA0 (ARAD = THETA0 + DISP),
C     ****     OFFA, DKOFA, OFFC, DISPC/DKOFC (DKOFC = DKOFA + DISPC),
C     ****     PCEP, PCEN, PHID, PHIN, PHIDP, PHIDM, PHINP, PHINM, AND
C     ****     R1.  (15)
C     ****   WE CAN DIFFERENTIATE HEMISPHERES FOR ARAD, OFFA, OFFC,
C     ****   DKOFA, PHID, PHIN, PCEP, PCEN, DISP/THETA0, AND DISPC/DKOFC
C     ****   (10). IF WE ONLY SPECIFY THE GENERIC NAME, BOTH HEMISPHERES
C     ****   WILL BE SET EQUAL.
C     ****    NO INPUTS = 3 + 15 + 10 = 28  (OR SPECIFY  3 + 15 = 18
C     ****            WHERE WE HAVE EQUAL HEMISPHERES.)
C     **** (3). HEELIS CASE PLUS OVAL (ASSYMMETRICAL)  (28-38 INPUTS)
C     ****    ALL THE ABOVE PARAMETERS PLUS H1, H2, ROTH, E1, E2, ROTE,
C     ****    TWA6, TWA21, ALFA1 AND ALFA2.  (10) NO INPUTS=28 + 10 = 38
C     ****    (OR SPECIFY 3 + 15 + 10 = 28  WHERE 10 ARE DUPLICATE HEMS)
C     ****
C     ****   GENERAL INDICES OF AURORAL POWER, CONVECTION STRENGTH AND
C     ****    CONVECTION ASSYMETRY, UPON WHICH ALL THE OTHER CONVECTION
C     ****    AND OVAL CHARACTERISTICS CAN BE PARAMETERIZED IN TAIL.
C     **** 1)  POWER      (FLOATING)
C     ****          POWER IS THE HEMISPHERIC POWER IN GW, USUALLY TAKEN
C     ****          FROM DAVE EVANS.
C     **** 2)  CTPOTEN    (FLOATING)
C     ****          CTPOTEN IS THE CROSS-TAIL POTENTIAL IN KV, USUALLY
C     ****          INFERRED FROM THE REIFF AND LUHMANN (1986) FORMULA
C     ****          OF VBSIN3(THETA/2).
C     **** 3)  BYIMF      (FLOATING)
C     ****          BYIMF IS THE GSM BY COMPONENT IN NT OF THE SOLAR IMF
C     ****          MAGNETIC FIELD, USUALLY TAKEN FROM THE IMF TAPE.

C     ****    AS NOTED IN AMIVOL, POWER AND CTPOTEN CAN BE FAKE IF HAVE
C     ****     AN AMIE VOLUME, SINCE THEY WILL BE IGNORED.
C     ****
C     ****   CONVECTION CHARACTERISTICS PLUS OVAL LOCATION:
C     ****    (SEE HEELIS ET AL. (1982, JGR, 87, 6339-6345) FOR DETAILS
C     ****     OF THE ION CONVECTION AND HAIRSTON AND HEELIS, (1989,
C     ****     IN PRESS) FOR NON-ZERO POTENTIALS IN THE CENTER OF THE
C     ****     POLAR CAP.)
C     **** 1)  ARAD (ARADNH-N.H.,ARADSH-S.H.)      (FLOATING)
C     ****          ARAD IS THE AURORAL RADIUS IN DEGREES.
C     **** 2)  THETA0 (THETA0NH-N.H.,THETA0SH-S.H.) (FLOATING)
C     ****  OR DISP (DISPNH-N.H.,DISPSH-S.H.) (FLOATING)
C     ****          WHERE ARAD = THETA0 + DISP
C     ****          THETA0 IS THE CONVECTION RADIUS IN DEGREES AND
C     ****          DISP IS THE DISPLACEMENT IN DEGREES BETWEEN THETA0
C     ****          AND ARAD.  GENERALLY LIKE TO GIVE THETA0, BUT IF
C     ****          DISP IS A CONSTANT, IT IS EASIER TO GIVE DISP (OR
C     ****          THEIR APPROPRIATE N.H. AND S.H. NAMES.)
C     **** 3)  OFFA (OFFANH-N.H.,OFFASH-S.H.) (FLOATING)
C     ****          OFFA IS THE OFFSET IN DEGREES FROM THE MAGNETIC
C     ****          POLE OF THE CENTER OF THE AURORAL OVAL, POSITIVE
C     ****          TOWARDS MIDNIGHT.
C     **** 4)  DKOFA (DKOFANH-N.H.,DKOFASH-S.H.) (FLOATING)
C     ****          DKOFA IS THE OFFSET IN DEGREES FROM THE MAGNETIC
C     ****          POLE OF THE CENTER OF THE AURORAL OVAL, POSITIVE
C     ****          TOWARDS DUSK.
C     **** 5)  OFFC (OFFCNH-N.H.,OFFCSH-S.H.) (FLOATING)
C     ****          OFFC IS THE OFFSET IN DEGREES FROM THE MAGNETIC
C     ****          POLE OF THE CENTER OF THE ION CONVECTION, POSITIVE
C     ****          TOWARDS MIDNIGHT.
C     **** 6)  DKOFC (DKOFCNH-N.H.,DKOFCSH-S.H.) (FLOATING)
C     ****  OR DISPC (DISPCNH-N.H.,DISPCSH-S.H.) (FLOATING)
C     ****          WHERE DKOFC = DKOFA + DISPC
C     ****          DKOFC IS THE OFFSET IN DEGREES FROM THE MAGNETIC
C     ****          POLE OF THE CENTER OF THE ION CONVECTION, POSITIVE
C     ****          TOWARDS DUSK.  DISPC IS THE DISPLACEMENT IN DEGREES
C     ****          DISP IS THE DISPLACEMENT IN DEGREES BETWEEN THETA0
C     ****          DKOFA AND DKOFC.  GENERALLY LIKE TO GIVE DKOFC, BUT
C     ****          IF DISPC IS A CONSTANT, IT IS EASIER TO GIVE DISPC
C     ****          (OR THEIR APPROPRIATE N.H. AND S.H. NAMES.)
C     **** 7)  PCEP (PCEPNH-N.H.,PCEPSH-S.H.) (FLOATING)
C     ****          PCEP IS THE PERCENT OF THE TOTAL POTENTIAL WHICH
C     ****          IS IN THE EVENING POTENTIAL.  IS CLOSE THE 0.5
C     **** 8)  PCEN (PCENNH-N.H.,PCENSH-S.H.) (FLOATING)
C     ****          PCEN IS THE FRACTION OF THE TOTAL POTENTIAL AT
C     ****          THE CENTER OF THE ION CONVECTION PATTERN.  IS A
C     ****          NUMBER BETWEEN -1. AND 1.
C     **** 9)  PHID (PHIDNH-N.H.,PHIDSH-S.H.) (FLOATING)
C     ****          PHID IS THE ENTRANCE OF THE ION CONVECTION ON THE
C     ****          DAYSIDE IN MLT HOURS * 15, SO AS TO BE IN DEGREES,
C     ****          WHERE 0 DEGREES IS MIDNIGHT.
C     **** 10) PHIN (PHINNH-N.H.,PHINSH-S.H.) (FLOATING)
C     ****          PHIN IS THE EXIT OF THE ION CONVECTION ON THE
C     ****          NIGHTSIDE IN MLT HOURS * 15, SO AS TO BE IN DEGREES,
C     ****          WHERE 0 DEGREES IS MIDNIGHT.
C     **** 11) PHIDP    (FLOATING)
C     ****          PHIDP IS THE ANGLE IN DEGREES LATER THAN PHID
C     ****          WHICH MARKS THE END OF THE DAYSIDE CONVERGENCE ZONE.
C     **** 12) PHIDM    (FLOATING)
C     ****          PHIDM IS THE ANGLE IN DEGREES EARLIER THAN PHID
C     ****          WHICH MARKS THE START OF THE DAYSIDE CONVERGENCE
C     ****          ZONE.
C     **** 13) PHINP    (FLOATING)
C     ****          PHINP IS THE ANGLE IN DEGREES LATER THAN PHIN
C     ****          WHICH MARKS THE END OF THE NIGHTSIDE CONVERGENCE
C     ****          ZONE.
C     **** 14) PHINM    (FLOATING)
C     ****          PHINM IS THE ANGLE IN DEGREES EARLIER THAN PHIN
C     ****          WHICH MARKS THE START OF THE NIGHTSIDE CONVERGENCE
C     ****          ZONE.
C     **** 15) R1    (FLOATING)
C     ****          R1 IS THE FALL-OFF RATE OF THE ELECTRIC POTENTIAL
C     ****          EQUATORWARDS OF THETA0 FOR 11.3 DEGREES.  A VERY
C     ****          FAST FALL-OFF TAKES OVER EQUATORWARDS OF THAT.
C     ****          (R1 AS DEFINED IN HEELIS IS FOR ALL REGIONS
C     ****          EQUATORWARDS OF THETA0.)
C     ****
C     ****   OVAL CHARACTERISTICS OF WIDTH, ENERGY FLUX AND MEAN ENERGY:
C     ****   (ARE ASSUMED TO BE THE SAME FOR BOTH HEMISPHERES.)
C     ****    (SEE ROBLE AND RIDLEY (1987, ANN. GEOPH., 5, 369-382) FOR
C     ****     DETAILS OF H, E AND ALFA (OLD MODEL).)
C     **** 1)  H1    (FLOATING)
C     ****          H1 IS THE GAUSSIAN HALF-WIDTH OF THE OVAL ON THE
C     ****          DAYSIDE IN DEGREES.
C     **** 2)  H2    (FLOATING)
C     ****          H2 IS THE GAUSSIAN HALF-WIDTH OF THE OVAL ON THE
C     ****          NIGHTSIDE IN DEGREES.
C     **** 3)  ROTH    (FLOATING)
C     ****          ROTH IS THE ROTATION OF THE CENTER OF THE DAYSIDE
C     ****          OF H1 IN DEGREES FROM NOON, POSITIVE LATER.
C     **** 4)  E1    (FLOATING)
C     ****          E1 IS THE PEAK OF THE ENERGY FLUX ON THE DAYSIDE
C     ****          IN ERGS/CM-2-S.
C     **** 5)  E2    (FLOATING)
C     ****          E2 IS THE PEAK OF THE ENERGY FLUX ON THE DAYSIDE
C     ****          IN ERGS/CM-2-S.
C     **** 6)  ROTE    (FLOATING)
C     ****          ROTE IS THE ROTATION OF THE CENTER OF THE DAYSIDE
C     ****          OF E1 IN DEGREES FROM NOON, POSITIVE LATER.
C     **** 7)  TWA6    (FLOATING)
C     ****          TWA6 IS THE VALUE OF THE MEAN ENERGY IN KEV (TWICE
C     ****          THE MAXWELLIAN ALPHA) AT THE PEAK NEAR 6 MLT.
C     **** 8)  TWA21   (FLOATING)
C     ****          TWA21 IS THE VALUE OF THE MEAN ENERGY IN KEV (TWICE
C     ****          THE MAXWELLIAN ALPHA) AT THE PEAK NEAR 21 MLT.
C     **** 9)  ALFA1   (FLOATING)
C     ****          ALFA1 IS THE MAXWELLIAN ALPHA ENERGY IN KEV FOR THE
C     ****          DAYSIDE, WHICH IS ROTATED PAST NOON BY ROTE.
C     **** 10) ALFA2   (FLOATING)
C     ****          ALFA2 IS THE MAXWELLIAN ALPHA ENERGY IN KEV FOR THE
C     ****          NIGHTSIDE, WHICH IS ROTATED PAST MIDNIGHT BY ROTE.
C     ****
C     ****     OLDALF   (INTEGER)
C     ****          OLDALF = 0  IF USE THE NEW ALPHA (TWA6 AND TWA21)
C     ****            DO NOT NEED TO SUPPLY ALFA1 OR ALFA2 IN THIS
C     ****            CASE SINCE THEY WILL BE SET TO ZERO.
C     ****          OLDALF = 1  IF USE THE OLD ALPHA (ALFA1 AND ALFA2)
C     ****            DO NOT NEED TO SUPPLY TWA6 OR TWA21 IN THIS
C     ****            CASE SINCE THEY WILL BE SET TO ZERO.
C     ****          IF OLDALF IS MISSING, IT WILL BE ASSUMED TO BE 1.
c
c 6/4/98 btf: Low energy proton inputs (single floats, in cons.h):
c              ALFALP  Average alpha energy of low proton aurora (Kev) 
c                      (2 < ALFALP < 40) (ALFALP=2 for Maxwellian)
c                      (default = 10.)
c              EFLUXLP Incident energy flux for protons (erg/cm-2/s-1)
c                      (default = 0.4)
c              (see sub low_proton in proton.f, called from orora, and
c               common/aurlp/ in aurht and orora)
C     ****
C     ****
C     ****     TYPICAL LEXICAL INPUT MIGHT READ AS FOLLOWS.  THE FIRST
C     ****     CHARACTER IN THE LINE SHOULD BE A BLANK.  HERE THE BLANK
C     ****     PRECEDED A 'C' FOR OBVIOUS REASONS.
C     ****
C LABEL='GTMS 84180 BY,CP,HP  UT VAR'
C DATE=1984,180
C MAGVOL='ECRIDLEY','ECR89','ECRMG3'
C SOURCE='ROBLE','RGR85','RGR4321',1,12,0
C OUTPUT='ECRIDLEY','ECR86','ECR550',
C        'ECRIDLEY','ECR86','ECR551',
C        'ECRIDLEY','ECR86','ECR552'
C START=1,12,0
C STOP=4,12,0
C HIST=0,1,0
C SAVE=0,6,0
C STEP=150
C MAG=-74.5,127.,79.,-70.
C DIFHOR=0
C IUIVI=1
C TIDE=3.E4,0.0,4.E4,0.0,0.0,-.5,0.0,-2.5,0.0,0.0
C TIDE2=5.E4,10.5
C AURORA=1
C DISPOSE=1
C COLFAC=1.5
C ENDOFREAD
C    ****     THIS IS THE END OF THE FIRST LEXICAL READ
C F107=67.
C F107A=70.
CCAMIVOL=                    (THE 'C' BEFORE AMIVOL COMMENTS THIS OUT)
C POWER=1,0,0,16.,1,18,0,6.,2,2,0,43.,2,22,0,7.,3,3,40,50.,4,1,0,50.
C CTPOTEN=1,0,0,30.,1,13,0,30.,2,2,0,92.,2,18,0,42.,3,2,0,117.,
C 3,18,0,90.,4,1,0,90.
C BYIMF=1,0,0,-7.3,1,7,20,-7.3,1,15,0,-2.3,1,22,0,-5.0,2,6,0,-5.5,
C 2,17,0,-1.8,3,0,0,-7.0,3,13,30,-7.2,4,1,0,7.0


C ENDOFREAD
C     ****
C     ****     IF VALUES FOR A PARAMETER ARE TOO MANY FOR A SINGLE LINE,
C     ****     MAY BE CONTINUED ON THE NEXT LINE AFTER A SEPARATING ','
C     ****
C ALFAD=ID1,IH1,IM1,IVAL1,ID2,IH2,IM2,IVAL2,ID3,IH3,IM3,IVAL3,ID4,IH4,IM
C IVAL4,ID5,IH5,IM5,IVAL5,ID6,IH6,IM6,IVAL6
C     ****
C     ****
C     ****    LEXICAL READ FOR THE AURORAL INPUT PARAMETERS
C     ****
      integer,parameter :: NAURPX=55,NLEX=600
      real :: dum
      COMMON/INPUT/DUM(4,NLEX,NAURPX)
      real :: f107,f107a,ctpoten,hpower,byimf
      common/ingpi/ f107,f107a,ctpoten,hpower,byimf
C     ****
C     ****     NORMAL CASE (NAURP=3)
C     ****
c     DIMENSION POWER(4,NLEX),CTPOTEN(4,NLEX),BYIMF(4,NLEX)
c     EQUIVALENCE (DUM,POWER),(DUM(1,1,2),CTPOTEN),(DUM(1,1,3),BYIMF)
C     ****
      real :: R1(4,NLEX),OFFAPN(4,NLEX),OFFANS(4,NLEX),
     1 DKOFAPN(4,NLEX),DKOFANS(4,NLEX),ARADPN(4,NLEX),ARADNS(4,NLEX),
     2 PHIDPN(4,NLEX),PHIDNS(4,NLEX),PHIDP(4,NLEX),PHIDM(4,NLEX),
     3 PHINP(4,NLEX),PHINM(4,NLEX),PCEPPN(4,NLEX),PCEPNS(4,NLEX),
     4 PHINPN(4,NLEX),PHINNS(4,NLEX),PCENPN(4,NLEX),PCENNS(4,NLEX),
     5 DISPCPN(4,NLEX),DISPCNS(4,NLEX),DISPPN(4,NLEX),DISPNS(4,NLEX),
     6 OFFCPN(4,NLEX),OFFCNS(4,NLEX), E1(4,NLEX),E2(4,NLEX),H1(4,NLEX),
     7 H2(4,NLEX),ROTE(4,NLEX),ROTH(4,NLEX),TWA6(4,NLEX),TWA21(4,NLEX)
     8, ALFA1(4,NLEX),ALFA2(4,NLEX),THET0,PI
C      F107(4,NLEX),F107A(4,NLEX)
C     ****
      EQUIVALENCE (DUM(1,1,4),R1),(DUM(1,1,5),PHIDM),(DUM(1,1,6),PHIDP),
     1 (DUM(1,1,7),PHINM),(DUM(1,1,8),PHINP),(DUM(1,1,9),ARADPN),
     2 (DUM(1,1,10),ARADNS),(DUM(1,1,11),OFFAPN),(DUM(1,1,12),OFFANS),
     3 (DUM(1,1,13),DKOFAPN),(DUM(1,1,14),DKOFANS),(DUM(1,1,15),PHIDPN),
     4 (DUM(1,1,16),PHIDNS),(DUM(1,1,17),PHINPN),(DUM(1,1,18),PHINNS),
     5 (DUM(1,1,19),PCEPPN),(DUM(1,1,20),PCEPNS),(DUM(1,1,21),PCENPN),
     6 (DUM(1,1,22),PCENNS),(DUM(1,1,23),DISPCPN),(DUM(1,1,24),DISPCNS),
     7 (DUM(1,1,25),DISPPN),(DUM(1,1,26),DISPNS),(DUM(1,1,27),OFFCPN),
     8 (DUM(1,1,28),OFFCNS), (DUM(1,1,29),E1),(DUM(1,1,30),E2),
     9 (DUM(1,1,31),H1),(DUM(1,1,32),H2),(DUM(1,1,33),ROTE),
     1 (DUM(1,1,34),ROTH),(DUM(1,1,35),TWA6),(DUM(1,1,36),TWA21),
     2 (DUM(1,1,37),ALFA1),(DUM(1,1,38),ALFA2)
C      ,(DUM(1,1,54),F107),(DUM(1,1,55),F107A)
C     ****
      CHARACTER*8 NAME(NAURPX), NAMEHA(38), NAMUT, username
      integer :: IHP(4,NLEX,1), ICNT(75)
      EQUIVALENCE (DUM,IHP)
      real :: aurps,paramv
      integer :: npts,ipr,naurp,jswolda,jdith,jdidk
      COMMON/AURDAT/ AURPS(NLEX,2,NAURPX), NPTS(NAURPX),IPR, NAURP,
     1 PARAMV(NAURPX), JSWOLDA, JDITH, JDIDK
C     ****
      real :: rmn4s,rmn2d,rmno,brn2d,colfac
      COMMON/MASS/RMN4S,RMN2D,RMNO,BRN2D,COLFAC
C     ****
C     ****
C     ****      DIMENSIONS FOR AMIE FIELDS
C     ****
      include "amie.h"
C     ****
C     ****     COMMON TO RESET LEXICAL DICTIONARY
C     ****
      integer :: kdict,ndx,mxd,nid,idict(3,64)
      COMMON/LXDICT/KDICT,NDX,MXD,NID,IDICT(3,64)
C     ****
!
! Local:
      REAL MAG(2,2)
      LOGICAL ICHK,ISTPCK
      INTEGER YRDA(2),MAGVOL(3),SOURCE(6),OUTPUT(3,20),START(3),
     1STOP(3,2),HIST(3,2),SAVE(3),STEP,DIFHOR,VOL,BLANK,AURORA,DISPOS,
     2TDATE,AMIVOL(3),YRDUTD(3),TIDEANN,iiuivi,ipower
      EQUIVALENCE (INPT(1),LABEL),(INPT(41),YRDA),(INPT(43),OUTPUT),
     1(INPT(103),START),(INPT(106),STOP),(INPT(112),HIST),
     2(INPT(118),SAVE),(INPT(121),STEP),(INPT(122),MAG),
     3(INPT(126),DIFHOR),(INPT(127),IIUIVI),(INPT(128),TIDE),
     4(INPT(138),IPOWER),(INPT(139),AURORA),(INPT(140),DISPOS),
     5(INPT(141),MAGVOL),(INPT(144),SOURCE),(INPT(150),TIDE2),
     6(INPT(152),AMIVOL),(INPT(160),TDATE),(INPT(161),TIDEANN)
!
      real :: f107d_in(4,nlex),f107a_in(4,nlex),ctpot_in(4,nlex),
     |  power_in(4,nlex),byimf_in(4,nlex),TIDE(10),TIDE2(2)
      integer :: LABEL(40), notesec(4),i,lunit,nincore,ntmpdir,nsecout,
     |  nsechist,nsecsave,nsecstart,nsecstop,nsecflds,kend,n,ierror,
     |  isecerr,ixt,ixo2,ixo1,ixz,ixox,ixo3,ixnoz,ixno,ixno2,ixhox,ixoh,
     |  ixho2,ixh,ip,iyr4,iyr100,lpyr,ienda,iadday,lensech,nsech,
     |  nvolsech,nvol,ii,j,m,k,k1,k2,iprint,n5,i1,i1p5,i5,jpts
      integer,external :: unlink,itera,ixfindc,ixpushc,ixfindr
!
! (imposed) max size of an mss file (bytes)
      integer,parameter :: mxmssbytes=200000000	
!
      data f107,f107a,ctpoten,hpower,byimf
     +     /spval,spval,spval,spval,spval/
C     ****
      DATA NAMUT/'      UT'/
C     ****
C     ****     HEELIS CASE PLUS AURORA (ASYMMETRICAL)
C     ****
      DATA NAMEHA/ ' H POWER', ' C POTEN', '  IMF BY', '      R1',
     1 '   PHIDM', '   PHIDP', '   PHINM', '   PHINP', '  ARADPN',
     2 ' ARADN,S', ' OFFAP,N', ' OFFAN,S', '  DKAP,N', '  DKAN,S',
     3 ' PHIDP,N', ' PHIDN,S', ' PHINP,N', ' PHINN,S', ' PCEPP,N',
     4 ' PCEPN,S', ' PCENP,N', ' PCENN,S', 'DPC/DKPN', 'DPC/DKNS',
     5 ' DP/THPN', ' DP/THNS', ' OFFCP,N', ' OFFCN,S',
     6 '    E1  ', '    E2  ', '    H1  ', '    H2  ', '  ROTE  ',
     7 '   ROTH ', '   TWA6 ', '  TWA21 ', '  ALFA1 ', '  ALFA2 '/
      data itapsech,mtapsech,ifilsech,mfilsech,ihissech,mhissech,
     +     isavsech,msavsech,isecstart,isecstop
     +  /-1,-1,-1,-1,-1,-1,-1,-1,-1,-1/
      data notesec/4*0/
C     ****
C     ****     ARITHMETIC STATEMENT FUNCTION
C     ****
C     ****     VOLUME NAME HAS MORE THAN 6 CHARACTERS
      integer :: mask
      logical :: msk
      MSK(VOL)=VOL.NE.AND(VOL,MASK)
C     ****
C     ****      INITIALIZE
C     ****
C     ****
c secflds(mxfsech) = field names requested by user for secondary histories
c secflds_hist(mxfsech)= names of secondary history fields actually
c   written to sec hist. This will always include primary fields requested
c   for secondary histories, but will include diagnostic (non-primary)
c   requested fields only if addfsech is actually called for that field.
c Both secflds and secflds_hist are in sechis.h
c fproc_names (cons.h) is list of allowed primary fields that can go
c   on a secondary history.
c
      lsumm = 512	! length of history summary
      do i=1,mxfsech
        secflds(i) = '        '
        secflds_hist(i) = '        '
      enddo
      MASK=1777777777777777777440B
      BLANK=8H
      LUNIT=5
      DO 1 I = 1,165
      INPT(I)=0
    1 CONTINUE
      DO 2 I=1,40
      LABEL(I)=BLANK
    2 CONTINUE
      DO 3 I = 1,75
      ICNT(I)=0
    3 CONTINUE
      DO 4 I=1,60
      OUTPUT(I)=BLANK
    4 CONTINUE
      DO 30 I=1,3
      SOURCE(I+3) = 0
      SOURCE(I)=BLANK
      MAGVOL(I)=BLANK
      AMIVOL(I) = BLANK
   30 CONTINUE
      DO 5 I=1,NAURPX*NLEX*2
      AURPS(I,1,1)=0.
    5 CONTINUE
      CALL DATE (TDATE)
      WRITE (6,100)
      WRITE (6,"(1X/1X,'****  LOAD IMAGE FOR TGCM13 ON ',A8,' ****'/)")
     | TDATE
C     ****
C     ****     SET UP DICTIONARY FOR NON-AURORAL INPUTS
C     ****
      nincore = 0
      ntmpdir = 0
      tmpdir = ' '
c
      CALL LEXCON(LABEL       ,8HLABEL       ,ICNT(51))
      CALL LEXCON(YRDUTD      ,8HDATE        ,ICNT(52))
      CALL LEXCON(MAGVOL      ,8HMAGVOL      ,ICNT(53))
      CALL LEXCON(SOURCE      ,8HSOURCE      ,ICNT(54))
      CALL LEXCON(OUTPUT      ,8HOUTPUT      ,ICNT(55))
      CALL LEXCON(START       ,8HSTART       ,ICNT(56))
      CALL LEXCON(STOP        ,8HSTOP        ,ICNT(57))
      CALL LEXCON(HIST        ,8HHIST        ,ICNT(58))
      CALL LEXCON(TMPDIR      ,8HTMPDIR      ,ntmpdir)
      CALL LEXCON(SAVE        ,8HSAVE        ,ICNT(59))
      CALL LEXCON(INCORE      ,8HINCORE      ,nincore)
      CALL LEXCON(STEP        ,8HSTEP        ,ICNT(60))
      CALL LEXCON(MAG         ,8HMAG         ,ICNT(61))
      CALL LEXCON(DIFHOR      ,8HDIFHOR      ,ICNT(62))
      CALL LEXCON(IIUIVI      ,8HIUIVI       ,ICNT(63))
      CALL LEXCON(TIDE        ,8HTIDE        ,ICNT(64))
      CALL LEXCON(COLFAC      ,8HCOLFAC     ,ICNT(65))
      CALL LEXCON(AURORA      ,8HAURORA      ,ICNT(66))
      CALL LEXCON(DISPOS      ,8HDISPOSE     ,ICNT(67))
      CALL LEXCON(TIDE2       ,8HTIDE2       ,ICNT(68))
      CALL LEXCON(TIDEANN     ,8HTIDEANN     ,ICNT(71))
      labsech(:,:) = 0
      call lexcon(secout   ,8HSECOUT  ,nsecout)
      call lexcon(sechist  ,8HSECHIST ,nsechist)
      call lexcon(secsave  ,8HSECSAVE ,nsecsave)
      call lexcon(secstart ,8HSECSTART,nsecstart)
      call lexcon(secstop  ,8HSECSTOP ,nsecstop)
      call lexcon(secflds  ,8HSECFLDS ,nsecflds)
      do i=1,60
        secout(i) = '        '
      enddo

  100 FORMAT(1H1)
C     ****
C     ****     READ LEXICAL INPUT
C     ****
      CALL READLX(LUNIT,KEND)
      IF(KEND.LT.0)STOP 'input'
C     ****
C     ****     CHECK LEXICAL DATA (FIRST ROUND)
C     ****
C     ****     SET ERROR FLAG TO ZERO
      IERROR=0

C     ****     LABEL
      IF(ICNT(51).GT.40)THEN
          WRITE(6,102)
  102     FORMAT(* INPUT -- LABEL: MORE THAN 320 CHARACTERS*)
          IERROR=1
      ENDIF
C     ****     DATE
      IF(ICNT(52).EQ.2) IADVDA = 0
      IF(ICNT(52).EQ.3) IADVDA = 1
      IF(ICNT(52).LT.2 .OR. ICNT(52).GT.3) THEN
          WRITE(6,103)
 103      FORMAT(* INPUT -- DATE: SHOULD BE 2 OR 3 ENTRIES*)
          IERROR=1
      ELSE IF (YRDUTD(1).LT.1900 .OR. YRDUTD(1).GT.2000 .OR. YRDUTD(2)
     1  .LT.1 .OR. YRDUTD(2).GT.366) THEN
          WRITE(6,104)
  104     FORMAT(* INPUT -- DATE: PARAMETER OUT OF RANGE*)
          IERROR=1
      ENDIF
C     ****     MAGVOL
      IF(ICNT(53).NE.3)THEN
          WRITE(6,105)
  105     FORMAT(* INPUT -- MAGVOL: SHOULD BE 3 ENTRIES*)
          IERROR=1
      ELSE IF(MSK(MAGVOL(3)))THEN
          WRITE(6,106)
  106     FORMAT(* INPUT -- MAGVOL: FILE MORE THAN 7 CHARACTERS*)
          IERROR=1
      ENDIF
C     ****     SOURCE
      IF(ICNT(54).NE.0.AND.ICNT(54).NE.6)THEN
          WRITE(6,107)
  107     FORMAT(* INPUT -- SOURCE: NO. OF ENTRIES MUST BE 0 OR 6*)
          IERROR=1
      ELSE IF(ICNT(54).EQ.6)THEN
          IF(MSK(SOURCE(3)))THEN
               WRITE(6,108)
  108          FORMAT(* INPUT -- SOURCE: FILE MORE THAN 7 CHARACTERS*)
               IERROR=1
          ENDIF
          IF(ICHK(SOURCE(4)))THEN
               WRITE(6,109)
  109          FORMAT(* INPUT -- SOURCE: TIME OUT OF RANGE*)
               IERROR=1
          ENDIF
      ENDIF
C     ****     OUTPUT
      IF(ICNT(55).LT.3.OR.ICNT(55).GT.60.OR.MOD(ICNT(55),3).NE.0)THEN
          WRITE(6,110)
  110     FORMAT(* INPUT -- OUTPUT: 1 TO 20 VOLUMES MUST BE DEFINED*)
          IERROR=1
      ELSE
          DO 7 I=1,ICNT(55)/3
          IF(MSK(OUTPUT(3,I)))THEN
               WRITE(6,111)I
  111          FORMAT(* INPUT -- OUTPUT: FILE *,I2,* HAS MORE THAN *
     1         *SEVEN CHARACTERS*)
               IERROR=1
          ENDIF
    7     CONTINUE
      ENDIF
C     ****     START
      IF(ICNT(56).NE.3)THEN
          WRITE(6,112)
  112     FORMAT(* INPUT -- START: SHOULD BE 3 ENTRIES*)
          IERROR=1
      ELSE IF(ICHK(START))THEN
          WRITE(6,113)
  113     FORMAT(* INPUT -- START: TIME OUT OF RANGE*)
          IERROR=1
      ENDIF
C     ****     STOP
      IF(ICNT(57).NE.3.AND.ICNT(57).NE.6) THEN
          WRITE(6,114)
  114     FORMAT(* OUTPUT -- STOP: SHOULD BE 3 OR 6 ENTRIES*)
          IERROR=1
      ELSE
          DO 8 N=1,ICNT(57)/3
          IF(ICHK(STOP(1,N)))THEN
               WRITE(6,115)N
  115          FORMAT(* INPUT -- STOP: TIME*,I1,* OUT OF RANGE*)
               IERROR=1
          ENDIF
    8     CONTINUE
      ENDIF
C     ****     HIST
      IF(ICNT(58).NE.3.AND.ICNT(58).NE.6)THEN
          WRITE(6,116)
  116     FORMAT(* INPUT -- HIST: NO OF ENTRIES MUST BE 3 OR 6*)
          IERROR=1
      ELSE
          DO 9 N=1,ICNT(58)/3
          IF(ICHK(HIST(1,N)))THEN
               WRITE(6,117)N
  117          FORMAT(* INPUT -- HIST: TIME*,I1,* OUT OF RANGE*)
               IERROR=1
          ENDIF
    9     CONTINUE
      ENDIF
C     ****     SAVE
      IF(ICNT(59).NE.3)THEN
          WRITE(6,118)
  118     FORMAT(* INPUT -- SAVE: SHOULD BE THREE ENTRIES*)
          IERROR=1
      ELSE IF(ICHK(SAVE))THEN
          WRITE(6,119)
  119     FORMAT(* INPUT -- SAVE: TIME OUT OF RANGE*)
          IERROR=1
      ENDIF
c
c Secondary histories input check:
      isecerr = 0
      lusech = -20      ! secondary history unit and flag
      lusech1 = 15	! unit for diagnostic secondary history fields
      if (nsecout+nsechist+nsecsave+nsecstart+nsecstop.gt.0) then
        lusech = -lusech        ! doing sec hist option if lusech > 0
c
c Output
        if (nsecout.lt.3.or.nsecout.gt.60.or.mod(nsecout,3).ne.0) then
          write(6,"('Secondary history input: 1 to 20 volumes must ',
     +      'defined')")
          isecerr = 1
        else
          do i=1,nsecout/3
            if (msk(secout(3,i))) then
              write(6,"('Secondary history input: file ',i2,
     +          ' has more than 7 characters')") i
              isecerr = 1
            endif
          enddo
        endif
c
c start:
        if (nsecstart.ne.3) then
          write(6,"('Secondary history input: secstart should have ',
     +      '3 integer values')")
          isecerr = 1
        elseif (ichk(secstart)) then
          write(6,"('Secondary history input: secstart out of range')")
          isecerr = 1
        endif
c
c stop
        if (nsecstop.ne.3) then
          write(6,"('Secondary history input: secstop',
     +      ' should have 3 integer values')")
          isecerr = 1
        else
          if (ichk(secstop)) then
            write(6,"('Secondary history input: secstop time ',
     +        'out of range')")
            isecerr = 1
          endif
        endif
c
c hist
        if (nsechist.ne.3) then
          write(6,"('Secondary history input: sechist',
     +      ' should have 3 integer values')")
          isecerr = 1
        else
          if (ichk(sechist)) then
              write(6,"('Secondary history input: sechist time ',
     +          'out of range')")
            isecerr = 1
          endif
        endif
c
c save:
        if (nsecsave.ne.3) then
          write(6,"('Secondary history input: secsave should have ',
     +      '3 integer values')")
          isecerr = 1
        elseif (ichk(secsave)) then
          write(6,"('Secondary history input: secsave out of range')")
          isecerr = 1
        endif
c
c Fields:
        if (nsecflds.gt.mxfsech) then
          write(6,"('Secondary history input: too many secondary',
     +      ' history field names: mxfsech=',i3,' nsecflds=',i3)") 
     +      mxfsech,nsecflds
          isecerr = 1
        elseif (nsecflds.le.0) then
          write(6,"('Secondary history input: need secondary ',
     +      'history field names (SECFLDS).')")
          isecerr = 1
        else
c
c Force t,o2,o1,z to always be on secondary histories. This is for 
c   post-model processing (these fields are required for conversion 
c   to number densities, height interpolation, calculation of heights 
c   with total mass, etc.)
c
          ixt  = ixfindc(secflds,mxfsech,'TN      ')
          ixo2 = ixfindc(secflds,mxfsech,'O2      ')
          ixo1 = ixfindc(secflds,mxfsech,'O1      ')
          ixz  = ixfindc(secflds,mxfsech,'Z       ')
          if (ixt.eq.0.or.ixo2.eq.0.or.ixo1.eq.0.or.ixz.eq.0) then
            if (ixt.eq.0)  ixt  = ixpushc(secflds,mxfsech,'TN      ')
            if (ixo2.eq.0) ixo2 = ixpushc(secflds,mxfsech,'O2      ')
            if (ixo1.eq.0) ixo1 = ixpushc(secflds,mxfsech,'O1      ')
            if (ixz.eq.0)  ixz  = ixpushc(secflds,mxfsech,'Z       ')
            if (ixt.eq.0.or.ixo2.eq.0.or.ixo1.eq.0.or.ixz.eq.0) then
              write(6,"(/'INPUT: error adding t, o2, o1, and z',
     +          ' to secondary history fields -- please reduce',
     +          ' number of SECFLDS, or increase mxfsech')") 
              stop 'SECFLDS'
            endif
            notesec(1) = 1
          endif
c
c If one of the "family" species is requested (ox,noz,hox), then
c also include its component members. These will be required by
c post-model processing if number densities are requested:
c
c ox = o1 + o3
          ixox = ixfindc(secflds,mxfsech,'OX      ')
          ixo1 = ixfindc(secflds,mxfsech,'O1      ')
          ixo3 = ixfindc(secflds,mxfsech,'O3      ')
          if (ixox.gt.0.and.(ixo1.le.0.or.ixo3.le.0)) then
            if (ixo1.eq.0) ixo1 = ixpushc(secflds,mxfsech,'O1      ')
            if (ixo3.eq.0) ixo3 = ixpushc(secflds,mxfsech,'O3      ')
            if (ixo1.eq.0.or.ixo3.eq.0) then
              write(6,"(/'INPUT: error adding o1 and o3',
     +          ' to secondary history fields -- please reduce',
     +          ' number of SECFLDS, or increase mxfsech')") 
              write(6,"('(attempted to add o1,o3 because ox was ',
     +          'requested)')")
              stop 'SECFLDS'
            endif 
            notesec(2) = 1
          endif
c
c noz = no + no2
          ixnoz = ixfindc(secflds,mxfsech,'NOZ     ')
          ixno =  ixfindc(secflds,mxfsech,'NO      ')
          ixno2 = ixfindc(secflds,mxfsech,'NO2     ')
          if (ixnoz.gt.0.and.(ixno.eq.0.or.ixno2.eq.0)) then
            if (ixno.eq.0)  ixno  = ixpushc(secflds,mxfsech,'NO      ')
            if (ixno2.eq.0) ixno2 = ixpushc(secflds,mxfsech,'NO2     ')
            if (ixno.eq.0.or.ixno2.eq.0) then
              write(6,"(/'INPUT: error adding no and no2',
     +          ' to secondary history fields -- please reduce',
     +          ' number of SECFLDS, or increase mxfsech')") 
              write(6,"('(attempted to add no,no2 because noz was ',
     +          'requested)')")
              stop 'SECFLDS'
            endif 
            notesec(3) = 1
          endif
c
c hox = oh + ho2 + h
          ixhox = ixfindc(secflds,mxfsech,'HOX     ')
          ixoh  = ixfindc(secflds,mxfsech,'OH      ')
          ixho2 = ixfindc(secflds,mxfsech,'HO2     ')
          ixh   = ixfindc(secflds,mxfsech,'H       ')
          if (ixhox.gt.0.and.(ixoh.eq.0.or.ixho2.eq.0.or.ixh.eq.0)) then
            if (ixoh.eq.0)  ixoh  = ixpushc(secflds,mxfsech,'OH      ')
            if (ixho2.eq.0) ixho2 = ixpushc(secflds,mxfsech,'HO2     ')
            if (ixh.eq.0)   ixh   = ixpushc(secflds,mxfsech,'H       ')
            if (ixoh.eq.0.or.ixho2.eq.0.or.ixh.eq.0) then
              write(6,"(/'INPUT: error adding oh, ho2 and h',
     +          ' to secondary history fields -- please reduce',
     +          ' number of SECFLDS, or increase mxfsech')") 
              write(6,"('(attempted to add oh,ho2,h because hox was ',
     +          'requested)')")
              stop 'SECFLDS'
            endif 
            notesec(4) = 1
          endif
c
c nfsech = number of fields requested to be on secondary histories:
c If requested field secflds(i) is in fproc_names, then include it
c   in secflds_hist(i). If not, then it is a non-primary (diagnostic)
c   sec hist field, and will be added to secflds_hist when addfsech
c   is called for that field.
c
          nfsech = 0
          do i=1,mxfsech
            if (len_trim(secflds(i)).gt.0) then
              nfsech = nfsech+1
              ip = ixfindr(fproc_names,nfproc,secflds(i))
              if (ip.gt.0) secflds_hist(i) = secflds(i)
            endif
          enddo
          if (nfsech.eq.0) then
            write(6,"('Secondary history input: no fields requested',
     +        ' to write to secondary histories (SECFLDS)')")
            isecerr = 1
          endif
        endif
        if (isecerr.gt.0) stop 'sechinpt'
      endif ! secondary hist option
C     ****     STEP
      IF(ICNT(60).NE.1)THEN
          WRITE(6,120)
  120     FORMAT(* INPUT -- STEP: SHOULD BE ONE ENTRY*)
          IERROR=1
      ELSE IF(STEP.LE.0)THEN
          WRITE(6,121)
  121     FORMAT(* INPUT -- STEP: STEP .LE. 0*)
          IERROR=1
      ENDIF
C     ****     MAG
      IF(ICNT(61).NE.4)THEN
          WRITE(6,122)
  122     FORMAT(* INPUT -- MAG: SHOULD BE 4 ENTRIES*)
          IERROR=0
      ELSE
          DO 10 N=1,2
          IF(MAG(1,N).LE.-90.0.OR.MAG(1,N).GT.90.0.OR.MAG(2,N).LT.-180.0
     1    .OR.MAG(2,N).GT.180.0)THEN
               WRITE(6,123)N
  123          FORMAT(* INPUT -- MAG: COORDINATES OF POLE*,I1,* OUT OF *
     1         *RANGE*)
               IERROR=1
          ENDIF
   10     CONTINUE
      ENDIF
C     ****     DIFHOR
      IF(ICNT(62).NE.1)THEN
          WRITE(6,124)
  124     FORMAT(* INPUT -- DIFHOR: SHOULD BE ONE ENTRY*)
          IERROR=1
      ELSE IF(DIFHOR.NE.0.AND.DIFHOR.NE.1)THEN
          WRITE(6,125)
  125     FORMAT(* INPUT -- DIFHOR: MUST BE 0 OR 1*)
          IERROR=1
      ENDIF
C     ****     IUIVI
      IF(ICNT(63).NE.1)THEN
          WRITE(6,126)
  126     FORMAT(* INPUT -- IUIVI: SHOULD BE 1 ENTRY*)
          IERROR=1
      ELSE IF(IIUIVI.NE.0.AND.IIUIVI.NE.1)THEN
          WRITE(6,127)
  127     FORMAT(* INPUT -- IIUIVI: MUST BE 0 OR 1*)
          IERROR=1
      ENDIF
C     ****     TIDE
      IF(ICNT(64).NE.10)THEN
          WRITE(6,128)
  128     FORMAT(* INPUT -- TIDE: MUST BE 10 ENTRIES*)
          IERROR=1
      ELSE
          DO 11 N=1,5
          IF(TIDE(N).LT.0)THEN
               WRITE(6,129)
  129          FORMAT(* INPUT -- TIDE: AMPLITUDE FOR COMPONENT *,I1,
     1         * IS NEGATIVE*)
               IERROR=1
          ENDIF
   11     CONTINUE
      ENDIF
C     ****     TIDE2
      IF(ICNT(68).NE.2)THEN
        WRITE(6,161)
  161   FORMAT(* INPUT -- TIDE2:  MUST HAVE 2 ENTRIES*)
        IERROR = 1
      ELSE
        DO 25 N = 1,1
          IF(TIDE2(N).LT.0.)THEN
            WRITE(6,162)
  162       FORMAT(* INPUT -- TIDE2:  AMPLITUDE FOR (1,1) IS -IVE*)
            IERROR = 1
          ENDIF
   25   CONTINUE
      ENDIF
C     ****     TIDEANN
      IF(ICNT(71).EQ.0)THEN
        TIDEANN = 1
      ELSE IF(ICNT(71).EQ.1)THEN
        IF(TIDEANN.NE.0.AND.TIDEANN.NE.1)THEN
          WRITE(6,300)
  300     FORMAT(* INPUT -- TIDEANN: IF PRESENT, MUST BE 0 OR 1 *)
          IERROR = 1
        ENDIF
      ELSE
        WRITE(6,301)
  301   FORMAT(* INPUT -- TIDEANN: MUST HAVE ZERO OR ONE ENTRIES *)
        IERROR = 1
      ENDIF
      ITIDEA = TIDEANN
C     ****     COLFAC
      IF(ICNT(65).NE.1)THEN
           WRITE(6,146)
  146      FORMAT(* INPUT -- COLFAC: MUST HAVE ONE ENTRY*)
           IERROR=1

      ENDIF
C     ****     AURORA
      IF(ICNT(66).NE.1)THEN
           WRITE(6,149)
  149      FORMAT(* INPUT -- AURORA: MUST HAVE ONE ENTRY*)
      ELSE IF(AURORA.NE.0.AND.AURORA.NE.1)THEN
           WRITE(6,150)
  150      FORMAT(* INPUT -- AURORA: MUST BE 0 OR 1*)
      ELSE
           IAUR=AURORA
      ENDIF
C     ****     DISPOSE
      IF(ICNT(67).NE.1)THEN
           WRITE(6,151)
  151      FORMAT(* INPUT -- DISPOSE: MUST HAVE ONE ENTRY*)
      ELSE IF(DISPOS.NE.0.AND.DISPOS.NE.1)THEN
           WRITE(6,152)
  152      FORMAT(* INPUT -- DISPOSE: MUST BE 0 OR 1*)
      ELSE
           IDISP=DISPOS
      ENDIF
C     ****     CHECK FOR SAME ENTRY COUNT FOR STOP AND HIST
      IF(ICNT(57).NE.ICNT(58))THEN

          WRITE(6,130)
  130     FORMAT(* INPUT -- STOP AND HIST MUST HAVE SAME NO. OF *
     1    *ENTRIES*)
          IERROR=1
      ENDIF
C     ****
C     ****     TERMINATE IF ERROR FLAG SET
C     ****
      IF(IERROR.EQ.1)STOP 'input'
C     ****
C     ****     CHECK THAT TIMES ARE MULTIPLES OF STEP
C     ****
C     ****     SOURCE
      IF(ISTPCK(SOURCE(4),STEP))THEN
          WRITE(6,131)
  131     FORMAT(* INPUT -- SOURCE: TIME NOT A MULTIPLE OF STEP*)
          IERROR=1
      ENDIF
C     ****     START
      IF(ISTPCK(START,STEP))THEN
          WRITE(6,132)
  132     FORMAT(* INPUT -- START: TIME NOT A MULTIPLE OF STEP*)
          IERROR=1
      ENDIF
C     ****     STOP
      DO 12 N=1,ICNT(33)/3
      IF(ISTPCK(STOP(1,N),STEP))THEN
          WRITE(6,133)N
  133     FORMAT(* INPUT -- STOP: TIME*,I1,* NOT A MULTIPLE OF STEP*)
          IERROR=1
      ENDIF
   12 CONTINUE
C     ****     HIST
      DO 13 N=1,ICNT(58)/3
      IF(ISTPCK(HIST(1,N),STEP))THEN
          WRITE(6,134)N
  134     FORMAT(* INPUT -- HIST: TIME*,I1,* NOT A MULTIPLE OF STEP*)
          IERROR=1
      ENDIF
   13 CONTINUE
C     ****     SAVE
      IF(ISTPCK(SAVE,STEP))THEN
          WRITE(6,135)
  135     FORMAT(* INPUT -- SAVE: TIME NOT A MULTIPLE OF STEP*)
          IERROR=1
      ENDIF
c
c Secondary history times must be multiple of step:
      if (lusech.gt.0) then
        if (istpck(secstart,step)) then
          write(6,"('Secondary history input: SECSTART not a multiple',
     +      ' of step')")
          isecerr = 1
        endif
        if (istpck(secstop,step)) then
          write(6,"('Secondary history input: SECSTOP not a multiple',
     +      ' of step')")
          isecerr = 1
        endif
        if (istpck(sechist,step)) then
          write(6,"('Secondary history input: SECHIST not a multiple',
     +      ' of step')")
          isecerr = 1
        endif
        if (istpck(secsave,step)) then
          write(6,"('Secondary history input: SECSAVE not a multiple',
     +      ' of step')")
          isecerr = 1
        endif
        if (isecerr.gt.0) stop 'sechinpt'
      endif
C     ****
C     ****     CHECK SOURCE AND START TIMES DIFFER BY WHOLE NUMBER OF
C     ****     DAYS (OR BY 12 HRS IN TRANSITION TIME DUE TO CHANGING
C     ****     THE MODEL TIME TO UT TIME)
C     ****
      IF(ICNT(54).EQ.6.AND.(SOURCE(5).NE.START(2).OR.SOURCE(6).NE.
     1START(3)))THEN
        IF(IABS(SOURCE(5)-START(2)).EQ.12.AND.SOURCE(6).EQ.START(3))THEN
          WRITE(6,"(1X,'INPUT -- SOURCE AND START TIMES DIFFER BY 12 ',
     1      'HRS, INDICATING THAT SOURCE USES THE OLD DEFINITION OF ',
     2      'MODEL TIME')")
        ELSE
          WRITE(6,136)
  136     FORMAT(* INPUT -- SOURCE AND START TIMES MUST DIFFER BY *
     1    *WHOLE NUMBER OF DAYS*)
          IERROR=1
        ENDIF
      ENDIF
C     ****
C     ****     TERMINATE IF ERROR FLAG SET
C     ****
      IF(IERROR.EQ.1)STOP 'input'
C     ****
C     ****     SET AS MANY PARAMETERS AS POSSIBLE
C     ****
C     ****     LABEL
      DO 14 I=1,40
      NCASE(I)=LABEL(I)
   14 CONTINUE
C     ****
C     ****     DATE (MODEL DAY = UT DAY, 11/89)
C     ****
      YRDA(1) = YRDUTD(1)
      YRDA(2) = YRDUTD(2)
      IF (IADVDA .EQ. 1) THEN
C       ****
C       ****     LPYR = 1(0)  IF IS (NOT) A LEAP YEAR
C       ****
        IYR4 = YRDUTD(1)/4.
        IYR100 = YRDUTD(1)/100.
        LPYR = 0
        IF (IYR4*4 .EQ. YRDUTD(1) .AND. IYR100*100 .NE. YRDUTD(1))
     1    LPYR=1
        IENDA = 365 + LPYR
        IADDAY = START(1)-YRDUTD(3)
        YRDA(2) = YRDUTD(2) + IADDAY
        IF (YRDA(2) .GT. IENDA) THEN
          YRDA(1) = YRDA(1) + 1
          YRDA(2) = YRDA(2) - IENDA
        ENDIF                          !   FOR PAST YEAR'S END
        IF (YRDA(2) .LE. 0) THEN
          YRDA(1) = YRDA(1) - 1
          YRDA(2) = YRDA(2) + IENDA
        ENDIF                          !   FOR BEFORE YEAR'S START
C       ****  SFEPS IS 6% VARIATION IN SOLAR OUTPUT OVER A YEAR
C       ****  CAUSED BY THE ORBITAL ECCENTRICITY
        PI = 3.14159265358979
        THET0 = 2.*PI*FLOAT(yrda(2))/365.
        SFEPS = 1.000110+0.034221*COS(THET0)+0.001280*SIN(THET0)
     1        +0.000719*COS(2.*THET0)+0.000077*SIN(2.*THET0)
        WRITE(6,"(1X,'INPUT:  ADVANCING DAY (PREVIOUS,PRESENT)=',4I5)")
     1    YRDUTD(1),YRDUTD(2),YRDA(1),YRDA(2)
      ENDIF                           !   FOR ADVANCING DAY
      IYEAR=YRDA(1)
      IIDAY=YRDA(2)
C     ****     MAGVOL
      CALL TRNSFR(MAGVOL,LABMAG,3,1)
C     ****     SOURCE
      MODEST=-1+ICNT(54)/3
      IF(MODEST.EQ.1)CALL TRNSFR(SOURCE,LABSRC,3,1)
C     ****     OUTPUT
      CALL TRNSFR(OUTPUT,LABHIS,60,1)
      MFIL=13
      MTAP=ICNT(55)/3
C     ****     START
      ITER=ITERA(START,STEP)
C     ****     STOP, HIST
      IEND=ICNT(57)/3
      DO 16 I=1,IEND
      NNSTP(I)=ITERA(STOP(1,I),STEP)
      MMHIS(I)=ITERA(HIST(1,I),STEP)
   16 CONTINUE
      IF(ICNT(57).EQ.3)NNSTP(2)=NNSTP(1)+1
      NSTP=NNSTP(1)
      MHIS=MMHIS(1)
C     ****     SAVE
      MSAV=ITERA(SAVE,STEP)
c
c Initialize secondary history capacity flags:
c
      if (lusech.gt.0) then
        call trnsfr(secout,labsech,60,1)
c
c lensech (local) = size of a secondary history (bytes)
c mxmssbytes = maximum size of an mss file (bytes)
c mfilsech (common) = number of secondary histories to fill an mss vol
c   mfilsech will vary with the number of fields written (nfsech).
c
        lensech = (((zimx+2)*(zkmx+1)*zjmx)*nfsech+512+lsumm)*8
c       write(6,"('lensech=',i8)") lensech
        mfilsech = mxmssbytes/lensech-1	! -1 for safety
        if (mfilsech.lt.1) then
          write(6,"(/'>>> INPUT: cannot fit single history on ',
     +      'a mass store file.')")
          write(6,"('  mxmssbytes=',i10,' lensech=',i10,
     +      ' nfsech=',i2,' lsumm=',i3,' mfilsech=',i4)") 
     +      mxmssbytes,lensech,nfsech,lsumm,mfilsech
          stop 'mfilsech'
        endif
        mtapsech = nsecout/3    ! number of sec output names given
        mhissech = itera(sechist,step)  ! disk write freq (# steps)
        msavsech = itera(secsave,step)  ! mss write freq (# steps)
        isecstart = itera(secstart,step)! iter to start sec hist
        isecstop = itera(secstop,step)  ! iter to stop sec hist
      endif
C     ****     STEP
      C(4)=STEP
C     ****     MAG
      DO 17 I=1,2
      DIPOLE(I)=90.0+(3-2*I)*MAG(1,I)
      PMLONG(I)=MAG(2,I)+(I-2)*180.0
   17 CONTINUE
C     ****     DIFHOR
      ICOMP=DIFHOR
C     ****     IUIVI
      IUIVI=IIUIVI
C     ****     TIDE
      ITIDE=0
      DO 18 I=1,5
      IF(TIDE(I).GT.0)ITIDE=1
   18 CONTINUE
C     ****     TIDE2
      ITIDE2 = 0
      DO 153 N=1,1
        IF(TIDE2(N).GT.0.)ITIDE2 = 1
  153 CONTINUE

C     ****
C     ****     FINAL PARAMETER CHECK
C     ****
C     ****     ITER.LT.NNSTP(1).LT.NNSTP(2)
      IF(ITER.GE.NNSTP(1).OR.NNSTP(1).GE.NNSTP(2))THEN
          WRITE(6,137)
  137     FORMAT(* INPUT -- MUST HAVE START TIME .LT. STOP TIME1 .LT. *
     1    *STOP TIME2*)
      ENDIF
C     ****     MSAV MUST BE MULTIPLE OF MMHIS(I),I=1,IEND
C     ****     (NNSTP(IEND)-ITER) MUST BE MULTIPLE OF MSAV
      DO 21 I=1,IEND
      IF(MOD(MSAV,MMHIS(I)).NE.0)THEN
          WRITE(6,138)I
  138     FORMAT(* INPUT -- MSAV NOT A MULTIPLE MMHIS(*,I1,*)*)
          IERROR=1
      ENDIF
   21 CONTINUE
      IF(MOD(NNSTP(IEND)-ITER,MSAV).NE.0)THEN
          WRITE(6,139)IEND
  139     FORMAT(* INPUT -- (NNSTP(*,I1,*)-ITER) IS NOT A MULTIPLE OF *
     1    *MSAV*)
          IERROR=1
      ENDIF
      if (lusech.gt.0) then
c
c Sec hist start time must be <= stop time:
c
        if (isecstart.gt.isecstop) then
          write(6,"('>>> Secondary history start time must be <= ',
     +      'sec hist stop time: isecstart=',i6,' (',i2,':',i2,':',
     +      i2,') isecstop=',i6,' (',i2,':',i2,':',i2,')')")
     +      isecstart,secstart,isecstop,secstop
        endif
c
c Time period to write sec hist must be within time period of run:
c
        if (isecstop.le.iter.or.isecstop.gt.nnstp(1).or.
     +      isecstop.gt.nnstp(2)) then
          write(6,"('>>> Secondary history stop time must be > start ',
     +      'of run and <= stop time(s): isecstop=',i6,' 1st iter=',i6,
     +      ' nnstp(1-2)=',2i6)") isecstop,iter,nnstp
          isecerr = 1
        endif
        if (isecstart.lt.iter.or.isecstart.ge.nnstp(1).or.
     +      isecstop.ge.nnstp(2)) then
          write(6,"('>>> Secondary history start time must be >= ',
     +      'start of run and < stop time(s): isecstart=',i6,' 1st ',
     +      'iter=',i6,' nnstp(1-2)=',2i6)") isecstart,iter,nnstp
          isecerr = 1
        endif
c
c Frequency of mss saves must be multiple of disk saves:
c
        if (mod(msavsech,mhissech).ne.0) then
          write(6,"('>>> SECSAVE not a multiple of SECHIST:')")
          write(6,"(4x,' SECSAVE=',i3,':',i2,':',i2,
     +      ' SECHIST=',i3,':',i2,':',i2)") secsave,sechist
          write(6,"('  msav=',i3,' mhis=',i3)") msavsech,mhissech
          isecerr = 1
        endif
c
c Elapsed time of secondary histories must be multiple of secondary
c mss file saves:
c
        if (mod(isecstop-isecstart,msavsech).ne.0) then
          write(6,"('>>> Elapsed time of secondary histories',
     +      '(SECSTOP-SECSTART) must be multiple of ',/4x,
     +      'secondary history mss save frequency (SECSAVE):')")
          write(6,"(4x,'SECSTART=',i3,':',i2,':',i2,
     +      ' SECSTOP=',i3,':',i2,':',i2,' SECSAVE=',i3,':',i2,':',
     +      i2)") secstart,secstop,secsave
          isecerr = 1
        endif
c
c Check that sufficient sec hist output vol names were given:
c
        nsech = (isecstop-isecstart)/mhissech+1 ! # sec hist this run
        nvolsech = (nsech+mfilsech-1)/mfilsech          ! # sec vols this run
        if (nvolsech.gt.mtapsech) then
          write(6,"('>>> Not enough secondary history output volumes',
     +      ' given (SECOUT): read ',i2,' mss paths, but need ',i2)")
     +      mtap,nvolsech
          write(6,"('  Number of secondary histories to be written ',
     +      'this run = ',i3)") nsech
          write(6,"('  Number of secondary histories that will fill ',
     +      'a volume = ',i3)") mfilsech
          isecerr = 1
        endif
        if (isecerr.gt.0) stop 'sechinpt'
      endif

C     ****     CHECK THAT SUFFICIENT VOLUMES FOR OUTPUT WHERE SOURCE
C     ****     USED
      IF(ICNT(54).EQ.6)THEN
          NVOL=1+(NNSTP(1)-ITER)/MMHIS(1)
          IF(IEND.EQ.2)NVOL=NVOL+(NNSTP(2)-NNSTP(1))/MMHIS(2)
          NVOL=(NVOL+MFIL-1)/MFIL
          IF(NVOL.GT.MTAP)THEN
               WRITE(6,141)NVOL
  141          FORMAT(* INPUT -- *,I2,* OUTPUT VOLUMES NEEDED*)
               IERROR=1
          ENDIF
      ENDIF
C     ****
C     ****     TERMINATE IF ERROR FLAG SET
C     ****
      IF(IERROR.EQ.1)STOP 'input'
C     ****
C     ****     RESET LEXICAL DICTIONARY TO AVOID OVERFLOW AT 64 ENTRIES
C     ****
      NID = 1
      DO 170 I=1,75
 170  ICNT(I) = 0
C     ****
C     ****     SET UP DICTIONARY FOR AURORAL INPUTS
C     ****
      CALL LEXCON(f107d_in    ,8HF107       ,ICNT(68))
      CALL LEXCON(f107a_in    ,8HF107A      ,ICNT(69))
      CALL LEXCON(AMIVOL      ,8HAMIVOL     ,ICNT(70))
C     ****
      CALL LEXCON(power_in    ,8HPOWER      ,ICNT(1))
      CALL LEXCON(ctpot_in    ,8HCTPOTEN    ,ICNT(2))
      CALL LEXCON(byimf_in    ,8HBYIMF      ,ICNT(3))
C     ****
      CALL LEXCON(R1          ,8HR1         ,ICNT(4))
      CALL LEXCON(PHIDM       ,8HPHIDM      ,ICNT(5))
      CALL LEXCON(PHIDP       ,8HPHIDP      ,ICNT(6))
      CALL LEXCON(PHINM       ,8HPHINM      ,ICNT(7))
      CALL LEXCON(PHINP       ,8HPHINP      ,ICNT(8))
      CALL LEXCON(ARADPN      ,8HARADNH     ,ICNT(9))
      CALL LEXCON(ARADNS      ,8HARADSH     ,ICNT(10))
      CALL LEXCON(OFFAPN      ,8HOFFANH     ,ICNT(11))
      CALL LEXCON(OFFANS      ,8HOFFASH     ,ICNT(12))
      CALL LEXCON(DKOFAPN     ,8HDKOFANH    ,ICNT(13))
      CALL LEXCON(DKOFANS     ,8HDKOFASH    ,ICNT(14))
      CALL LEXCON(PHIDPN      ,8HPHIDNH     ,ICNT(15))
      CALL LEXCON(PHIDNS      ,8HPHIDSH     ,ICNT(16))
      CALL LEXCON(PHINPN      ,8HPHINNH     ,ICNT(17))
      CALL LEXCON(PHINNS      ,8HPHINSH     ,ICNT(18))
      CALL LEXCON(PCEPPN      ,8HPCEPNH     ,ICNT(19))
      CALL LEXCON(PCEPNS      ,8HPCEPSH     ,ICNT(20))
      CALL LEXCON(PCENPN      ,8HPCENNH     ,ICNT(21))
      CALL LEXCON(PCENNS      ,8HPCENSH     ,ICNT(22))
      CALL LEXCON(DISPCPN     ,8HDISPCNH    ,ICNT(23))
      CALL LEXCON(DISPCNS     ,8HDISPCSH    ,ICNT(24))
      CALL LEXCON(DISPPN      ,8HDISPNH     ,ICNT(25))
      CALL LEXCON(DISPNS      ,8HDISPSH     ,ICNT(26))
      CALL LEXCON(OFFCPN      ,8HOFFCNH     ,ICNT(27))
      CALL LEXCON(OFFCNS      ,8HOFFCSH     ,ICNT(28))
C     ****
      CALL LEXCON(E1          ,8HE1         ,ICNT(29))
      CALL LEXCON(E2          ,8HE2         ,ICNT(30))
      CALL LEXCON(H1          ,8HH1         ,ICNT(31))
      CALL LEXCON(H2          ,8HH2         ,ICNT(32))
      CALL LEXCON(ROTE        ,8HROTE       ,ICNT(33))
      CALL LEXCON(ROTH        ,8HROTH       ,ICNT(34))
      CALL LEXCON(TWA6        ,8HTWA6       ,ICNT(35))
      CALL LEXCON(TWA21       ,8HTWA21      ,ICNT(36))
      CALL LEXCON(ALFA1       ,8HALFA1      ,ICNT(37))
      CALL LEXCON(ALFA2       ,8HALFA2      ,ICNT(38))
C     ****
      CALL LEXCON(DISPCPN     ,8HDKOFCNH    ,ICNT(39))
      CALL LEXCON(DISPCNS     ,8HDKOFCSH    ,ICNT(40))
      CALL LEXCON(DISPPN      ,8HTHETA0NH   ,ICNT(41))
      CALL LEXCON(DISPNS      ,8HTHETA0SH   ,ICNT(42))
C     ****
      CALL LEXCON(ARADPN      ,8HARAD       ,ICNT(9))
      CALL LEXCON(OFFAPN      ,8HOFFA       ,ICNT(11))
      CALL LEXCON(DKOFAPN     ,8HDKOFA      ,ICNT(13))
      CALL LEXCON(PHIDPN      ,8HPHID       ,ICNT(15))
      CALL LEXCON(PHINPN      ,8HPHIN       ,ICNT(17))
      CALL LEXCON(PCEPPN      ,8HPCEP       ,ICNT(19))
      CALL LEXCON(PCENPN      ,8HPCEN       ,ICNT(21))
      CALL LEXCON(DISPCPN     ,8HDISPC      ,ICNT(23))
      CALL LEXCON(DISPPN      ,8HDISP       ,ICNT(25))
      CALL LEXCON(OFFCPN      ,8HOFFC       ,ICNT(27))
      CALL LEXCON(DISPCPN     ,8HDKOFC      ,ICNT(39))
      CALL LEXCON(DISPPN      ,8HTHETA0     ,ICNT(41))
C     ****
      CALL LEXCON(JSWOLDA     ,8HOLDALF      ,ICNT(44))
c
c Low energy proton: 
      CALL LEXCON(ALFALP      ,8HALFALP      ,ICNT(45))
      CALL LEXCON(EFLUXLP     ,8HEFLUXLP     ,ICNT(46))
C     ****
      CALL READLX(LUNIT,KEND)
      IF (KEND .LT. 0) STOP 'input'
      IERROR = 0
c
c INCORE=1 or 0: in-core or out-of-core:
c If incore=1, then assign statements to units 8,9,15 in fogcm specify
c   memory resident i/o class (assign -F mr.scr::xxxxx u:x) 
c If incore=0, then assign statements to units 8,9,15 in fogcm specify
c   sds (ssd) i/o class (assign -F sds.scr::xxxxx u:x)
c (where xxxxx is max number of 512 word blocks required for the file)
c
! tgcm13mt: there are no scratch units in multi-tasked model.
!           INCORE is ignored: 
!
      if (nincore.le.0) incore = 1	! default
!
!     if (incore.gt.0) then
!       write(6,"('INCORE=',i2,': Scratch units will be memory ',
!    +    'resident (SSD will *not* be used)')") incore
!     else
!       write(6,"('INCORE:',i2,': Scratch units will be on secondary ',
!    +    'data storage (SSD will be used)')") incore
!     endif
!
      if (nincore.gt.0) then
        write(6,"('Note: input parameter INCORE is ignored.')")
        write(6,"('      (multi-tasked models do not use SSD)')")
        incore = 1
      endif
c
c Temporary directory is tmpdir, where local disk files are linked.
c   (tmpdir has 80 chars, and is in strt.h. It will be created if
c    necessary in getms or putms)
c If user does not provide tmpdir, use /tmp/username, where username
c   is obtained from the unicos LOGNAME environment variable. If 
c   this fails, use /tmp/TGCM.
c
      if (ntmpdir <= 0) then	! not given by user
        call getenv('LOGNAME',username) 
        if (username == '        ') then
          write(6,"('>>> input: cannot get user name for tmpdir.')")
          tmpdir = '/tmp/TGCM'
        else
          tmpdir = '/tmp/'//trim(username)
        endif
      endif
      if (len_trim(tmpdir)<=0) then
        write(6,"('>>> input: need temporary directory tmpdir')")
        stop 'tmpdir'
      endif
      write(6,"('TMPDIR: temporary directory = ',a)") trim(tmpdir)
c
c There are 3 options for input parameters f107,f107a,power, and ctpoten:
c   If no values are read -> get time-varying inputs from database (getgpi)
c   If single value is read -> use single constant value throughout run
c   If multiple values are read -> use time-varying values as provided
c (at least one byimf value must be provided)
c
c
c Hemispheric Power:
      if (icnt(1).eq.0) then            ! will get time-varying from database
        icnt(1) = 1                     ! (fake-out for aurps, etc.)
        write(6,"('POWER: will get from GPI database at each ',
     +    'iteration')")
      elseif (icnt(1).eq.1) then        ! constant provided by user
        dum(1,1,1) = power_in(1,1)
        hpower = power_in(1,1)
        write(6,"('POWER: constant provided by user (',e12.4,')')")
     +    hpower
      else                              ! time-varying provided by user
        dum(:,:,1) = power_in(:,:)
        hpower = 0.
        write(6,"('POWER: time-varying values provided by user')")
      endif
c
c Cross-tail potential:
      if (icnt(2).eq.0) then
        icnt(2) = 1
        write(6,"('CTPOTEN: will get from GPI database at each ',
     +    'iteration')")
      elseif (icnt(2).eq.1) then
        dum(1,1,2) = ctpot_in(1,1)
        ctpoten = ctpot_in(1,1)
        write(6,"('CTPOTEN: constant provided by user (',e12.4,')')")
     +    ctpoten
      else
        dum(:,:,2) = ctpot_in(:,:)
        ctpoten = 0.
        write(6,"('CTPOTEN: time-varying values provided by user')")
      endif
c
c Daily f107:
      if (icnt(68).eq.0) then
        icnt(68) = 1
        write(6,"('F107: will get from GPI database at each ',
     +    'iteration')")
      elseif (icnt(68).eq.1) then
        dum(1,1,54) = f107d_in(1,1)
        f107 = f107d_in(1,1)
        write(6,"('F107: constant provided by user (',e12.4,')')")
     +    f107
      else
        dum(:,:,54) = f107d_in(:,:)
        f107 = 0.
        write(6,"('F107: time-varying values provided by user')")
      endif
c
c 81-day average f107:
      if (icnt(69).eq.0) then
        icnt(69) = 1
        write(6,"('F107A: will get from GPI database at each ',
     +    'iteration')")
      elseif (icnt(69).eq.1) then
        dum(1,1,55) = f107a_in(1,1)
        f107a = f107a_in(1,1)
        write(6,"('F107A: constant provided by user (',e12.4,')')")
     +    f107a
      else
        dum(:,:,55) = f107a_in(:,:)
        f107a = 0.
        write(6,"('F107A: time-varying values provided by user')")
      endif
c
c Byimf (user must provide):
      if (icnt(3).eq.0) then            ! error
        write(6,"(' ')")
        write(6,"('>>> INPUT: must provide at least one value ',
     +    'for BYIMF')")
        write(6,"(' ')")
        stop 'BYIMF'
      elseif (icnt(3).eq.1) then
        dum(1,1,3) = byimf_in(1,1)
        byimf = byimf_in(1,1)
        write(6,"('BYIMF: constant provided by user (',e12.4,')')")
     +    byimf
      else
        dum(:,:,3) = byimf_in(:,:)
        byimf = 0.
        write(6,"('BYIMF: time-varying values provided by user')")
      endif
      write(6,"(72('-')/)")
c
c Report secondary history status to user:
c
      if (lusech.gt.0) then
        write(6,"(/75('-')/'INPUT: Secondary Histories:')")
        write(6,"('SECOUT = ',/('  /',a8,'/',a8,'/',a8))")
     +    ((secout(ii,i),ii=1,3),i=1,nsecout/3)
        write(6,"('SECHIST  = ',i3,':',i2,':',i2,'  (save secondary',
     +    ' histories to disk every ',i3,' iterations)')")
     +    sechist,mhissech
        write(6,"('SECSAVE  = ',i3,':',i2,':',i2,'  (save secondary',
     +    ' history files to mss every ',i3,' iterations')')")
     +    secsave,msavsech
        write(6,"('SECSTART = ',i3,':',i2,':',i2,'  (start secondary',
     +    ' history saves at iteration ',i6,')')") secstart,isecstart
        write(6,"('SECSTOP  = ',i3,':',i2,':',i2,'  (stop secondary',
     +    ' history saves at iteration ',i6,')')") secstop,isecstop
        write(6,"('Number of secondary histories to be written ',
     +    'this run = ',i3)") nsech
        write(6,"('Number of secondary history volumes to be written ',
     +    'this run = ',i3)") nvolsech
        write(6,"('Number of secondary histories that will fill',
     +    ' a mss volume = ',i3)") mfilsech
        write(6,"('Number of fields to be written to secondary ',
     +    'histories = ',i2,', as follows:')") nfsech
        ii = 0
        do i=1,mxfsech
          if (len_trim(secflds(i)).gt.0) then
            ii = ii+1
            if (ixfindr(fproc_names,nfproc,secflds(i)).gt.0) then
              write(6,"(a,' ',$)") secflds(i)
            else
              write(6,"(a,'* ',$)") secflds(i)(1:len_trim(secflds(i)))
            endif
            if (mod(ii,8).eq.0.or.ii.eq.nfsech) write(6,"(' ')")
          endif
        enddo
        write(6,"(/'Fields marked with ''*'' are diagnostic fields')")
        write(6,"(' ')")
c
c Certain fields are forced on the secondary histories (see notesec above)
c If these fields were not selected, they were set above -- notify user:
c
        if (notesec(1).gt.0) then
          write(6,"('NOTE: t,o2,o1,z are always written to ',
     +      'secondary histories '/6x,'(for post-model processing)')")
        endif
        if (notesec(2).gt.0) then
          write(6,"('NOTE: Because field OX was selected, its',
     +      ' component species (O1 and O3)'/6x,
     +      'will also be saved on the secondary histories')")
        endif
        if (notesec(3).gt.0) then
          write(6,"('NOTE: Because field NOZ was selected, its',
     +      ' component species (NO and NO2)'/6x,
     +      'will also be saved on the secondary histories')")
        endif
        if (notesec(4).gt.0) then
          write(6,"('NOTE: Because field HOX was selected, its',
     +      ' component species (OH, HO2 and H)'/6x,
     +      'will also be saved on the secondary histories')")
        endif
        write(6,"(75('-')/)")
      endif
C     ****
C     ****     AMIVOL
C     ****
      IF (ICNT(70).EQ. 0) THEN
        IAMIE = 0
      ELSE
        IAMIE = 1
        IF (ICNT(70) .NE. 3) THEN
          WRITE (5,"(1X,'INPUT -- AMIVOL:  SHOULD BE 3 ENTRIES')")
          IERROR = 1
        ENDIF
      ENDIF
C     ****
C     ****     CHECK JSWOLDA SWITCH (0 FOR NEW ALPHA, 1 FOR OLD ALPHA)
C     ****
      IF (ICNT(44) .NE. 1) THEN
        WRITE (6,'(1X,''INPUT -- OLDALF:  NO ENTRY, SO SET = 0'')')
        JSWOLDA = 0
      ENDIF
      IF (JSWOLDA .NE. 0 .AND. JSWOLDA .NE. 1) THEN
        WRITE (6,"(1X,'INPUT -- OLDALF:  MUST BE 0 OR 1, ICNT OLDALF =',
     1    2I3)") ICNT(44), JSWOLDA
        STOP
      ENDIF
c
c Low energy protons in aurora:
c
c     if (icnt(45) == 0) alfalp = 10.
c     if (icnt(46) == 0) efluxlp = 0.4
c     alfalp = 10.
c     efluxlp = 0.4
      alfalp = 10.
      efluxlp = 1.e-20
C     ****
      JDIDK = 0
      IF (ICNT(23) .EQ. 0 .AND. ICNT(39) .GT. 0) THEN
        JDIDK = 1
        ICNT(23) = ICNT(39)
        ICNT(39) = 0
        ICNT(24) = ICNT(40)
        ICNT(40) = 0
      ENDIF
      JDITH = 0
      IF (ICNT(25) .EQ. 0 .AND. ICNT(41) .GT. 0) THEN
        JDITH = 1
        ICNT(25) = ICNT(41)
        ICNT(41) = 0
        ICNT(26) = ICNT(42)
        ICNT(42) = 0
      ENDIF
      WRITE (6,"(1X,'JSWOLDA JDITH JDIDK =', 3I3)") JSWOLDA,JDITH,JDIDK
C     ****
      DO 60 IP=9,27,2
      IF (ICNT(IP) .GT. 0 .AND. ICNT(IP+1) .EQ. 0) THEN
        N = ICNT(IP)
        DO 50 J=1,N
        DO 50 I=1,4
  50    DUM(I,J,IP+1) = DUM(I,J,IP)
        ICNT(IP+1) = ICNT(IP)
      ENDIF
  60  CONTINUE
C     ****
      NAURP = 0
      IPR = 0
      DO 85 N=1,39
      IF (ICNT(N) .LT. 1) GO TO 90
      IF (ICNT(N) .GT. 1) IPR = 1
   85 CONTINUE
      WRITE (6,'(1X,''NAURP .GT. 38 --- STOP'')')
      STOP
   90 NAURP = N - 1
      IPOWER = IPR
      IF (NAURP.EQ.3 .OR. NAURP.EQ.28 .OR. NAURP.EQ.36 .OR. NAURP.EQ.38)
     1 GO TO 95
      WRITE (6,"(1X,'NAURP ='I3,' .NE. 3, 28, 36 OR 38 --- STOP.')")
     1 NAURP
      WRITE (6,"(1X,'ICNT:  ', 15I5)") (ICNT(I),I=1,39)
      STOP
   95 CONTINUE
      WRITE (6,'(1X,''NAURP IPR ='', 2I3)') NAURP, IPR
C     ****
      DO 200 N=1,NAURP
        NAME(N) = NAMEHA(N)
  200 CONTINUE
      DO 210 N=1,NAURP
        NPTS(N) = (ICNT(N)+3)/4
        IF (NPTS(N) .GT. NLEX) THEN
          WRITE (6,"(1X,'INPUT -- ',A8,' NPTS =',I3,
     1      ' WHICH IS .GT. NLEX')")NAME(N),NPTS(N)
          STOP
        ENDIF
  210 CONTINUE
      DO 6 N=1,NAURP
        II = ICNT(N)
        IF (II.GT.1 .AND. II.LT.8 .AND. MOD(II,4).NE.0) THEN
          WRITE (6,"(1X,'INPUT -- ',A8,' NO. OF ENTRIES MUST BE 1 OR ',
     1      'MULTIPLE OF 4 AND GE 8.  ICNT NPTS =', 2I5)") NAME(N),
     2      ICNT(N),NPTS(N)
           IERROR = 1
        ENDIF
    6 CONTINUE
      DO 19 N=1,NAURP
        IF (NPTS(N) .EQ. 1) THEN
           AURPS(1,2,N) = DUM(1,1,N)
        ELSE
          DO 20 M=1,NPTS(N)
            AURPS(M,1,N) = IHP(1,M,N)*24. + IHP(2,M,N) + IHP(3,M,N)/60.
            AURPS(M,2,N) = DUM(4,M,N)
   20     CONTINUE
        ENDIF
   19 CONTINUE
C     ****
C     ****    F107
C     ****
      N = 54
      NPTS(N) = (ICNT(68)+3)/4
      IF (NPTS(N) .EQ. 1) THEN
        AURPS(1,2,N) = DUM(1,1,N)
      ELSE
        DO 220 M=1,NPTS(N)
          AURPS(M,2,N) = DUM(4,M,N)
          AURPS(M,1,N) = IHP(1,M,N)*24. + IHP(2,M,N) + IHP(3,M,N)/60.
          IF (M .EQ. 1) GO TO 220
          IF (AURPS(M,1,N) .LE. AURPS(M-1,1,N)) THEN
            WRITE (6,"(1X,'INPUT --F107:  TABLE OF TIMES ',
     1        'MONOTONIC')")
            WRITE (6,"(1X,'NPTS N,N+1 =', 3I4, '  D H M (N,N+1)', 6I3)")
     1        NPTS(N),M-1,M,(IHP(K1,M-1,N),K1=1,3),(IHP(K2,M,N),K2=1,3)
            IERROR = 1
          ENDIF
  220   CONTINUE
      ENDIF
C     ****
C     ****    F107A
C     ****
      N = 55
      NPTS(N) = (ICNT(69)+3)/4
      IF (NPTS(N) .EQ. 1) THEN
        AURPS(1,2,N) = DUM(1,1,N)
      ELSE
        DO 221 M=1,NPTS(N)
          AURPS(M,2,N) = DUM(4,M,N)
          AURPS(M,1,N) = IHP(1,M,N)*24. + IHP(2,M,N) + IHP(3,M,N)/60.
          IF (M .EQ. 1) GO TO 221
          IF (AURPS(M,1,N) .LE. AURPS(M-1,1,N)) THEN
            WRITE (6,"(1X,'INPUT --F107A  TABLE OF TIMES NOT ',
     1        'MONOTONIC')")
            WRITE (6,"(1X,'NPTS N,N+1 =', 3I4, '  D H M (N,N+1)', 6I3)")
     1        NPTS(N),M-1,M,(IHP(K1,M-1,N),K1=1,3),(IHP(K2,M,N),K2=1,3)
          IERROR = 1
          ENDIF
  221   CONTINUE
      ENDIF
C     ****     TIMES FOR AURORAL PARAMETERS MUST BE MONOTONIC
      DO 240 N=1,NAURP
        IF (NPTS(N) .EQ. 1) GO TO 240
        DO 230 M=2,NPTS(N)
          IF (AURPS(M,1,N) .LE. AURPS(M-1,1,N)) THEN
            WRITE (6,"(1X,'INPUT --',A8,':  TABLE OF TIMES NOT ',
     1        'MONOTONIC')")NAME(N)
            WRITE (6,"(1X,'NPTS N,N+1 =', 3I4, '  D H M (N,N+1)', 6I3)")
     1        NPTS(N),M-1,M,(IHP(K1,M-1,N),K1=1,3),(IHP(K2,M,N),K2=1,3)
            IERROR = 1
          ENDIF
  230   CONTINUE
  240 CONTINUE
C     ****
C     ****   TERMINATE IF ERROR FLAG SET
C     ****
      IF (IERROR .EQ. 1) STOP 'input'
      IPRINT = 0
      IF (IPRINT .EQ. 0) GO TO 250
C     ****
C     ****     PRINT TABLE OF AURORAL PARAMETERS
C     ****
      N5 = (NAURP-1)/5 + 1
      DO 23 N=1,N5
      WRITE(6,142)
  142 FORMAT(1H )
      I1=(N-1)*5
      I1P5 = MIN0(NAURP,I1+5)
      I5 = I1P5 - I1
      WRITE(6,143)(NAMUT,NAME(I),I=I1+1,I1P5)
  143 FORMAT(1H ,10(4X,A8))
      WRITE(6,144)(NPTS(I),I=I1+1,I1P5)
  144 FORMAT(1H ,5I24)
      JPTS=0
      DO 24 I=1,I5
      IF(NPTS(I1+I).GT.JPTS)JPTS=NPTS(I1+I)
   24 CONTINUE
      DO 23 J=1,JPTS
      WRITE (6,145) ((AURPS(J,K,I),K=1,2),I=I1+1,I1P5)
  145 FORMAT(1H ,10E12.4)
   23 CONTINUE
  250 NHEMI = 0
C     ****
C     ****      IF HAVE AN AMIE VOLUME
C     ****
      IF (IAMIE .EQ. 0) RETURN
      CALL TRNSFR (AMIVOL,LABAMI,3,1)
      RETURN
      END
C
