C------------------------------------------------------------------------------
C     nptemp.for
C------------------------------------------------------------------------------
C     26 Jan 2006 - 
C     25 Jan 2006 - version for gravity waves
C     DO-NOTHING TEMPERATURE PERTURBATION MODEL
C------------------------------------------------------------------------------
      SUBROUTINE PTEMP

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

      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

      RETURN

      ENTRY PTEMPg(temperature)
      RETURN

      END SUBROUTINE PTEMP

C------------------------------------------------------------------------------

      SUBROUTINE SETPTMP
C
C     This subroutine is called once.
C
      implicit double precision (a-h,o-z)

C     COMMON DECK "B6" INSERTED HERE
      INTEGER DTMX,DTNTBL,DTITBL,DTFRMTB,IDSDT(10)
      COMMON/B6/DTMX,DTNTBL(10),DTITBL(10),DTFRMTB(10),DTGP(10)
      EQUIVALENCE (DTGP,IDSDT)
C
      INTEGER DWMX ,DWNTBL(10),DWITBL(10),DWFRMTB(10)
C
      DATA DWMX/1/
      DATA DWNTBL/1,11,8*0/
      DATA DWITBL/1,9*0/
      DATA DWFRMTB/1,9*0/
C
      DTMX=DWMX
      CALL IMOVE(DTNTBL,DWNTBL,10)
      CALL IMOVE(DTITBL,DWITBL,10)
      CALL IMOVE(DTFRMTB,DWFRMTB,10)
C
      RETURN
C
      END SUBROUTINE SETPTMP

C------------------------------------------------------------------------------

      SUBROUTINE IPTEMP
C     This subroutine is called once for each new W array.

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

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

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)
C
C     DELTA TEMPERATURE    225-249
      EQUIVALENCE (W(226),DTFORM)
C
      IF(W(225) .NE. 0.0) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(225) should be 0 if you are using NPTEMP'
      ENDIF
C
      MODT(3) = 'NPTEMP'
      MODT(4) = W(227)
      RETURN

      ENTRY IPTEMPg(modtg)
C     This subroutine is called once for each new W array.

      IF(W(225) .NE. 0.0) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(225) should be 0 if you are using NPTEMP'
      ENDIF
C
      modtg%pert_name = 'NPTEMP'
      modtg%pert_id = W(227)
      RETURN

      END SUBROUTINE IPTEMP
