C      REAL*4 FUNCTION INERSP (TEMP,ALB,AMODL,DTA,DTI,AHR,ALAT,AINC)=C_Title  INERSP  computes single-point mars' thermal inertia.C_Arguments6      REAL*4 TEMP  ![i] temperature in degrees kelvin.      REAL*4 ALB   ![i] albedo.=      REAL*4 AMODL ![i] model temperature in degrees kelvin. >      REAL*4 DTA   ![i] model delta of temperature with albedo@      REAL*4 DTI   ![i] model delta of temperature with inertia.,      REAL*4 AHR   ![i] local time in hours.,      REAL*4 ALAT  ![i] latitude in degrees.3      REAL*4 AINC  ![i] incidence angle in degrees. CC    REAL*4 INERSP Output value
C_DescriptionMC  The real function  INERSP computes single-point mars' thermal inertia fromMC  observed temperature and albedo at a single point.  If the observed albedo6C  is not reliable, the nominal albedo of .25 is used.FC  AMODL is  Viking nominal model temperature in kelvin, (i=6.5,a=.25)HC  NOTE: the 3 base thermal models originally run to interpolate to the =C  Viking nominal model were  (I=6,A=.2), (6,.3) and (8,.2). IC  The "partial derivatives" are in fact the delta temperatures of these C  3 models.C_Calls  DTICORC_Lims8	PARAMETER NUMI=10	! number of inertia correction pointsC_Hist@C	89aug11  Hugh_H_Kieffer complete rewrite of code and algorithmC_EndI	REAL*4 CORI(NUMI) /1.,2.,4.,6.,8.,10.,12.,14.,30.,55./!correction inert.0	REAL*4 DELI(NUMI)	! computed on first call only)	REAL*4 COR(NUMI)	! returned from  DTICOR	LOGICAL LFIRST /.TRUE./K      DATA EPSALB, AINCMX /.1, 85./ ! minimum albedo,  MAX. incidence angle3	DATA EPSI /.1/ 	! minimum derivative wrt inertia.,	IF (LFIRST) THEN	! initialize	  DO J=1,NUMI	    DELI(J) = CORI(J)-6.
	    ENDDO	  LFIRST = .FALSE.	ENDIFD	IF (ABS(DTI).LT.EPSI) THEN	! too close to inertia curve cross-over;'	  OUT = 6.5			! return nominal inertia
	  GOTO 8 	ENDIFMC if input albedo is unreal, or incidence angle is to low, use nominal albedo	A = ALB.	IF (A.LE.EPSALB .OR. AINC.GE.AINCMX) A=ALBMODFC find correction to model temperature for albedo, then find how much ;C temperature excess  TR remains to be assigned to inertia.	TR = TEMP 		! observed=     &	       -( AMODL 	! viking nominal model, a=.25,  I=6.5,     &		+ DTA*(A-.25)/.1	! albedo correction=     &		- DTI*.25 )	! adjust base inertia from 6.5 back to 6.:	X = 2.*TR/DTI		! del inertia without nonlinear correction*				! the 2. is del_inertia of base modelsIC get the full set of correction factors for linear interpolation to thisC   specific latitude and hour	CALL DTICOR (ALAT,AHR, COR)=C find the inertia such that  TR=DEL_I*DTDI*CORRECTION_FACTOR	XL = DELI(1)*COR(1)	DO J=2,NUMI	  XN = DELI(J)*COR(J)5	  IF (XN.GE.X) THEN	! linear interpolate in interval		F = (X-XL)/(XN-XL))	  	OUT = CORI(J-1)+F*(CORI(J)-CORI(J-1))!D		WRITE (5,*) TR,X,J,XL,XN,F,OUT		GOTO 8	  ENDIF
	  XL = XN	  ENDDO<	OUT = CORI(NUMI)	! outside correction table, use max. value,8	INERSP = OUT	! transfer result to function	RETURN	END!	SUBROUTINE DTICOR (ALAT,AHR,COR)KC_Title  DTICOR  Correction factor function for nonlinearity of derivative 'C   of temperature with thermal inertiaC_Arguments)	REAL*4 ALAT    ! [i] latitude in degrees)	REAL*4 AHR     ! [i] local time in hoursE	REAL*4 COR(10) ! [o] array of correction factors for set of inertiasC_Description =C the correction factor function for the nonlinearity of the CC partial derivative of temperature with thermal inertia  (DTDI).  1C the correction factor is defined as the ratio: (C  2/(I-6.5) * (T_I - T_6.5)/(T_8 - T_6)MC where I is the inertia of a model  and T_I is the temperature at inertia I.CC it is tabulated below as a function of hour, inertia & latitude, EC and is bi-linearly interpolated to the requested latitude and hour.FC   The data in CORFAC are based on extensive runs of  "mini-KRC", andC averaging over season.1C_Limitation  MUST compile with  /CONT=90 or more	C_Calls 0?C_History  1978  Phil_R_Christensen original  GETFUD subroutine'C	79may22  PRC  I=1.5 changed to  I=1.0-C	80apr22  PRC lats -80,-60,+60 and +80 addedC	80jul25  PRC  I=30 added@C	81mar06  PRC fixed to give correct interpolated values at i>14AC	81apr03  PRC  I=55 added . computed for -80s,-40s,0n,40n & 80n.&C			& other latitudes are interpolatedFC	83jan05  RMEHLMAN  DTICOR function for  IRTM db adapted from  GETFUDIC	89aug08  Hugh_H_Kieffer recode finding the table position and fraction <C		for lat and hour variables. return array of values for alC		inertia correction points.C_EndB	PARAMETER (NUMH=6,NUMI=10,NUML=9)	! dimension of hour,inertia,lat6	PARAMETER MAXIL=NUML-1		! max. index of last interval%C array of factors:  CORFAC(HR,I,LAT)C   hr=0,4,8,12,16,20			uniform-C   lat=-80,-60,-40,-20,0,20,40,60,80	uniform4C   i=1,2,4,6,8,10,12,14,30,55		uniform from 2 to 14:      REAL CORFAC(NUMH,NUMI,NUML) /	!(hr,inertia,latitude)C  -80S%     & 2.49,1.55,1.65,1.74,2.55,3.36,%     & 1.97,1.37,1.47,1.57,2.02,2.47,%     & 1.45,1.20,1.25,1.29,1.47,1.64,%     & 1.16,1.08,1.09,1.10,1.16,1.21,%     &  .95, .97, .97, .97, .95, .93,%     &  .82, .89, .87, .86, .81, .76,%     &  .73, .84, .80, .76, .71, .66,%     &  .65, .77, .73, .69, .62, .56,%     &  .35, .48, .44, .39, .32, .25,%     &  .18, .25, .22, .19, .15, .12,C  -60S%     & 2.43,1.83,1.57,1.32,2.01,2.69,%     & 1.94,1.63,1.46,1.28,1.70,2.11,%     & 1.43,1.32,1.25,1.18,1.34,1.50,%     & 1.14,1.11,1.09,1.07,1.12,1.16,%     &  .95, .96, .97, .98, .96, .95,%     &  .82, .85, .87, .89, .84, .79,%     &  .72, .76, .78, .81, .75, .68,%     &  .64, .68, .71, .75, .67, .59,%     &  .34, .38, .41, .44, .36, .28,%     &  .18, .22, .22, .21, .17, .13,C  -40S%     & 2.51,2.33,1.89,1.43,2.20,2.98,%     & 2.00,1.89,1.63,1.37,1.82,2.26,%     & 1.45,1.41,1.32,1.22,1.39,1.55,%     & 1.15,1.14,1.12,1.09,1.13,1.17,%     &  .95, .95, .96, .97, .95, .94,%     &  .81, .82, .84, .87, .82, .78,%     &  .71, .72, .74, .79, .73, .67,%     &  .63, .65, .68, .72, .65, .58,%     &  .33, .35, .39, .42, .35, .28,%     &  .18, .20, .22, .24, .19, .14,C  -20S%     & 2.32,2.17,1.72,1.28,1.98,2.69,%     & 1.88,1.79,1.52,1.24,1.67,2.09,%     & 1.41,1.37,1.27,1.16,1.33,1.49,%     & 1.14,1.13,1.10,1.07,1.11,1.16,%     &  .95, .96, .97, .98, .96, .95,%     &  .82, .83, .86, .89, .84, .80,%     &  .72, .74, .78, .82, .76, .69,%     &  .64, .66, .70, .75, .68, .60,%     &  .34, .36, .41, .45, .37, .29,%     &  .19, .20, .23, .25, .20, .15,C  0N%     & 2.27,2.12,1.67,1.25,1.92,2.60,%     & 1.86,1.77,1.49,1.22,1.63,2.05,%     & 1.40,1.37,1.26,1.15,1.31,1.47,%     & 1.13,1.12,1.09,1.06,1.11,1.16,%     &  .96, .96, .97, .98, .96, .95,%     &  .83, .84, .87, .90, .85, .80,%     &  .73, .74, .78, .83, .76, .69,%     &  .65, .67, .71, .76, .69, .61,%     &  .34, .37, .42, .46, .38, .29,%     &  .20, .21, .24, .27, .22, .16,C  20N%     & 2.32,2.16,1.72,1.28,1.97,2.67,%     & 1.89,1.80,1.52,1.24,1.67,2.09,%     & 1.41,1.38,1.27,1.16,1.33,1.49,%     & 1.14,1.13,1.10,1.07,1.12,1.16,%     &  .96, .96, .97, .98, .96, .95,%     &  .82, .83, .86, .89, .85, .80,%     &  .72, .74, .77, .81, .74, .68,%     &  .64, .66, .70, .74, .67, .60,%     &  .34, .36, .40, .44, .37, .29,%     &  .19, .20, .23, .25, .21, .15,C  40N%     & 2.52,2.33,1.88,1.43,2.19,2.96,%     & 2.01,1.90,1.64,1.37,1.82,2.26,%     & 1.46,1.42,1.33,1.23,1.39,1.55,%     & 1.15,1.14,1.12,1.09,1.13,1.18,%     &  .95, .95, .96, .97, .95, .94,%     &  .81, .82, .84, .86, .82, .78,%     &  .70, .72, .75, .78, .72, .66,%     &  .62, .64, .67, .70, .63, .57,%     &  .32, .34, .37, .39, .33, .27,%     &  .18, .20, .22, .23, .19, .14,C  60N%     & 2.57,2.01,1.72,1.42,2.18,2.93,%     & 2.02,1.74,1.55,1.36,1.81,2.25,%     & 1.46,1.37,1.30,1.23,1.39,1.55,%     & 1.15,1.13,1.11,1.09,1.14,1.18,%     &  .95, .96, .96, .97, .95, .94,%     &  .81, .83, .85, .87, .83, .78,%     &  .70, .74, .76, .78, .72, .66,%     &  .62, .66, .68, .71, .64, .57,%     &  .32, .36, .38, .40, .33, .25,%     &  .17, .21, .21, .20, .17, .13,C  80N%     & 2.69,1.75,1.82,1.88,2.83,3.78,%     & 2.10,1.52,1.60,1.67,2.20,2.72,%     & 1.50,1.28,1.31,1.33,1.54,1.74,%     & 1.17,1.12,1.11,1.11,1.18,1.25,%     &  .94, .96, .96, .96, .94, .92,%     &  .82, .88, .85, .83, .80, .77,%     &  .71, .80, .77, .73, .68, .63,%     &  .63, .72, .69, .66, .60, .53,%     &  .33, .43, .39, .35, .29, .23,%     &  .17, .22, .20, .18, .15, .12/C      DATA ALATD,AHRD,ALMIN/     &       20.,  4.,-80./D     DATA IOUT /5//C find table interval and fraction for latitude>	FRACL = (ALAT-ALMIN)/ALATD +1.	! table position as real index 	ILAT = FRACL			! and as integer.	IF (ILAT.LT.1) THEN		!   off low end of table	  ILAT = 1
	  FRACL = 0.6	ELSEIF (ILAT.GT.MAXIL) THEN	!   off high end of table	  ILAT = MAXIL
	  FRACL = 1.	ELSE				!   interior to table4	  FRACL = FRACL-ILAT		! get as fraction of interval	ENDIF	JLAT = ILAT+1+C find table interval and fraction for hour4	FRACH = AHR/AHRD +1.	! table position as real index	IHR = FRACH			! and as integer-	IF (IHR.LT.1) THEN		!   off low end of table
	  IHR = 1
	  FRACH = 0.4	ELSEIF (IHR.GT.NUMH) THEN	!   off high end of table)	  IHR = NUMH			!   hour can wrap around.
	  FRACH = 1.	ELSE				!   interior to table3	  FRACH = FRACH-IHR		! get as fraction of interval	ENDIF	JHR = IHR+1,	IF (JHR.GT.NUMH) JHR = 1	! wrap hour around=D	write (iout,'(i5,f6.3,2i5,f6.3)') ilat,fracl, ihr,jhr,frachC do 2-way linear interpolation	DO J=1,NUMI	  F111=CORFAC(IHR,J,ILAT)	  F112=CORFAC(IHR,J,JLAT)	  F211=CORFAC(JHR,J,ILAT)	  F212=CORFAC(JHR,J,JLAT)	  A1=(F112-F111)*FRACL+F111	  B1=(F212-F211)*FRACL+F211	  COR(J)=((B1-A1)*FRACH)+A1	  ENDDO9D     write (iout,'(1x,6f7.3)') f111,f112,f211,f212,a1,b1      RETURN	      END