0	INTEGER*2 FUNCTION XXFVAL (KFUN,IFUN,IA,NLINES)AC_Titl  XXFVAL  XG system function argument setup and evaluation.	IMPLICIT INTEGER*2 (M)C_Args?	INTEGER KFUN    	![I] The predefined function to be performed.A	INTEGER*2 IFUN(10)      ![I] The index to the database variable.D	INTEGER*2 IA(NLINES,1)  ![I] Contains requested database variables./	INTEGER NLINES		![I] Number of lines per page.C_DescMC XXFVAL sets up the arguments for any specialized user application which theKC user may wish to add to XGDATA.  The following steps explain how to add aC function.CC#C To add a function:CKC  A. Increment number of defined functions by 1  (NDFUN data statement and!C	 2nd dimension of  LFUN array).:C  B. Enter column numbers of arguments for new  LFUN row..C  C. Enter variable definition in  VARTAB.INP@C  D. Add a new branch to the computed go to statement of XXFVALAC  E. Insert function code at that new branch followed by return.EC     column arguments are referenced by  IA(1,IFUN(N)) or equivalentMC     where  N is argument number.  THEY are all  INTEGER*2 in storage units.JC     function code must have the form  XXFVAL = .... to evaluate a singleGC     function as an  INTEGER*2 item in storage units.  SEQUENCE headerEC     items (in  COMMON/XXSCOM/) may be used.  ANY function requiringHC     more than a few lines of code should be evaluated in a subprogram.DC  F. similarly, add a new branch to the computed go to statement ofCC     the XXFARG entry, inserting initialization code: requests forCC     parameters, pre-computation of constants, etc., if necessary.'C  The functions currently defined are:;C  *** VIKING IRTM and MAWD database: defined functions *** 8C   1  SOLAR longitude  (ZLNG or l sub s) (seq dir item)8C   2  SOLAR colatitude  (ZCOL) sequence directory item.2C  *** VIKING irtm database: defined functions ***C   3  JULIAN date (djul)	&C   4  SINGLE point inertia (i sub sp)C   5  LAMBERT albedo (a sub l) C   6  MINNAERT albedo (a sub m)'C   7  PHASE-CORRECTED albedo (a sub g)2C  *** VIKING MAWD database: defined functions ***#C   8  MARS day (by bruce jakosky).C   9  WATER error code.C#.C_Calls  A2AN  INERSP  COS  EXP  DAYFUN  ISHFTC_Hist	82jan06  R.Mehlman  UCLAIC	85nov17  H.Kieffer add tests for real_value of result being within i*2 3C range and precalculate first 2 function integers.:C	85jan26  HHK combine  IRTM and  MAWD (functions 8 and 9):C	87oct19  HHK variable definitions ( now done by  XGVDEF)C_End	INTEGER*4 IFDSQ,IZMAG3	COMMON /XXSCOM/ MSC1(7),MDSC,MXS9(2),IFDSQ,MOET(4)5     1 ,IZMAG,MZLNG,MZCOL, MJDQ1,MJDQ2, MTFPER,MXUFBQ     2 ,MVFXX(3),MLON,MSC2(92)	INTEGER*2 IDENT(8), DAYFUN5	REAL INERSP, FACTI /100./ , AMAXIN /32000./ , AI(8) 0     1 , SCALEI(8) /80.,10000.,3*80.,800.,2*80./&     &,RMINI2/-32767./, RMAXI2/32767./<	EQUIVALENCE (AI1,AI(1)),(AI2,AI(2)),(AI3,AI(3)),(AI4,AI(4))<     1	     ,(AI5,AI(5)),(AI6,AI(6)),(AI7,AI(7)),(AI8,AI(8))	INTEGER*2 LFUN(10,9)     1 /10*0     2 ,10*0     3 ,10*0     4 ,13,-5,17,5,6,12,9,7,0,0     5 ,16,7,8*0     6 ,16,7,8,7*0     7 ,-5,3,8*0
     8 ,3,9*0     9 ,9,9*0/1	DATA NDFUN,MXNARG,NDENT, DAR80,    MINI2 , MAXI29     1    /    9,    10,    8, 2.18166E-4, -32767, 32767/!-------XXFVAL function entry./!       Convert commonly used columns to  REAL.	RIAF1 = IA(1,IFUN(1))		RIAF2 = IA(1,IFUN(2))!-------Branch to function.)	GO TO (10,20,30,40,50,60,70,80,90),KFUN	M!----- L sub s,  ZLNG (code 1) from sequence directory (constant thru orbit).10	XXFVAL=MZLNG	GOTO 99BC-----ZCOL (code 2) from sequence directory (constant thru orbit).20	XXFVAL=MZCOL	GOTO 99LC-----JULIAN DATE (code 3) from sequence directory (constant thru sequence).30	XXFVAL=MJDQ1	GOTO 99KC-----Single point thermal inertia (code 4) using PHIL CHRISTENSEN routine.GC     inertias > 320. reset to -320.  RETURNED in integer*2 hundredths.40	DO 41 I=1,8I41        AI(I) = IA(1,IFUN(I))/SCALEI(I)                                7	  T = FACTI*INERSP(AI1,AI2,AI3,AI4,AI5,AI6,AI7,AI8)+.5	  IF (T .GT. AMAXIN) T=-AMAXIN	GOTO 987C-----Lambert albedo (code 5) a sub l =  VB / cos(inc).$50	T = RIAF1 / COS(RIAF2*DAR80) + .5	GOTO 98PC-----Minnaert albedo (code 6) a sub m = vb * cos(inc)**(-k) * cos(emis)**(1-k).$60	T =RIAF1*COS(RIAF2   *DAR80)**AMK*     1	 *COS(IA(1,IFUN(3))*DAR80)**AOMK+.5	GOTO 98OC-----Phase-corrected albedo (code 7) a sub g = a sub l * (1 + a*exp(b*phase)).*70	T = RIAF1*(1.0+AALG*EXP(BALG*RIAF2))+.5	GOTO 98'C-----Mars day (code 8) (BMJ function).80	ALON = RIAF1/80.	T = DAYFUN (IFDSQ,ALON,MDSC)	GOTO 98OC---Water error code (extracted from high order byte of word 9 of MAWD record).+90	XXFVAL = ISHFT (IA(1,IFUN(1)),-8) / 5.10	GOTO 99698	IF (T.GT.RMAXI2) THEN	!Test for valid Int*2 result.          XXFVAL = MAXI2	  ELSEIF (T.LT.RMINI2) THEN            XXFVAL = MINI2	  ELSE	    XXFVAL = T	  ENDIF	99	RETURNPC==========================  XXFARG  ===========================================	ENTRY XXFARG (KFUN,IFUN,IR)NCC_Title XXFARG set Column numbers's of function arguments, initial constants.CC_Arguments(CC	INTEGER*2 KFUN		![I] Function number ?CC	INTEGER*2 IFUN(*)	![I/O] Location of the requested function."CC	INTEGER   IR		![O] Error code. -CC                                 0 = Normal4CC                                -1 = Formal error.CC_Description  CC_Hist started same as  XXFVAL.<CC 87oct19  HHK remove all the unused potential flexibility.CC_End (	IR = 0				      !Set for normal return.H	IF (KFUN.LE.0.OR.KFUN.GT.NDFUN) THEN  !Formal error in input arguments.7	   IR=-1	                      !Set error return code.
	   GOTO 9
        ENDIF	DO  I=1,MXNARG*	   IF (IFUN(I).EQ.0) IFUN(I)=LFUN(I,KFUN)	ENDDO&C------ Initialize physical constants.!	AMK=-.95	!MINNEART ALBEDO, k=.95		AOMK=.05	&	AALG=.000146	!PHASE-CORRECTED ALBEDO.	BALG=.075/80.9	RETURN	END