*DK MINOR                                                                          MINOR.1          
      SUBROUTINE MINOR(NX,NXNM,RMX,PHIX,ALFAX,IBND,IBNDB,PXB)
      SAVE
C     ****                                                                         MINOR.4          
C     ****     COMMON DECKS:                                                       MINOR.5          
C     ****       PARAMS, ASAS, CONS, INDEX, VSCR,                                  MINOR.6          
C     ****                                                                         MINOR.7          
C     ****                                                                         MINOR.8          
C     ****     ADVANCES MINOR SPECIES BY ONE TIME STEP                             MINOR.9          
C     ****     NX = INDEX OF MINOR SPECIES FOR TIME T(N)                           MINOR.10         
C     ****     NXNM = INDEX OF MINOR SPECIES FOR TIME T(N-1)                       MINOR.11         
C     ****     NPSDH = INDEX FOR HORIZONTAL DIFFUSION FIELD                        MINOR.12         
C     ****     RMX = MOLECULAR WEIGHT OF MINOR SPECIES                             MINOR.13         
C     ****     PHIX = DIFFUSION VECTOR, PHI(X,N),N=1,3                             MINOR.14         
C     ****     ALFAX = THERMAL DIFFUSION COEFFICIENT                               MINOR.15         
C     ****     IBND=0 IF DIFFUSIVE FLUX GIVEN AT UPPER BOUNDARY (IN T4)            MINOR.16         
C     ****         =1 IF TOTAL FLUX GIVEN AT UPPER BOUNDARY (IN T4)                MINOR.17         
C     ****         NOTE: FLUXES ARE IN 1/(CM**2*SEC)                               MINOR.18         
C     ****                                                                         MINOR.19         
C     ****     ON ENTRY:                                                           MINOR.20         
C     ****     LOWER BOUNDARY:                                                     MINOR.21         
C     ****        IF IBNDB = 0, THEN                                               MINOR.22         
C     ****        T1 = A, T2 = B, T3 = C DEFINE LOWER BOUNDARY CONDITION           MINOR.23         
C     ****        WHERE       A*DPSX/DZ + B*PSX + C = 0.                           MINOR.24         
C     ****        IF IBNDB = 1, THEN                                               MINOR.25         
C     ****        T3 = UPWARD FLUX (1/(SEC*CM**2)) AT LOWER BOUNDARY               MINOR.26         
C     ****     UPPER BOUNDARY:                                                     MINOR.27         
C     ****        T4 = PHI, GIVES UPWARD FLUX OF SPECIES X AT UPPER                MINOR.28         
C     ****             BOUNDARY (1/(SEC*CM**2))                                    MINOR.29         
C     ****     SOURCES:                                                            MINOR.30         
C     ****        S1 = SX/N(X), WHERE SX IS PORTION OF NUMBER DENSITY              MINOR.31         
C     ****        SOURCE PROPORTIONAL TO N(X), THE MINOR SPECIES NUMBER            MINOR.32         
C     ****        DENSITY                                                          MINOR.33         
C     ****        S2 = S0, PORTION OF NUMBER DENSITY SOURCE INDEPENDENT            MINOR.34         
C     ****        OF N(X).                                                         MINOR.35         
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'index.h'
      include 'vscr.h'
      DIMENSION PHIX(3),B(2,2),PHI(2,3)
      DIMENSION PXB(IMXP)
      DATA PHI/0.,0.673,1.35,0.,1.11,0.769/,TAU/1.86E+3/,T00/273./,
     1SMALL/1.E-15/
      EQUIVALENCE (C(40),B)
C     ****     S13 = HORIZONAL ADVECTION                                           MINOR.46         
      DO 24 K=1,KMAX
      CALL ADVECL(NX,S13(1,K),K)
   24 CONTINUE
C     ****     PERIODIC POINTS                                                     MINOR.50         
      DO 42 I=1,2
      T1(I)=T1(I+IMAX)
      T1(I+IMAXP2)=T1(I+2)
      T2(I)=T2(I+IMAX)
      T2(I+IMAXP2)=T2(I+2)
      T3(I)=T3(I+IMAX)
      T3(I+IMAXP2)=T3(I+2)
      T4(I)=T4(I+IMAX)
      T4(I+IMAXP2)=T4(I+2)
      DO 42 K=1,KMAXP1
      S1(I,K)=S1(I+IMAX,K)
      S1(I+IMAXP2,K)=S1(I+2,K)
      S2(I,K)=S2(I+IMAX,K)
      S2(I+IMAXP2,K)=S2(I+2,K)
      S13(I,K)=S13(I+IMAX,K)
      S13(I+IMAXP2,K)=S13(I+2,K)
   42 CONTINUE
C     ****     S14=SX/N(X)(K+1/2),  S15=S0(K+1/2)                                  MINOR.68         
      DO 1 K=1,KMAX
      DO 1 I=1,LEN1
      S15(I,K)=.5*(S2(I,K)+S2(I,K+1))
      S14(I,K)=.5*(S1(I,K)+S1(I,K+1))
    1 CONTINUE
C     ****     T4 = PS1(-1/2), T5 = PS2(-1/2), T6 = MBAR(-1/2)                     MINOR.74         
      NPS1K=NJ+NPS
      NPS2K=NPS1K+KMAXP1
      DO 2 I=1,LEN1
      T7(I)=T4(I)
      T4(I)=B(1,1)*F(I,NPS1K)+B(1,2)*F(I,NPS2K)+FB(I,1)
      T5(I)=B(2,1)*F(I,NPS1K)+B(2,2)*F(I,NPS2K)+FB(I,2)
      T6(I)=1./(T4(I)/RMASS(1)+T5(I)/RMASS(2)+(1.-T4(I)-T5(I))/RMASS(3))
    2 CONTINUE
C     ****     S12 = MBAR(K+1/2)                                                   MINOR.83         
      NPS1K=NJ+NPS-1
      NPS2K=NPS1K+KMAXP1
      DO 3 K = 1,KMAXP1
      DO 3 I=1,LEN1
      S12(I,K)=1./(F(I,NPS1K+K)/RMASS(1)+F(I,NPS2K+K)/RMASS(2)+(1.-
     1  F(I,NPS1K+K)-F(I,NPS2K+K))/RMASS(3))
    3 CONTINUE
C     ****     S11 = MBAR(K), S10 = DM/DZ(K), S9 = PS2(K),                         MINOR.91         
C     ****     S8 = PS1(K), S7 = DPS2/DZ(K), S6 = DPS1/DZ(K)                       MINOR.92         
C     ****     LOWER BOUNDARY                                                      MINOR.93         
      DO 4 I=1,LEN1
      S11(I,1)=.5*(T6(I)+S12(I,1))
      S10(I,1)=(S12(I,1)-T6(I))/C(3)
      S9(I,1)=.5*(T5(I)+F(I,NPS2K+1))
      S8(I,1)=.5*(T4(I)+F(I,NPS1K+1))
      S7(I,1)=(F(I,NPS2K+1)-T5(I))/C(3)
      S6(I,1)=(F(I,NPS1K+1)-T4(I))/C(3)
      T4(I)=T7(I)
    4 CONTINUE
C     ****     LEVELS K=2,KMAXP1                                                   MINOR.103        
      DO 5 K = 2,KMAXP1
      DO 5 I=1,LEN1
      S11(I,K)=.5*(S12(I,K)+S12(I,K-1))
      S10(I,K)=(S12(I,K)-S12(I,K-1))/C(3)
      S9(I,K)=.5*(F(I,NPS2K+K)+F(I,NPS2K+K-1))
      S8(I,K)=.5*(F(I,NPS1K+K)+F(I,NPS1K+K-1))
      S7(I,K)=(F(I,NPS2K+K)-F(I,NPS2K+K-1))/C(3)
      S6(I,K)=(F(I,NPS1K+K)-F(I,NPS1K+K-1))/C(3)
    5 CONTINUE
C     ****     S5=T(TOT,K)                                                         MINOR.113        
C     ****     LOWER AND UPPER BOUNDARIES                                          MINOR.114        
      NTK=NJ+NT+KMAX
      DO 6 I=1,LEN1
      S5(I,1)=T0(1)+F(I,NTK)
      S5(I,KMAXP1)=T0(KMAXP1)+F(I,NTK-1)
    6 CONTINUE
C     ****     LEVELS K=2,KMAX                                                     MINOR.120        
      NTK=NJ+NT
      DO 7 K=2,KMAX
      NTK=NTK+1
      DO 7 I=1,LEN1
      S5(I,K)=T0(K)+.5*(F(I,NTK)+F(I,NTK-1))
    7 CONTINUE
C     ****     EVALUATE ALFA12, ALFA21, ALFAM1, ALFAM2                             MINOR.127        
      ALFA12=PHI(1,2)-PHI(1,3)
      ALFA21=PHI(2,1)-PHI(2,3)
      ALFAX1=PHIX(1)-PHIX(3)
      ALFAX2=PHIX(2)-PHIX(3)
C     ****     S15=(S0*MX/NMBAR)(K+1/2)                                            MINOR.132        
      NTK=NJ+NT-1
      DO 8 K=1,KMAX
      NTK=NTK+1
      DO 8 I=1,LEN1
      S15(I,K)=S15(I,K)*RMX*C(84)*(.5*(T0(K)+T0(K+1))+F(I,NTK))/(C(81)*
     1EXPS(K)*S12(I,K))
    8 CONTINUE
C     ****     IF IBNDB = 1, SET UP FLUX BOUNDARY CONDITION AT BOTTOM              MINOR.140        
      IF(IBNDB.EQ.1)THEN
          DO 26 I=1,LEN1
          T1(I)=1.
          T2(I)=S10(I,1)/S11(I,1)
	  T3(I)=T3(I)*C(54)*RMX/(DIFK(I,1)*C(81)*EXPS(1)*C(87)*C(85))
   26     CONTINUE
      ENDIF
C     ****     S1 = ALFA(1,1,K), S2 = ALFA(1,2,K),                                 MINOR.148        
C     ****     S2 = ALFA(2,1,K), S4 = ALFA(2,2,K)                                  MINOR.149        
      DO 9 K=1,KMAXP1
      DO 9 I=1,LEN1
      S1(I,K)=-(PHI(1,3)+ALFA12*S9(I,K))
      S2(I,K)=ALFA12*S8(I,K)
      S3(I,K)=ALFA21*S9(I,K)
      S4(I,K)=-(PHI(2,3)+ALFA21*S8(I,K))
C     ****     S12=EX(K)                                                           MINOR.156        
      S12(I,K)=((ALFAX1*S4(I,K)-ALFAX2*S3(I,K))*(S6(I,K)-(1.-(RMASS(1)+
     1  S10(I,K))/S11(I,K))*S8(I,K))+(ALFAX2*S1(I,K)-ALFAX1*S2(I,K))*
     2  (S7(I,K)-(1.-(RMASS(2)+S10(I,K))/S11(I,K))*S9(I,K)))/(S1(I,K)*
     3  S4(I,K)-S2(I,K)*S3(I,K))+1.-(RMX+S10(I,K))/S11(I,K)
C     ****     S10 = (DM/DZ)/MBAR                                                  MINOR.161        
      S10(I,K)=S10(I,K)/S11(I,K)
C     ****     S11 = AX(K)                                                         MINOR.163        
      S11(I,K)=-S11(I,K)/(TAU*RMASS(3))*(T00/S5(I,K))**0.25/(PHIX(3)+
     1  ALFAX1*S8(I,K)+ALFAX2*S9(I,K))
    9 CONTINUE
C     ****     S12=EX-ALFAX*D/DS(LN(T(TOT))  (THERMAL DIFFUSION TERM)              MINOR.167        
      DO 21 K=2,KMAX
      DO 21 I=1,LEN1
      S12(I,K)=S12(I,K)-ALFAX*(S5(I,K+1)-S5(I,K-1))/(2.*C(3)*
     1  S5(I,K))
   21 CONTINUE
C     ****     LOWER BOUNDARY AND UPPER BOUNDARY                                   MINOR.173        
      DO 22 I=1,LEN1
      S12(I,1)=S12(I,1)-ALFAX*(S5(I,2)-S5(I,1))/(C(3)*S5(I,1))
   22 CONTINUE
      K=KMAXP1
      DO 23 I=1,LEN1
      S12(I,K)=S12(I,K)-ALFAX*(S5(I,K)-S5(I,K-1)
     1  )/(C(3)*S5(I,K))
   23 CONTINUE
C     ****     T7=DFACT                                                            MINOR.182        
      DO 10 I=1,LEN1
      T7(I)=1.
   10 CONTINUE
C     ****     SHAPIRO SMOOTHER,   S10=NXNM  (ELIMINATED)                          MINOR.186        
      NXNMK=NJ+NXNM-1
      DO 12 K=1,KMAXP1
      DO 12 I=3,LEN1-2
      S9(I,K)=S10(I,K)
       S10(I,K)=F(I,NXNMK+K)-C(26)*(F(I+2,NXNMK+K)+F(I-2,NXNMK+K)-4.*
     1  (F(I+2,NXNMK+K)+F(I-2,NXNMK+K))+6.*F(I,NXNMK+K))
   12 CONTINUE
C     ****     S1 = P, S2 = Q, S3 = R, S4= F                                       MINOR.194        
      NWK=NJ+NW-1
      DO 13 K=1,KMAX
      NWK=NWK+1
      DO 13 I=1,LEN1
      S1(I,K)=S11(I,K)/C(3)*(1./C(3)+.5*S12(I,K))-EXPS(K)*(C(87)*
     1  DIFK(I,K)*T7(I)*(1./C(3)-.5*S9(I,K))+0.25*(F(I,NWK)+
     2  F(I,NWK+1)))/C(3)
      S3(I,K)=S11(I,K+1)/C(3)*(1./C(3)-.5*S12(I,K+1))-EXPS(K)*(C(86)*
     1  DIFK(I,K+1)*T7(I)*(1./C(3)+.5*S9(I,K+1))-0.25*(F(I,NWK)+
     2  F(I,NWK+1)))/C(3)
      S2(I,K)=-(S11(I,K)/C(3)*(1./C(3)-.5*S12(I,K))+S11(I,K+1)/C(3)*(1./
     1  C(3)+.5*S12(I,K+1)))+EXPS(K)*((C(87)*DIFK(I,K)*(1./C(3)+.5*
     2  S9(I,K))+C(86)*DIFK(I,K+1)*(1./C(3)-.5*S9(I,K+1)))*T7(I)/C(3)-
     3  S14(I,K)+C(7))
      S4(I,K)=EXPS(K)*(S10(I,K)*C(7)-S13(I,K)+S15(I,K))
   13 CONTINUE
C     ****     BOUNDARIES                                                          MINOR.211        
C     ****     MODIFY EX(KMAXP1) IF IBND=1                                         MINOR.212        
      IF(IBND.EQ.1)THEN
           NWK=NJ+NW+KMAX
           DO 25 I=1,LEN1
           T7(I)=EXPS(KMAX)*C(86)*F(I,NWK)/S11(I,KMAXP1)
           S12(I,KMAXP1)=S12(I,KMAXP1)-T7(I)
   25      CONTINUE
      ENDIF
      DO 14 I=1,LEN1
C     ****     LOWER BOUNDARY                                                      MINOR.221        
      S2(I,1)=S2(I,1)+S1(I,1)*(T1(I)+.5*T2(I)*C(3))/(T1(I)-.5*T2(I)*C(3)
     1)
      S4(I,1)=S4(I,1)-S1(I,1)*T3(I)*C(3)/(T1(I)-.5*T2(I)*C(3))
      S1(I,1)=0.
C     ****     UPPER BOUNDARY  (UPWARD FLUX GIVEN)                                 MINOR.226        
      S2(I,KMAX)=S2(I,KMAX)+S3(I,KMAX)*(1.+.5*S12(I,KMAXP1)*C(3))/(1.-
     1.5*S12(I,KMAXP1)*C(3))
      S4(I,KMAX)=S4(I,KMAX)-S3(I,KMAX)*C(54)*RMX/(C(81)*S11(I,KMAXP1)*
     1C(85))*T4(I)*C(3)/(1.-.5*S12(I,KMAXP1)*C(3))
      S3(I,KMAX)=0.
   14 CONTINUE
C     ****     SOLVE TRIDIAGONAL SYSTEM                                            MINOR.233        
      NXNPK=NJNP+NX
      CALL TRSOLV(S1,S2,S3,S4,S7,F(1,NXNPK),LEN1,3,LEN1-2,KMAXP1,1,KMAX
     1,1)
C     ****     INSERT VALUE OF NXNPK(KMAXP1) USING UPPER BOUNDARY                  MINOR.237        
C     ****                     CONDITION                                           MINOR.238        
      NXNPK=NJNP+NX+KMAX
      DO 15 I=3,LEN1-2
      F(I,NXNPK)=(C(54)*RMX/(C(81)*S11(I,KMAXP1)*C(85))*T4(I)*C(3)+
     1(1.+.5*S12(I,KMAXP1)*C(3))*F(I,NXNPK-1))/(1.-.5*S12(I,KMAXP1)*
     2C(3))
   15 CONTINUE
C     ****     INSERT PERIODIC POINTS                                              MINOR.245        
      K1=NJNP+NX
      K2=K1+KMAX
      DO 18 N=1,2
      DO 19 I=1,2
      DO 19 K=K1,K2
      F(I,K)=F(I+IMAX,K)
      F(I+IMAXP2,K)=F(I+2,K)
   19 CONTINUE
      K1=NJNP+NXNM
      K2=K1+KMAX
   18 CONTINUE
C     ****     TIME SMOOTHING                                                      MINOR.257        
      NXNMK=NJ+NXNM-1
      NXK=NJ+NX-1
      NXNPK=NJNP+NX-1
      NXMNK=NJNP+NXNM-1
      DO 17 K=1,KMAXP1
      DO 17 I=1,LEN1
      F(I,NXMNK+K)=C(30)*F(I,NXK+K)+C(31)*(F(I,NXNMK+K)+F(I,NXNPK+K))
   17 CONTINUE
C     ****     PXB = PSX(-1/2)                                                     MINOR.266        
      NXNPK=NJNP+NX
      DO 16 I = 1,LEN1
      PXB(I)=(F(I,NXNPK)*(T1(I)+.5*T2(I)*C(3))+T3(I)*C(3))/
     1(T1(I)-.5*T2(I)*C(3))
   16 CONTINUE
C     ****     INSURE NON-NEGATIVE NX                                              MINOR.272        
      NXK=NJNP+NX-1
      NXNMK=NJNP+NXNM-1
      DO 20 K=1,KMAXP1
      DO 20 I=1,LEN1
      F(I,NXK+K)=CVMGP(F(I,NXK+K),SMALL,F(I,NXK+K)-SMALL)
      F(I,NXNMK+K)=CVMGP(F(I,NXNMK+K),SMALL,F(I,NXNMK+K)-SMALL)
   20 CONTINUE
      RETURN
      END
