text: C
  C-----------------------------------------------------------------------
  C
  C   Model for the plasmaspheric electron temperature based on Akebono
  C   TED data:
  C     I. Kutiev, K. Oyama, T. Abe, and P. Marinov, Plasamsphere 
  C         electron temperature model based on Akebono data, Advances in 
  C         Space Research 33, 975-979, 2004
  C
  C   This file includes the model subroutine TE3ARG and a short driver
  C   program 
  C
  C-----------------------------------------------------------------------
  C   Subroutine TE3ARG and main program
  C    
  C   Examples:
  C      IN: TLOC, GMLAT, HEIGHT     OUT: TLOC, GMLAT, Height, Te 
  C               14,-50,1000        14.00   -50.00  1000.00   5283.16
  C               14,-70,5000        14.00   -70.00  5000.00   3935.66
  C               14,-71,5000        14.00   -71.00  5000.00    3935.7 warning 1
  C               14,70,5000         14.00    70.00  5000.00   3935.66
  C               14,-80,0           14.00   -80.00     0.00    2764.0 warning 2
  C               warning 1 indicates one input parameter out of range
  C               warning 2 indicates two input parameters out of range
  C-----------------------------------------------------------------------
  C
  C     2007/01/10
  C     2005/07/17
  C     2002/04/28
  C   		Pencho G. Marinov                                                    
  C   		Institute for Parallel Processing                           
  C   		Bulgarian Academy of Science                                         
  C   		E-mail: pencho@bas.bg                                           
  C
  C     1) The Polynomial Approximation
  C
  C     2) 3-dimensioned X_space
  C
  C
  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  C
  C
        PROGRAM PGMIK
  C
        IMPLICIT REAL*4 (A-H,O-Z)
        IMPLICIT INTEGER*2 (I-N)
  C
        COMMON /BLBAS/ XL(3),XR(3),SL(3),SR(3),NBAS(2,3),MBAS(3)
        COMMON /BLDAT/ BUFF(50)
        COMMON /BLWRK/ WA(216),WB(216),WC(6,6,6)
        COMMON /BLCFN/ Z(216),A(216),CFN(6,6,6),NCFN(20)
        COMMON /BLEPS/ ERS(20), NITER(20), O, E
        COMMON /BLIOT/ NINP1, NINP2, NOUT1, NOUT2, NTAB1, NTAB2
  C
        LOGICAL IOCHECK
        CHARACTER*64 NAME(10), NAMP(10)
        integer*4 n,n0
  c
        data NR, NW, npgm /1,2,4/
  C
        DATA  NAME(1)/'AKEBONO.INP'/
        DATA  NAME(2)/'AKEBONO.OUT'/
        DATA  NAME(3)/'AKEBONO.INF'/
        DATA  NAME(4)/'AKEBONO.CFN'/
        DATA  NAMP(7)/'(1X,A)                  '/
        DATA  NAMP(8)/'(1X,3F9.2, F10.2  )     '/
        DATA  NAMP(9)/'(1X,3F9.2,F10.1,8H warning,I2)'/
  C
           n=0
           n0=0
           write(*,*) 'LT [0.0 - 24.0], GMLAT [-70 to +70], HEIGHT ',
       &   '[1000-10,000 km] (# to end)'
  C
    200 CONTINUE
           READ (* , *, ERR=201, END=201) TLOC, GMLAT, HEIGHT
           n=n+1
           call TE3ARG(TLOC, GMLAT, HEIGHT, TE, ierr)
           if (ierr.GT.0) then
              n0=n0+1
              WRITE( *,NAMP(9)) TLOC, GMLAT, HEIGHT, TE, ierr
           else
              WRITE(* ,NAMP(8)) TLOC, GMLAT, HEIGHT, TE
           endif
           GOTO 200
    201 CONTINUE
  C
        write(*,*) n , ' - rows processed  '
        write(*,*) n0, ' - warnings occured '
  C
   301  continue
        STOP '  '
  C
        END
  C
  C
         SUBROUTINE TE3ARG(TLOC,GMLAT,HEIGHT,TE,ierr)
  C--------------------------------------------------------------------------
  C      Input parameters are: 
  C          TLOC solar local time in hours (0-24) 
  C          GMLAT magnetic latitude in degrees (-70 - +70) 
  C          HEIGHT altitude in km (1000 - 10,000)
  C          If input parameters is outside valid range it will be set to the
  C          nearest range boundary, e.g., +80 to +70
  C      Output parameters are: 
  C          TE  electron temperature in K
  C          ierr  # of cases of input parameter ouside valid range
  C--------------------------------------------------------------------------
  C
  C
        IMPLICIT REAL*4 (A-H,O-Z)
        IMPLICIT INTEGER*2  (I-N)
  C
        COMMON /BLBAS/ XL(3),XR(3),SL(3),SR(3),NBAS(2,3),MBAS(3)
        COMMON /BLDAT/ BUFF(50)
        COMMON /BLCFN/ Z(216),A(216),CFN(6,6,6),NCFN(20)
        COMMON /BLEPS/ ERS(20), NITER(20), O, E
  C
        CHARACTER*64 FORMD,FORME
  C
        FFL(V)=(2.0D0-V-3*V*V+2*V**3)*0.5D0
        FFR(V)=(      V+3*V*V-2*V**3)*0.5D0
  C
        A(11) = TLOC
        A(12) = GMLAT
        A(13) = HEIGHT
  C
  C     Test if input data are in correct range.
  C          if NOT then ierr>0
  C
           ierr=0
           A(1)=A(11)
           A(2)=A(12)
           A(3)=A(13)
           IF (A(11).LT.(0.0)) THEN
              A(1)=0.0
              ierr=ierr+1
           ENDIF
           IF (A(11).GT.(24.)) THEN
              A(1)=24.0
              ierr=ierr+1
           ENDIF
           IF ( (A(12).LT.XL(2)).AND.(A(12).LT.O) ) A(2)=-A(12)
           IF (A( 2).GT.XR(2)) THEN
              A(2)=XR(2)
              ierr=ierr+1
           ENDIF
           IF (A(13).LT.XL(3)) THEN
              A(3)=XL(3)
              ierr=ierr+1
           ENDIF
           IF (A(13).GT.XR(3)) THEN
              A(3)=XR(3)
              ierr=ierr+1
           ENDIF
  C
           DO J=2,3
              BUFF(J)=SL(J)+(A(J)-XL(J))/(XR(J)-XL(J))*(SR(J)-SL(J))
           ENDDO
           BUFF(1)=SL(1)
           R1 = R(BUFF)
           BUFF(1)=SR(1)
           R2 = R(BUFF)
           IF ((A(1)-9.0)*(16.0-A(1)).GE.O) THEN
              BUFF(4) = R2
              GOTO 202
           ENDIF
           IF ( (A(1).GE.(22.0)).OR.(A(1).LE.(4.0)) ) THEN
              BUFF(4) = R1
              GOTO 202
           ENDIF
           IF ((A(1)-4.0)*(9.0-A(1)).GE.O) THEN
              SS = (A(1)-4.0)/5.0
              BUFF(4) = R1*FFL(SS)+R2*FFR(SS)
              GOTO 202
           ENDIF
           IF ((A(1)-16.0)*(22.0-A(1)).GE.O) THEN
              SS = (A(1)-16.0)/6.0
              BUFF(4) = R2*FFL(SS)+R1*FFR(SS)
              GOTO 202
           ENDIF
  C
    202 CONTINUE
           A   (4)=BUFF(4)
           A  (14)=   A(4)*FLOAT(MBAS(1))
           TE = A(14) 
  C
  C
        RETURN
        END
  C
  C
  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  C
  C
        REAL*4 FUNCTION R(S)
  C
        IMPLICIT REAL*4 (A-H,O-Z)
        IMPLICIT INTEGER*2  (I-N)
  C
        COMMON /BLCFN/ Z(6,6,6),A(216),CFN(6,6,6),NCFN(20)
        COMMON /BLEPS/ ERS(20), NITER(20), O, E
        DIMENSION S(5)
  C
        R=O
        CALL PVGB(S)
                DO  I3 = 1, NCFN(3)
                    DO  I2 = 1, NCFN(2)
                        DO  I1 = 1, NCFN(1)
                            R=R+Z(I1,I2,I3)*CFN(I1,I2,I3)
                        END DO
                    END DO
                END DO
  C
        RETURN
        END
  C
  C
  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  C
  C
  C     NBAS  1 2 3  4 5 6  7 8 9
  C     NB1   1 1 1  2 2 2  3 3 3    1= S**   2=Tn  3= sin cos
  C     NB2   1 2 3  1 2 3  1 2 3    1=0,1,2,3... 2=0,2,4... 3=0,1,3,5...
  C
  C
        SUBROUTINE PVGB(S)
  C
        IMPLICIT REAL*4 (A-H,O-Z)
        IMPLICIT INTEGER*2  (I-N)
  C
        COMMON /BLBAS/ XL(3),XR(3),SL(3),SR(3),NBAS(2,3),MBAS(3)
        COMMON /BLWRK/ WA(36,6),WB(216),WC(6,6,6)
        COMMON /BLCFN/ Z(6,6,6),A(216),CFN(6,6,6),NCFN(20)
        COMMON /BLEPS/ ERS(20), NITER(20), O, E
  C
        DIMENSION S(5)
  C
        DO  I=1,3
            CALL PVGB1( S(I), WA(1,I), NCFN(I), NBAS(1,I), NBAS(2,I) )
        END DO
  C
        WB(4)=E
                DO  I3 = 1, NCFN(3)
                    WB(3)=WB(4)*WA(I3,3)
                    DO  I2 = 1, NCFN(2)
                        WB(2)=WB(3)*WA(I2,2)
                        DO  I1 = 1, NCFN(1)
                            WB(1)=WB(2)*WA(I1,1)
                            Z(I1,I2,I3)=WB(1)
                        END DO
                    END DO
                END DO
  C
        RETURN
        END
  C
  C
  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  C
  C
        SUBROUTINE PVGB1(S,T,N,NBAS1,NBAS2)
  C
  C
  C     NBAS  1 2 3  4 5 6  7 8 9
  C     NB1   1 1 1  2 2 2  3 3 3    1= S**   2=Tn  3= sin cos
  C     NB2   1 2 3  1 2 3  1 2 3    1=0,1,2,3... 2=0,2,4... 3=0,1,3,5...
  C
        IMPLICIT REAL*4 (A-H,O-Z)
        IMPLICIT INTEGER*2  (I-N)
  C
        COMMON /BLEPS/ ERS(20), NITER(20), O, ONE
        DIMENSION T(5)
  C
        GOTO (10,20,30),NBAS1
    10  T(1)=ONE
        GOTO (11,13,14),NBAS2
    11  DO 12 I=2,N
    12  T(I)=T(I-1)*S
        RETURN
    13  T(2)=S*S
        GOTO 15
    14  T(2)=S
    15  SS=S*S
        DO 16 I=3,N
    16  T(I)=T(I-1)*SS
        RETURN
    20  T(1)=ONE
        T(2)=S
        SS=S+S
        NN=N
        IF(NBAS2.GT.1) NN=N+N
        DO 21 I=3,NN
    21  T(I)=T(I-1)*SS-T(I-2)
        GOTO (26,22,24),NBAS2
    22  DO 23 I=2,N
        J=2*I-1
    23  T(I)=T(J)
        GOTO 26
    24  DO 25 I=2,N
        J=2*I-2
    25  T(I)=T(J)
    26  RETURN
    30  T(1)=ONE
        SS= SIN(S)
        SC= COS(S)
        NN=N
        IF(NBAS2.GT.1) NN=N+N
        T(2)=SS
        T(3)=SC
        DO 31 I=4,NN,2
        T(I)  =T(I-2)*SC+T(I-1)*SS
    31  T(I+1)=T(I-1)*SC-T(I-2)*SS
        GOTO (36,32,34),NBAS2
    32  DO 33 I=2,N
        J=2*I-1
    33  T(I)=T(J)
        GOTO 36
    34  DO 35 I=2,N
        J=2*I-2
    35  T(I)=T(J)
    36  RETURN
        END
  C
  C
  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  C
  C
        BLOCK DATA PMIK
  C
        IMPLICIT REAL*4 (A-H,O-Z)
        IMPLICIT INTEGER*2  (I-N)
  C
        COMMON /BLBAS/ XL(3),XR(3),SL(3),SR(3),NBAS(2,3),MBAS(3)
        COMMON /BLDAT/ BUFF(50)
        COMMON /BLWRK/ WA(216),WB(216),WC(6,6,6)
        COMMON /BLCFN/ Z(216),A(216),CFN(6,6,6),NCFN(20)
        COMMON /BLEPS/ ERS(20), NITER(20), O, E
        COMMON /BLIOT/ NINP1, NINP2, NOUT1, NOUT2, NTAB1, NTAB2
  C
        DATA NITER/20*0/,ERS/20*.0E0/,O/0.0E0/,E/1.000E0/
        DATA NINP1, NINP2 /1,2/
        DATA NOUT1, NOUT2 /5,6/
        DATA NTAB1, NTAB2 /3,4/
  C
        DATA XL/1.0, -70.0, 1000. /
        DATA XR/13.,  70.0, 10000./
        DATA SL/0.0, -1.00, -1.00 /
        DATA SR/1.0,  1.00,  1.00 /
        DATA NBAS/ 1, 1, 2,  2, 2, 1 /
        DATA MBAS/1000, 1, 0 /
        DATA NCFN/ 2, 3, 4, 0, 0, 1, 2, 6, 24, 0, 24, 9*0 /
        DATA CFN/ 0.312742E+01, 0.267892E+01, 4*0.0,
       *         -0.142170E+00,-0.935806E+00, 4*0.0,
       *         -0.719833E+00,-0.372147E+00,22*0.0,
       *          0.323231E+00, 0.683911E+00, 4*0.0,
       *         -0.797365E+00,-0.605986E+00, 4*0.0,
       *         -0.100220E+00, 0.527238E+00,22*0.0, 
       *         -0.127842E+00,-0.321196E+00, 4*0.0,
       *         -0.676206E-01, 0.212179E+00, 4*0.0,
       *          0.136602E+00, 0.126485E+00,22*0.0, 
       *          0.149113E+00, 0.217611E+00, 4*0.0,
       *          0.166502E+00, 0.223654E+00, 4*0.0,
       *          0.834719E-01,-0.402023E-01,22*0.0,72*0.0/
        END
  