C ----------------------------------------------------------------------!-------
C tlinear.for
C ----------------------------------------------------------------------!-------
! 16 Mar 2011 - different entry points for acoustics and gravity
! 16 Mar 2011 - version for gravity waves
C 13 Mar 2008 - Corrected length in common block /MM/
C 27 Jul 2006 - added entry settmp with call setptmp
C ----------------------------------------------------------------------!-------
      SUBROUTINE TLINEAR
C ----------------------------------------------------------------------!-------
C     LINEAR TEMPERATURE PROFILE

      implicit double precision (a-h,o-z)

      TYPE :: model                                                ! 16 Mar 2011
         CHARACTER :: model_name
         REAL(KIND=8) :: data_id
         CHARACTER :: pert_name
         REAL(KIND=8) :: pert_id
      END TYPE model
      TYPE (model) :: modtg

      TYPE :: values_and_derivs_1_2
         REAL(KIND=8) :: value
         REAL(KIND=8) :: ptm,pr,pth,pph
         REAL(KIND=8) :: ptmtm,prtm,pthtm,pphtm
         REAL(KIND=8) :: ptmr,prr,pthr,pphr
         REAL(KIND=8) :: ptmth,prth,pthth,pphth
         REAL(KIND=8) :: ptmph,prph,pthph,pphph
      END TYPE 
      TYPE (values_and_derivs_1_2) :: temperature

C     COMMON DECK "RKAM" INSERTED HERE
      DOUBLE PRECISION KR,KTH,KPH
      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20)

C     COMMON DECK "MM" INSERTED HERE
      DOUBLE PRECISION M,MODM
      COMMON/MM/MODM(4),M,PMT,PMR,PMTH,PMPH
     1 ,XO2,XN2,XO,XN,XH2O,XO3                        ! 5 Mar 2007 ! 13 Mar 2008

C     COMMON DECK "TT" INSERTED HERE
      DOUBLE PRECISION MODT
      COMMON/TT/MODT(4), T,PTT,PTR,PTTH,PTPH

C     COMMON DECK "WW" INSERTED HERE
      PARAMETER (NWARSZ=1000)
      COMMON/WW/ dum(10),MAXW,W(NWARSZ)
      EQUIVALENCE (EARTHR,W(1))
C
C     TEMPERATURE    200-224
C
       EQUIVALENCE (TGND, W(203)), (A, W(204))

C     COMMON DECK "B5" INSERTED HERE
      INTEGER TMX,TNTBL,TITBL,TFRMTBL,IDST(10)
      COMMON/B5/TMX,TNTBL(10),TITBL(10),TFRMTBL(10),TGP(262)
      EQUIVALENCE (TGP,IDST),(ANT,TGP(11))
      INTEGER TYMX,TYNTBL(10),TYITBL(10),TYFRMTBL(10)
      DATA ANT/0.0/
c      DATA TMX/1/
c      DATA TNTBL/1,11,8*0/
c      DATA TITBL/1,9*0/
c      DATA TFRMTBL/1,9*0/

      DATA RECOGT/0.d0/
      DATA TYMX/1/
      DATA TYNTBL/1,11,8*0/
      DATA TYITBL/1,9*0/
      DATA TYFRMTBL/1,9*0/
C                           
C ----------------------------------------------------------------------!-------
      entry settmp                                                 ! 27 Jul 2006
C ----------------------------------------------------------------------!-------
      TMX=TYMX             
      CALL IMOVE(TNTBL,TYNTBL,10)  
      CALL IMOVE(TITBL,TYITBL,10)  
      CALL IMOVE(TFRMTBL,TYFRMTBL,10) ! 26 Jul 2006 
      call setptmp ! 27 Jul 2006
      return
C ----------------------------------------------------------------------!-------
      ENTRY ITEMP
C ----------------------------------------------------------------------!-------
C     This subroutine is called once for each new W array.

      if (w(200) .ne. 1) then
           PRINT*,' Model check number mismatch: '
           STOP ' W(200) should be 1 if you are using model TLINEAR.'
      endif

C
      MODT(1) = 'TLINEAR'                                  
      MODT(2) = w(202)
      CALL IPTEMP
C
      RETURN
C
C ----------------------------------------------------------------------!-------
      ENTRY itempg(modtg)                                          ! 16 Mar 2011
C ----------------------------------------------------------------------!-------
C     This subroutine is called once for each new W array.
      CALL iptempg(modtg)                                          

      if (w(200) .ne. 1) then
           PRINT*,' Model check number mismatch: '
           STOP ' W(200) should be 1 if you are using model TLINEAR.'
      endif

      modtg%model_name = 'TLINEAR'                                  
      modtg%data_id = w(202)

      RETURN
C ----------------------------------------------------------------------!-------
      ENTRY TEMP
C ----------------------------------------------------------------------!-------
      H = R - EARTHR
      T = TGND + A * H
      CALL CLEAR(PTT,4)
      pTt = 0.d0                                                   ! 16 Mar 2011
      pTth = 0.d0                                                  ! 16 Mar 2011
      pTph = 0.d0                                                  ! 16 Mar 2011
      PTR=A

      CALL PTEMP
      RETURN
C ----------------------------------------------------------------------!-------
      ENTRY tempg(temperature)                                     ! 16 Mar 2011
C ----------------------------------------------------------------------!-------
c      PRINT *,' at tempg'
      h = r - earthr
      T = TGND + A * H
      PTR=A
c      PRINT *,' at tempg'
      temperature%value = T

      temperature%ptm = 0.d0
      temperature%pr = pTr
      temperature%pth = 0.d0
      temperature%pph = 0.d0

      temperature%ptmtm = 0.d0
      temperature%prtm = 0.d0
      temperature%pthtm = 0.d0
      temperature%pphtm = 0.d0

      temperature%ptmr = 0.d0
      temperature%prr = 0.d0
      temperature%pthr = 0.d0
      temperature%pphr = 0.d0

      temperature%ptmth = 0.d0
      temperature%prth = 0.d0
      temperature%pthth = 0.d0
      temperature%pphth = 0.d0

      temperature%ptmph = 0.d0
      temperature%prph = 0.d0
      temperature%pthph = 0.d0
      temperature%pphph = 0.d0

c      PRINT *,'T = ',T
c      PRINT *,'pTr = ',pTr
c      PRINT *,'pTrr = ',temperature%prr


      CALL ptempg(temperature)                                     
      RETURN

C ----------------------------------------------------------------------!-------
      END SUBROUTINE TLINEAR
C ----------------------------------------------------------------------!-------