SUBROUTINE OAC (GAM, MY, DENTR, D, AJ , S , T , V , W , K )
IMPLICIT DOUBLE PRECISION (A–Z)
INTEGER GAM, I , J , J J
DIMENSION MY(GAM) , D(GAM) , AJ (8, GAM)
DIMENSION RHO( 120 ) , PSI ( 120) , KAP(120 ) , RHOT(120) , AR1(120) , AR2(120),
& AR3 (120) , NI( 120) ,K( 120) ,DFDR( 1 20) , FI( 120) ,NM( 120) ,MOD ( 120),
& COSTH( 120) , COSTHM( 120) ,RHOO( 120) ,PS10( 120) ,KAP0( 120) ,
& SM( 120) , TM( 120) , VM( 120) , WM( 120) ,S( 120) ,T( 120) ,V( 120) ,W( 120)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C THIS SUBROUTINE COMPUTES THE ABERRATION COEFFICIENTS TO THE 15.TH
C ORDER FOR A ROTATIONALLY SYMMETRIC SYSTEM WITH /GAM/ SURFACES.
C
C EXPLANATION TO INPUT VARIABLES :
C GAM : NUMBER OF SURFACES
C MY(GAM) : RELATIVE REFRACTIVE INDICES
C DENTR : AX. DIST. FROM ENTRANCE PUPIL TO 1. SURF.
C D(GAM) : AXIAL SURFACE DISTANCES
C AJ ( 8 , GAM) : SURFACE EXPANSION COEFFICIENTS
C
C EXPLANATION TO OUTPUT VARIABLES :
C S( 120 ) : EXPANSION COEFF. S OF ABERR. FUNCTION S.
C T( 120 ) : EXPANSION COEFF. S OF ABERR. FUNCTION T.
C V( 120 ) : EXPANSION COEFF. S OF ABERR. FUNCTION V.
C W( 120) : EXPANSION COEFF. S OF ABERR. FUNCTION W.
C K ( 120) : EXPANSION COEFF. S OF OPTICAL PATH LENGTH K.
C
C EXTERNAL SUBROUTINES : SUMM, PROD, CNST, NORM, NPOW, COPY
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C INITIALIZATION OF ARRAYS AND CONSTANTS
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
CALL NORM (NM)
CALL CNST (0. D0 , S, RHO)
CALL COPY (RHO , PSI)
CALL COPY (RHO , KAP)
CALL COPY (RHO , K)
CALL COPY (K , RHOO)
CALL COPY (K , PSIO)
CALL COPY (K , KAPO)
RHOO (2) = 1 . D0
PSI0 (3) = 1 . D0
KAP0 (4) = 1 . D0
CALL NORM(S)
CALL COPY(K, T)
CALL COPY(K, V)
CALL NORM(W)
RHO(2) = 1.D0
RHO(3) = DENTR*DENTR
RHO(4 ) = DENTR+DENTR
PSI(3) = 1 . D0
KAP(3) = DENTR
KAP(4) = 1.D0
T(1) = DENTR
MYPROD = 1.D0
CALL NORM(AR1)
AR1(3 ) = 1.D0
CALL NPOW(AR1,AR2,0.5D0)
CALL CNST (DENTR,AR2,K)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C RAYTRACING THROUGH THE /GAM/ SURFACES. I-LOOP.
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
D0 200 I = 1, GAM
CALL COPY(RHO, RHOT )
MYPROD = MYPROD/MY(I)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C ITERATIVE DETERMINATION OF RAY–INTERSECTION WITH SURFACE. J–LOOP.
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
D0 100 J = 1 , 7
CALL CNST(AJ(7 , I), RHOT, FI)
D0 50 JJ = 6, 1, −1
CALL CNST (AJ(JJ, I) , NM , AR1 )
CALL SUMM(FI,AR1,AR2)
CALL PROD(AR2,RHOT,FI)
50 CONTINUE
CALL PROD(FI,FI,AR1)
CALL PR0D(AR1,PSI,AR2)
CALL CNST(2.D0,KAP,AR1)
CALL PROD(ART,FI,AR3)
CALL SUMM(AR2,AR3.AR1)
CALL SUMM(RHO,AR1,RHOT)
C - - - - - - - - - - - - - - - - - - - - - -
C END OF ITERATIVE J-LOOP.
C - - - - - - - - - - - - - - - - - - - - - -
100 CONTINUE
CALL CNST(8.D0*AJ(3,I),NM,DFDR)
D0 70 JJ = 7,1,−1 CALL PROD(DFDR,RHOT,AR1)
CALL CNST(JJ*AJ(JJ,I),NM,AR2)
CALL SUMM(AR1,AR2,DFDR)
70 CONTINUE
CALL PROD(DFDR,DFDR,AR1)
CALL CNST(4.D0,RHOT,AR2)
CALL PR0D(AR1,AR2,AR3)
CALL SUMM(NM,AR3.M0D)
CALL NPOW(MOD,RHOT,−0.5D0)
CALL SUMM(NM,PSI,AR1)
CALL NPOW(AR1,NI,−0.5D0)
CALL CNST(2.D3,DFDR,MOD)
CALL PROD(FI,PSI,AR1)
CALL SUMM(AR1,KAP,AR3)
CALL PROD(AR3,MOD,AR1)
CALL CNST(−1,D0,AR1,AR2)
CALL SUMM(NM,AR2,AR1)
CALL PROD(AR1,NI,AR2)
CALL PROD(AR2,RHOT,COSTH)
CALL PROD(COSTH,COSTH,AR1)
CALL CNST(MY(I)*MY(I),AR1,AR2)
CALL CNST(1.D0-MY(I)*MY(I),NM,AR1) CALL SUMMUR1 , AR2.AR3)
CALL NPOW(AR3,AR1,0.5D0)
CALL CNST(-MY(I),COSTH,AR2)
CALL SUMM(AR1,AR2,COSTHM)
CALL PROD(COSTHM,RHOT,AR1)
CALL CNST(MY(I),NI,AR2)
CALL SUMM(AR1,AR2,AR3)
CALL NPOW(AR3,COSTH,−1.D0)
CALL PROD(COSTH,COSTH,AR1)
CALL CNST(−1,D0,NM,DFDR)
CALL SUMM(AR1,DFDR,PSI)
CALL PROD(NI,COSTH,AR1)
CALL NPOW(AR1,AR2,−1.D0)
CALL CNST(MY(I),AR2,AR1)
CALL SUMM(AR1,DFDR,AR3)
CALL PR0D(AR3,FI,AR1)
CALL CNST(D(I),NM,DFDR)
CALL SUMM(AR1,DFDR,AR3)
CALL PR0D(AR3,COSTH,AR1)
CALL CNST(MYPROD,AR1,AR2)
CALL SUMM(K,AR2.AR1)
CALL COPY(AR1,K)
CALL PROD(RHOT,COSTHM,AR1)
CALL PR0D(AR1,MOD,AR2)
CALL PR0D(AR2,COSTH,AR3)
CALL CNST(−1,D0,FI,AR1)
CALL SUMM(AR1,DFDR,MOD)
CALL CNST(MY(I),NI,AR1)
CALL PR0D(AR1,COSTH,RHOT)
CALL CNST(−1.D0,AR3.AR1)
CALL PR0DCAR1,FI,AR2)
CALL SUMM(AR2,RHOT,COSTHM) CALL PROD(AR1,S,AR2)
CALL PROD(COSTHM,V,AR3) CALL SUMM(AR2,AR3.VM)
CALL PROD(AR1,T,AR2)
CALL PROD(COSTHM,W,AR3) CALL SUMM(AR2,AR3,WM)
CALL PROD(FI,V,AR2)
CALL PROD(MOD,VM,SM)
CALL SUMM(AR2,SM,AR3)
CALL SUMM(AR3,S,SM)
CALL PR0D(FI,W,AR2)
CALL PROD(MOD,WM,TM)
CALL SUMM(AR2,TM,AR3)
CALL SUMM(AR3,T,TM)
CALL COPY(SM,S)
CALL COPY(TM,T)
CALL COPY(VM,V)
CALL COPY(WM,W)
CALL PROD(S,S,AR1)
CALL PROD(AR1,RHOO,AR2) CALL PROD(T,T,AR1)
CALL PR0D(AR1,PSIO,AR3) CALL SUMM(AR2,AR3,AR1)
CALL PROD(S,T,AR2)
CALL PR0D(AR2,KAP0,AR3) CALL CNST(2.D0,AR3,AR2) CALL SUMMUR1, AR2,RHO)
CALL PROD(S,V,AR1)
CALL PROD(AR1,RHOO,AR2) CALL PROD(T,W,AR1)
CALL PR0D(AR1,PSIO,AR3) CALL SUMM(AR2,AR3,AR1)
CALL PROD(S,W,AR2)
CALL PROD(T,V,RHOT)
CALL SUMM(RHOT,AR2.AR3) CALL PROD(AR3,KAPO,AR2) CALL SUMM(AR1,AR2,KAP)
C - - - - - - - - - - - -
C END OF I-LOOP.
C - - - - - - - - - - - -
200 CONTINUE
RETURN
END
|