📄 gomsphere_f.htm
字号:
REAL*8 TABIM( NWL ), TABIMT( NWLT, 4 ), TABRE( NWL ),
& TABRET( NWLT, 4), TEMREF(4), WL( NWL ), WLT( NWLT )
COMMON / ICEREF / WL, WLT, TABRE, TABRET, TABIM, TABIMT, TEMREF
DATA PASS1 / .True. /
WAVLEN = WAVMET*1.0d+6
IF( PASS1 ) THEN
PASS1 = .False.
c ** Superficially test if main table messed up
IF( NWL.LT.100 ) CALL ERRMSG('refice--NWL value bad',.True.)
IF( WL(1).GT.0.045 ) CALL ERRMSG('refice--WL(1) bad',.True.)
IF( WL(NWL).LT.166.) CALL ERRMSG('refice--WL(NWL) bad',.True.)
DO 1 I = 1, NWL
IF( WL(I).LE.0.0 .OR. TABRE(I).LE.0.5 .OR. TABRE(I).GT.2.0
& .OR. TABIM(I).LT.0.0 .OR. TABIM(I).GT.10.0 ) THEN
WRITE( MESSAG, '(A,I5,A)' ) 'refice--table value ', I,
& ' out of bounds '
CALL ERRMSG( MESSAG, .True. )
END IF
IF( I.GT.1 .AND. WL(I).LE.WL(I-1) ) THEN
WRITE( MESSAG, '(A,I5,A)' ) 'refice--table WL(', I,
& ') not increasing '
CALL ERRMSG( MESSAG, .True. )
END IF
1 CONTINUE
END IF
IF( WAVLEN.LT.WL(1) .OR. WAVLEN.GT.WLT(NWLT) ) THEN
CALL ERRMSG('refice--wavelength outside table boundaries',
& .False.)
ref_ice = (0.,0.)
RETURN
END IF
IF( WAVLEN.LE.167.) THEN
c ** Wavelength between 0.045 and 167
c ** microns. No temperature dependence
DO 10 I = 2, NWL
IF( WAVLEN.LE.WL(I)) GO TO 20
10 CONTINUE
20 CONTINUE
FRAC = LOG( WAVLEN / WL(I-1) ) /
& LOG( WL(I) / WL(I-1) )
MRE = TABRE(I-1) + FRAC * ( TABRE(I) - TABRE(I-1) )
MIM = TABIM(I-1) * ( TABIM(I) / TABIM(I-1) )**FRAC
ELSE
c ** Wavelength greater than 167 microns
c ** (temperature-dependent case)
c write (*,*)'temp=',TEMP
IF( TEMP.LT.TEMREF(4) .OR. TEMP.GT.TEMREF(1) ) THEN
CALL ERRMSG('refice--temperature outside table boundaries',
& .False.)
ref_ice = (0.,0.)
RETURN
END IF
c ** Find position in temperature array
DO 30 L = 2, 4
IF( TEMP.GE.TEMREF(L) ) GO TO 40
30 CONTINUE
c ** Find position in wavelength array
40 CONTINUE
DO 50 I = 2, NWLT
IF( WAVLEN.LE.WLT(I) ) GO TO 60
50 CONTINUE
60 CONTINUE
FRAC = LOG( WAVLEN / WLT(I-1) ) /
& LOG( WLT(I) / WLT(I-1) )
YLO = TABRET(I-1, L) +
& FRAC*( TABRET(I, L) - TABRET(I-1, L) )
YHI = TABRET( I-1, L-1) +
& FRAC*( TABRET(I, L-1) - TABRET(I-1, L-1) )
MRE = YLO + ( YHI - YLO) * ( TEMP - TEMREF(L) ) /
& ( TEMREF(L-1) - TEMREF(L) )
YLO = LOG( TABIMT(I-1, L)) +
& FRAC*LOG( TABIMT(I, L) / TABIMT(I-1, L) )
YHI = LOG( TABIMT(I-1, L-1) ) +
& FRAC*LOG( TABIMT(I, L-1) / TABIMT(I-1, L-1) )
MIM = EXP( YLO + (YHI - YLO) * (TEMP - TEMREF(L)) /
& (TEMREF(L-1) - TEMREF(L)) )
END IF
ref_ice = CMPLX( MRE, MIM)
END
BLOCK DATA ICECON
c Ice-refractive-index vs. wavelength table for subroutine refice
IMPLICIT NONE
c .. Parameters ..
INTEGER NWL, NWLT
PARAMETER ( NWL = 574, NWLT = 62 )
c ..
c .. Local Scalars ..
INTEGER I
c ..
REAL*8 TABIM(NWL), TABIMT( NWLT, 4 ), TABRE(NWL),
& TABRET( NWLT, 4 ), TEMREF(4), WL(NWL), WLT(NWLT)
COMMON / ICEREF / WL, WLT, TABRE, TABRET, TABIM, TABIMT, TEMREF
c WL, WLT wavelengths (microns) for temperature-
c independent and temperature-dependent
c regimes, respectively
c TABRE, TABRET real refractive indices for temperature-
c independent and temperature-dependent
c regimes, respectively
c TABIM, TABIMT imaginary refractive indices for temperature-
c independent and temperature-dependent
c regimes, respectively
c TEMREF reference temperatures (-1,-5,-20,-60 deg C)
c for TABRET,TABIMT
DATA TEMREF / 272.16, 268.16, 253.16, 213.16 /
DATA ( WL( I ), TABRE( I ), TABIM( I ), I = 1, 10 ) /
& 4.43000E-02, 8.34410E-01, 1.64000E-01,
& 4.51000E-02, 8.36760E-01, 1.73000E-01,
& 4.59000E-02, 8.37290E-01, 1.83000E-01,
& 4.68000E-02, 8.37710E-01, 1.95000E-01,
& 4.77000E-02, 8.38270E-01, 2.08000E-01,
& 4.86000E-02, 8.40380E-01, 2.23000E-01,
& 4.96000E-02, 8.47190E-01, 2.40000E-01,
& 5.06000E-02, 8.55220E-01, 2.50000E-01,
& 5.17000E-02, 8.60470E-01, 2.59000E-01,
& 5.28000E-02, 8.62480E-01, 2.68000E-01 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 11, 20 ) /
& 5.39000E-02, 8.61570E-01, 2.79000E-01,
& 5.51000E-02, 8.60930E-01, 2.97000E-01,
& 5.64000E-02, 8.64190E-01, 3.19000E-01,
& 5.77000E-02, 8.69160E-01, 3.40000E-01,
& 5.90000E-02, 8.77640E-01, 3.66000E-01,
& 6.05000E-02, 8.92960E-01, 3.92000E-01,
& 6.20000E-02, 9.10410E-01, 4.16000E-01,
& 6.36000E-02, 9.30890E-01, 4.40000E-01,
& 6.53000E-02, 9.53730E-01, 4.64000E-01,
& 6.70000E-02, 9.81880E-01, 4.92000E-01 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 21, 30 ) /
& 6.89000E-02, 1.02334, 5.17000E-01,
& 7.08000E-02, 1.06735, 5.28000E-01,
& 7.29000E-02, 1.11197, 5.33000E-01,
& 7.38000E-02, 1.13134, 5.34000E-01,
& 7.51000E-02, 1.15747, 5.31000E-01,
& 7.75000E-02, 1.20045, 5.24000E-01,
& 8.00000E-02, 1.23840, 5.10000E-01,
& 8.27000E-02, 1.27325, 5.00000E-01,
& 8.55000E-02, 1.32157, 4.99000E-01,
& 8.86000E-02, 1.38958, 4.68000E-01 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 31, 40 ) /
& 9.18000E-02, 1.41644, 3.80000E-01,
& 9.30000E-02, 1.40906, 3.60000E-01,
& 9.54000E-02, 1.40063, 3.39000E-01,
& 9.92000E-02, 1.40169, 3.18000E-01,
& 1.03300E-01, 1.40934, 2.91000E-01,
& 1.07800E-01, 1.40221, 2.51000E-01,
& 1.10000E-01, 1.39240, 2.44000E-01,
& 1.12700E-01, 1.38424, 2.39000E-01,
& 1.14000E-01, 1.38075, 2.39000E-01,
& 1.18100E-01, 1.38186, 2.44000E-01 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 41, 50 ) /
& 1.21000E-01, 1.39634, 2.47000E-01,
& 1.24000E-01, 1.40918, 2.24000E-01,
& 1.27200E-01, 1.40256, 1.95000E-01,
& 1.29500E-01, 1.38013, 1.74000E-01,
& 1.30500E-01, 1.36303, 1.72000E-01,
& 1.31900E-01, 1.34144, 1.80000E-01,
& 1.33300E-01, 1.32377, 1.94000E-01,
& 1.34800E-01, 1.30605, 2.13000E-01,
& 1.36200E-01, 1.29054, 2.43000E-01,
& 1.37000E-01, 1.28890, 2.71000E-01 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 51, 60 ) /
& 1.37800E-01, 1.28931, 2.89000E-01,
& 1.38700E-01, 1.30190, 3.34000E-01,
& 1.39300E-01, 1.32025, 3.44000E-01,
& 1.40900E-01, 1.36302, 3.82000E-01,
& 1.42500E-01, 1.41872, 4.01000E-01,
& 1.43500E-01, 1.45834, 4.06500E-01,
& 1.44200E-01, 1.49028, 4.05000E-01,
& 1.45000E-01, 1.52128, 3.89000E-01,
& 1.45900E-01, 1.55376, 3.77000E-01,
& 1.46800E-01, 1.57782, 3.45000E-01 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 61, 70 ) /
& 1.47600E-01, 1.59636, 3.32000E-01,
& 1.48000E-01, 1.60652, 3.15000E-01,
& 1.48500E-01, 1.61172, 2.98000E-01,
& 1.49400E-01, 1.61919, 2.74000E-01,
& 1.51200E-01, 1.62522, 2.28000E-01,
& 1.53100E-01, 1.63404, 1.98000E-01,
& 1.54000E-01, 1.63689, 1.72000E-01,
& 1.55000E-01, 1.63833, 1.56000E-01,
& 1.56900E-01, 1.63720, 1.10000E-01,
& 1.58000E-01, 1.63233, 8.30000E-02 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 71, 80 ) /
& 1.58900E-01, 1.62222, 5.80000E-02,
& 1.61000E-01, 1.58270, 2.20000E-02,
& 1.62700E-01, 1.55360, 1.00000E-02,
& 1.65200E-01, 1.52040, 3.00000E-03,
& 1.67500E-01, 1.49840, 1.00000E-03,
& 1.70000E-01, 1.48010, 3.00000E-04,
& 1.72300E-01, 1.46710, 1.00000E-04,
& 1.74800E-01, 1.45510, 3.00000E-05,
& 1.77100E-01, 1.44580, 1.00000E-05,
& 1.79600E-01, 1.43700, 3.00000E-06 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 81, 90 ) /
& 1.81000E-01, 1.43250, 1.56700E-06,
& 1.82000E-01, 1.42950, 9.32500E-07,
& 1.83000E-01, 1.42680, 5.39700E-07,
& 1.84000E-01, 1.42410, 3.12200E-07,
& 1.85000E-01, 1.42140, 1.72500E-07,
& 1.88000E-01, 1.41430, 1.00000E-07,
& 1.90000E-01, 1.41010, 8.20000E-08,
& 1.95000E-01, 1.40070, 5.10000E-08,
& 2.00000E-01, 1.39360, 3.81000E-08,
& 2.05000E-01, 1.38670, 3.05000E-08 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 91, 100 ) /
& 2.10000E-01, 1.38000, 2.51000E-08,
& 2.15000E-01, 1.37610, 2.18000E-08,
& 2.20000E-01, 1.37230, 1.98000E-08,
& 2.25000E-01, 1.36850, 1.78000E-08,
& 2.30000E-01, 1.36480, 1.62000E-08,
& 2.35000E-01, 1.36120, 1.50000E-08,
& 2.40000E-01, 1.35770, 1.43000E-08,
& 2.45000E-01, 1.35420, 1.37000E-08,
& 2.50000E-01, 1.35080, 1.33000E-08,
& 2.60000E-01, 1.34720, 1.32000E-08 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 101, 110 ) /
& 2.70000E-01, 1.34370, 1.30000E-08,
& 2.80000E-01, 1.34030, 1.26000E-08,
& 2.90000E-01, 1.33710, 1.18000E-08,
& 3.00000E-01, 1.33390, 1.10000E-08,
& 3.10000E-01, 1.33200, 9.28000E-09,
& 3.20000E-01, 1.33020, 8.25000E-09,
& 3.30000E-01, 1.32840, 7.65000E-09,
& 3.40000E-01, 1.32660, 7.00000E-09,
& 3.50000E-01, 1.32490, 6.15000E-09,
& 3.60000E-01, 1.32380, 5.10000E-09 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 111, 120 ) /
& 3.70000E-01, 1.32260, 4.13000E-09,
& 3.80000E-01, 1.32150, 3.43000E-09,
& 3.90000E-01, 1.32040, 3.12000E-09,
& 4.00000E-01, 1.31940, 2.82000E-09,
& 4.10000E-01, 1.31850, 2.51000E-09,
& 4.20000E-01, 1.31775, 2.26000E-09,
& 4.30000E-01, 1.31702, 2.08000E-09,
& 4.40000E-01, 1.31633, 1.91000E-09,
& 4.50000E-01, 1.31569, 1.54000E-09,
& 4.60000E-01, 1.31509, 1.53000E-09 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 121, 130 ) /
& 4.70000E-01, 1.31452, 1.55000E-09,
& 4.80000E-01, 1.31399, 1.64000E-09,
& 4.90000E-01, 1.31349, 1.78000E-09,
& 5.00000E-01, 1.31302, 1.91000E-09,
& 5.10000E-01, 1.31257, 2.14000E-09,
& 5.20000E-01, 1.31215, 2.26000E-09,
& 5.30000E-01, 1.31175, 2.54000E-09,
& 5.40000E-01, 1.31136, 2.93000E-09,
& 5.50000E-01, 1.31099, 3.11000E-09,
& 5.60000E-01, 1.31064, 3.29000E-09 /
DATA ( WL( I ), TABRE( I ), TABIM( I ) , I = 131, 140 ) /
& 5.70000E-01, 1.31031, 3.52000E-09,
& 5.80000E-01, 1.30999, 4.04000E-09,
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -