65 C ADJUST S TO ALLOW FOR FACT THAT THMAX IS I DEGREES 66 S = S*PI/180.0 67 WRITE (5,95) RHO,S 68 95 FORMAT (1HO. 5X, SHRHO =, 1PE13.4,5X, 10HINIEGRAL = , 1 PE18.4/) 69 IF (I.GT. 1000) GO TO 100 70 ARHO (I) = RHO*10.OE+03 71 ARINT (I) = S 72 100 CONTINUE 73 IF (PI.OT .EQ. 0.0) GO TO 120 74 CALL GRAF 75 120 IF (ITYPE NE. 4) GO TO 5 76 C RHPEAT FOR SOUARE MIRROR ON DIAGONAL 77 ITYPE = 3 78 GO TO 14 79 ENC O ERRORS COYPILATION COMPLETE PAGE 1 SOLAR 4/12/75 1 SUBROUTINE TRAP (FORN.A.B.NMN.S) 2C C SUBROUTINE TRAP COMPUTES AN INTEGRAL USIUG TRAPEZOIOAL RUIE 4 C s C FUN = FUMCTION TO BE INTEGRATEO 6 C A = LOWER LIMIT OF INTEGRATION 7 C B = UPPER LIMIT OF INTEGRATION 8 C HMN = MUMBER OF STEPS USED IN INTEGRATION 9 C S = VALUE OF INTEGRAL 10 C 11 U = NMN 12 FN = N 13 H = (B-A) /EN 14 SI = 0.0 15 IF (A. NE. 0.0) SI = 0.5*FON (A) 16 N1=N 17. DO 20 I 1.N1,1 18 Y1 = FUN(A + FLONT(I)*H) 19 SI = S1+Y1 20 20 CONTINUE 21 S = (SI-0.5* X 1)*R 22 RETURN 23 END O ERRORS COMPILATION COMPLETE CS 1.SOLAR 4/12/75 1 FWNCTION FUNC (T) 2 C EONCTION FUNC EVALUATES THE FUNCTION INTEGRATED IN SOLAR 3C 4 COMMON / FCOM / Q.ALPHA,D,CAPR, RHO 5 COMMON / PCOM / PI,PIO2, PRNT, ITYPE. SINT2 6 COMMON / QCOM / SINT 7 COMMON / TCOM / TMETA2, THETA4 8 TH = T*PI/150.0 9 TH2 = 2.0*TH 19 SINT = SIM(TH) 11 RSINT = CAPP*SINT 12 RCOST = CAPR*COS(TH) 13 SINZT = SIN (TH2) 14 COS2T = COS (TH2) 15 TANZT = TAN (TH2) 16 RCOSZT = CAPR * COSZT 17 D = D*CAPR 18 R = BSINT - (RCOST - D) * TANZT 19 x = (RCOST - D) / COSZT 20 A = X*ALPHA 21 B = A/COS2T 22 C CHECK WHETHER Y SHOULD BE COMPUTED 23 C = ABS(R) - ABS(B) 24 IF IF (C .GT RHO) GO TO 68 25 ~ C COMPUTE TERMZA FOR Y CALCULATION 26 DEN = D*B 27 TERMI = -A*A*R/DEN 28 TERMZA = DEN*(RHO*RHO-A*A) + A*A*R*R 29 IF (TERHZA - LT- 0.0) GO TO 67 30 C COMPUTE Y1, Y2, PHI1 AND PHI2 31 TERM2 = B*SQRT(TERMZA) / OEN 32 Y1 = TERM1 + TERM2 33 Y2 = TERM1 - TERM2 34 IE (ABS (Y1) .LE. RHO) GO TO SO 35 PHI1 = 0.0 36 GO TO 60 37 50 PNI1 = ARCOS (Y1/RHO) 38 IF (PHI).OT.PIO2) PHI1 = PI-PHI1 39 60 IS (ABS(Y2). LE. RHO) GO TO 65 40 PHI2 = 0.0 41 IF (PHI1 . EQ. O.O .AND. PHI2 . Eq. 0.01 GO TO 67 42 GO TO 70 43 65 PHI2 = ARCOS (Y2/RHO) 44 IF (PHI2 .GT. PIO2) PRI2 = PI-PHI2 45 GO TO @O 46 6? IF (C .LT. -RHQ) GO TO 69 47 68 PHI1 = 0.0 48 PH1 = 0.0 49 GO TO 70 50 G9 PRII = PIO2 51 PHI2 = PIO2 52 70 CONTINUE 53 IF (T . LE.THETAZ) GO TO 75 54 GO TO (75,72,73,72). ITY@E 55 '2 CALL VLINIT (PHI1.TI) 56 CALL VLICIT (PHI2.T2) 57 GO TO 89 58 73 CALL DLINIT (PHI1.T1) PAGE 2 SOLAR 4/12/75 59 CALL DLIMIT (PHI2.T2) 60 GO TO 80 61 75 TI = 2.0*PHI1 62 T2 = 2.0*PHI2 63 80 CONTINUE 64 SIN4T = SIM (4.0*TH) 65 DI = Q*CAPR*CAPR*SIM4T* (T1+T2) / (4.0*PI*X*X*ALPHA*ALPHA) 66 IF ( PRNT EQ. 0.0) GO TO 110 67 - IF ( PRNT .NE. 1.0) GO TO 85 68 @ RPB = R+B 69 RMB = R - B WRITE (5.100) T.A.B.R.RPB. RMB 71 GO TO 110 72 85 IF (PRNT. NE. 2.0) GO TO 110 73 IF (DI . EQ.O.O) GO TO 110 74 WRITE (5,100) T.Y1,Y2, PHI1.PHI2.DI 75 100 FORMAT (1H, F10.4, 1P9E12.4) '76 110 ÇONTINUE 77 FUNC = DI 78 RETURN 79 END 9 ERRORS COMPILATION COMPLETE PAGE l SOLAB 4/12/75 1 SUBROUTINE VLIMIT (Q1, T1) 2 C SUBROUTINE VLIMIT COMPOTES INTEGRATION LIMIT FOR PHI 3 C FOR SQUARE MIRROR WITH RBO ON A VERTICAL 4 C 5 COMMON / PCOM / PI.PIO2.PRNT, ITYPE, SINTW 6 COMMON / QCOM / SINT 7 T1 = O.O 8 IF (Q1 .EQ. O.O) RETURN 9 03 = ARCOS (SINT2/SINT) 10 04 = PIO2 - 03 11 IF (Q1 . LE. 03) RETORN 12 IF (Q3 LT. Q1 .AND. ai .LT. Q4) Ti = 01-03 13 IF (04.LE. 01) T1 - 04-03 14 T1 = 2.0*T1 15 FETURN 16 END O ERRORS COMPILATION COMPLETE PAGE 1 SOLAR 4/12/75 1 SUBROUTINE DLIMIT (Q1,T1) 2 C SUBROUTINE OLIMIT COMPUTES INTEGRATION LIMIT FOR PAI 3 C FOR SQUARE MIRROR WITH RHO ON DIAGONAL 4C 5 COMMON / PCON / PI.PIO2, PRNT, ITYPE.SINT2 6 COMMON / OCOM / SINT 7 T1 = 0.0 8 IF (Q1.EO. G.O) RETURN 9 Q3 = ARCO3(SINT2/SINT) 10 013 = PI/4.0 - 03 PAGE 1 SOLAR 4/12/75 1 SUBROUTINE DLINIT (01.T1) 2 C SUBROUTINE OLIMIT COMPUTES INTEGRATION LIMIT FOR PHI 3 C FOR SQUARE MIRROR WITH RHO ON DIAGONAL 4 C 5 COMMON / PCON / PI.PIO2, PRNT. ITYPE, SINT2 6 COMMON / QCOM / SINT 7 T1 = 0.0 8 IF (01 .EQ. 0.0) RETURN 9 03 = ARCOS (SINT2/SINT) 10 013 = PI/4.0-03 11 IF (01 . LE. 013) T1 = Q1 12 IF (013 .LT. 01 .AND. 01 .LT. (PIO2-Q13) ; TI =Q13 13 IF ((PIO2-013) .LE. OI . AND. OI .LE. PIO2) TI-Q13+Q1-PIO2-Q13 14 T1 = 2.0*T1 15 RETURN 16 DND O ERRORS COMPILATION COMPLETS PAGE 1 SOLAR 4/12/75 1 - FUNCTION TAN(Xt 2 TAN = SIN(X)/COS(X) 3 RETURN END O ERRORS COMPILATION COMPLETS PAGE l SOLAR 4/12/75 1 FUMCTION ARCOS(X) 2 PI = 3.14159265 3 IF (X.EQ. 0.0) GO TO 50 4 ACOS = ATAN (SORT(1.0-X*X)/2I 5 IF (ACOS. LT. 0.0) ACOS = FI+ACOS 6 ARCOS=ACOS 7 RETURN 8 59 ARCOS = PI/2.0 9 RETURN 10 END O ERRORS COMPILATION COMPLETE PAGE 1 SOLAR 4/12/75 1 FUNCTION ARSIN (X) 2 PI = 3,14159265 3 ARSIN = ATAN (X/SORT (1.0-X*X)) 4 RETURN 5 END O ERRORS COMPILATION COM@LBTE PACB 1 SOLAR 4/12/75 1 SUBROUTINE GRAF 2 RETURN 3 END 0 ERRORS COMPILATION COMPLETE **