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

      SUBROUTINE TBLOB2

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

C     TEMPERATURE PERTURBATION MODEL

C     MULTIPLICATIVE PERTURBATION WITH EXPONENTIALLY DECAYING

C     EFFECT IN ALL THREE DIRECTIONS. GIVE LATITUDE

C     INSTEAD OF CO-LATITUDE.

C     Compile with options /c (compile only) and /4Yb (error tracing)

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

      COMMON/PCONST/CREF,RGAS,GAMMA

      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10

C     COMMON DECK "RKAM" INSERTED HERE

      real*8 KR,KTH,KPH

      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20)

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     COMMON DECK "TT" INSERTED HERE

      real*8 MODT

      COMMON/TT/MODT(4),T,PTT,PTR,PTTH,PTPH

      COMMON/WW/ dum(10),MAXW,W(1000)

      EQUIVALENCE (EARTHR,W(1))

C

C     DELTA TEMPERATURE    225-249

      EQUIVALENCE (W(225),DTMODEL),(W(226),DTFORM),(W(227),DTID)

C

      EQUIVALENCE (C0,W(228)), (Z0,W(229)),(TBTH0,W(230))

      EQUIVALENCE (PH0,W(231)),(WZ,W(232)),(WTH,W(233)),(WPH,W(234))

      INTEGER DFMX,DFNTBL(10),DFITBL(10),DFFRMTB(10)

      DATA RECOGDT/2.d0/

      DATA DFMX/1/

      DATA DFNTBL/1,11,8*0/

      DATA DFITBL/1,9*0/

      DATA DFFRMTB/1,9*0/

C

      ENTRY SETPTMP

      DTMX=DFMX 

      CALL IMOVE(DTNTBL,DFNTBL,10)

      CALL IMOVE(DTITBL,DFITBL,10)

      CALL IMOVE(DTFRMTB,DFFRMTB,10)

      RETURN

C

      ENTRY IPTEMP

      IF(idint(RECOGDT) .NE. idint(DTMODEL))

     1    CALL RERROR('DTEMP  ','WRNG MODEL',RECOGDT)

      MODT(3)=6HTBLOB2

      MODT(4)=DTID

C

      FWZ=0.d0

      FWTH=0.d0

      FWPH=0.d0

      TH0= PID2-TBTH0

      IF(WZ.NE.0.d0) FWZ=2.d0/WZ/WZ

      IF(WTH.NE.0.d0) FWTH=2.d0/WTH/WTH

      IF(WPH.NE.0.d0) FWPH=2.d0/WPH/WPH

      RETURN

C

      ENTRY PTEMP

      IF(C0.EQ.0.d0) RETURN

      DZ=R-EARTHR-Z0

      DTH=TH-TH0

      DPH=PH-PH0

      DEXPO=0.d0

      EXPO=-0.5d0*(DZ*DZ*FWZ+DTH*DTH*FWTH+DPH*DPH*FWPH)

      IF(EXPO .GT. -200.d0) DEXPO=C0*dEXP(EXPO)

      DEL=1.d0+DEXPO

      PTR=PTR*DEL-T*DEXPO*FWZ*DZ

      PTTH=PTTH*DEL-T*DEXPO*FWTH*DTH

      PTPH=PTPH*DEL-T*DEXPO*FWPH*DPH

      T=T*DEL

      RETURN

      END

