FUNCTION SFUNC(ISD) C C JRM 2/26/93 C CALCULATE F HERE C IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*78 ALPHA COMMON /IN/ ND,NF,NP,MAXD,G,EPS,A(10),NOUT,NS(10),ALPHA COMMON /SECDER/ P1,P2,DEL,XX C C THE FUNCTION DEFINITION GOES HERE C IT IS OF THE FORM SFUNC = F(A,XX) C FOR EXAMPLE, A LINEAR CASE WOULD BE C SFUNC = A(1) + A(2)*XX C C HERE, WE PROVIDE TEN FUNCTIONS, SELECTED BY VALUE OF NF C C NF=1: POLYNOMIAL, maximum degree (NP-1) C NF=2: SUM OF EXPONENTIALS, EXP(-AX) FORM C NF=3: SUM OF EXPONENTIALS, EXP(-X/A) FORM C NF=4: RATIONAL FRACTION, MAX DEGREE 5 FOR NUM. AND 5 FOR DEN.; C USE NP > 5 AND CHOOSE PROPER NOUT PARAMETER VALUES C NF=5: CONSTANT PLUS POWER LAW, maximum NP = 3 C NF=6: LN-TRANSFORM OF Y DATA, maximum NP = 10 C NF=7,8,9, or 10: THE USER MAY ADD HIS OWN FUNCTION DEFINITION(S) C HERE AND IN NF=8,9, AND 10; MAXIMUM NP = 10 C C WRITE(*,*) 111,A(1),A(2),A(3) GOTO(100,200,300,400,500,600,700,800,900,1000) NF C 100 CONTINUE IF(NP.GT.10) PAUSE 'NP MUST BE < 11' SFUNC = A(NP) DO 50 IP = NP-1,1,-1 SFUNC = SFUNC*XX + A(IP) 50 CONTINUE C WRITE(*,*) 3333,I,SFUNC GOTO 1100 C 200 CONTINUE SFUNC = 0.D0 DO 264 IE = 1,NP IMD = MOD(IE,2) IF(IMD.EQ.0) THEN EARG = XX*A(IE) IF(EARG.GT.200.OR.EARG.LT.-200) THEN WRITE(*,*) IE,EARG WRITE(*,321) 321 FORMAT(5X,'PARAMETER OUT OF RANGE; 1 RESTART PROGRAM WITH BETTER CHOICES'/) STOP ENDIF SFUNC = SFUNC + A(IE-1)*DEXP(-EARG) ENDIF 264 CONTINUE C GOTO 1100 C 300 CONTINUE SFUNC = 0.D0 DO 64 IE = 1,NP IMD = MOD(IE,2) IF(IMD.EQ.0) THEN EARG = XX/A(IE) IF(EARG.GT.200.OR.EARG.LT.-200) THEN WRITE(*,*) IE,EARG WRITE(*,321) STOP ENDIF SFUNC = SFUNC + A(IE-1)*DEXP(-EARG) ENDIF 64 CONTINUE C GOTO 1100 C 400 CONTINUE SFU = A(5) DO 55 IP = 4,2,-1 SFU = SFU*XX + A(IP) 55 CONTINUE SFU = 1.D0 + SFU SFUNC = A(NP) DO 65 IP = NP-1,6,-1 SFUNC = SFUNC*XX + A(IP) 65 CONTINUE SFUNC = SFU/(SFUNC + 1.D-35) C GOTO 1100 C 500 CONTINUE IF(NP.GT.3) PAUSE 'NP MUST BE < 4' SFUNC = A(1) + A(2)*(XX**A(3)) GOTO 1100 C 600 GOTO 1100 C Operations for this choice appear in the main program C 700 CONTINUE C THERMAL ACTIVATION FIT FUNCTION: A(3) IN e.v. EARG = 1.16045D4*A(3)/XX IF(DABS(EARG).GT.1.5D0) THEN WRITE(*,*) 9999,A(3),XX,EARG EARG = 1 ENDIF IF(EARG.GT.200.OR.EARG.LT.-200) THEN WRITE(*,*) IE,EARG WRITE(*,321) STOP ENDIF SFUNC = A(1)*(XX**A(2))*DEXP(-EARG) GOTO 1100 C 800 CONTINUE C DUMMY FUNCTION: ADD YOUR FITTING FUNCTION HERE WRITE(*,*) 'BAD FUNCTION CHOICE' C GOTO 1100 C 900 CONTINUE C DUMMY FUNCTION: ADD YOUR FITTING FUNCTION HERE WRITE(*,*) 'BAD FUNCTION CHOICE' C GOTO 1100 C 1000 CONTINUE C DUMMY FUNCTION: ADD YOUR FITTING FUNCTION HERE WRITE(*,*) 'BAD FUNCTION CHOICE' C 1100 CONTINUE RETURN END