www.pudn.com > Noise.rar > NOIS1.FOR
PROGRAM NOIS1
C.....A FORTRAN V ROUTINE FOR PC USING USER INPUT OF SEASON, LOCATION,
C.....MANMADE NOISE, FREQUENCY AND TIME AND FOUR EXTERNAL FILES OF
C.....COEFFICIENTS TO GIVE OUTPUT OF ATMOSPHERIC, GALACTIC,AND MANMADE
C.....NOISE, AN OVERALL MEDIAN NOISE VALUE FAM (DBW/HZ) AND DL, DU,
C.....SL, SM AND SU, THE STATISTICAL VARIATIONS OF A NOISE VALUE.
C.....THIS IS THE FORMER NOSCMPC ROUTINE.
COMMON /ANOIS/ ATNU,ATNY,CC,TM,RCNSE,DU,DL,SIGM,SIGU,SIGL,KJ,JK
COMMON /TON/ ATMO, GNOS, ZCNSE, XADJN, XNOISE, ZNOISE
COMMON /TWO/ DUD(5,12,5),FAM(14,12),FAKP(29,16,6),FAKABP(2,6)
COMMON /NSTAT/ DLA,DUA,SLA,SMA,SUA,DLM,DUM,SLM,SMM,SUM
DIMENSION FREQA(100),TBHR(6),FREQL(11)
CHARACTER*6 SEASON(4),SEAFIN(4)
CHARACTER*9 TIMEBLK(6)
CHARACTER*17 NOSNAME(4)
CHARACTER*40 LOCNAME
DATA SEASON /'WINTER','SPRING','SUMMER','AUTUMN'/
DATA SEAFIN /'ISCOF1','ISCOF2','ISCOF3','ISCOF4'/
DATA TIMEBLK /'0000-0400','0400-0800','0800-1200','1200-1600',
A '1600-2000','2000-2400'/
DATA NOSNAME /'BUSINESS NOISE','RESIDENTIAL NOISE',
A 'RURAL NOISE','QUIET RURAL NOISE'/
DATA TBHR /2.0,6.0,10.0,14.0,18.0,22.0/
DATA FREQL /.01,.02,.05,.1,.2,.5,1.,2.,5.,10.,20./
C.....
C.....BEGIN INPUT WITH SEASON
C.....
100 WRITE (*,1050)
1050 FORMAT (/1X,' INPUT SEASON, 1=WINTER, 2=SPRING, 3=SUMMER'/
A ' 4=AUTUMN, 5=ALL SEASONS, ANYTHING ELSE=END OF RUN')
READ (*,*) ISEASON
ISEAIN=ISEASON
IF (ISEASON .LT. 1 .OR. ISEASON .GT. 5) GO TO 500
ISE1=ISEASON
ISE2=ISEASON
IF (ISEASON .EQ. 5) ISE1=1
IF (ISEASON .EQ. 5) ISE2=4
DO 275 ISE = ISE1,ISE2
ISEASON = ISE
IF (ISEAIN .GT. 4 .AND. ISE .GT. 1) GO TO 105
C.....
C.....INPUT LOCATION
C.....
WRITE (*,1051)
1051 FORMAT (/1X,' INPUT LOCATION LATITUDE (- IF S), LONGITUDE (- IF'
A ' WEST)'/' AND LOCATION NAME IN SINGLE QUOTES')
READ (*,*) RLATD,ALONGD,LOCNAME
RLONGD=ALONGD
IF (ALONGD .LT. 0.0) RLONGD=360.+ALONGD
105 CONTINUE
KODESEA=ISEASON
IF (RLATD .GE. 0.0) GO TO 110
IF (ISEASON .EQ. 1) KODESEA = 3
IF (ISEASON .EQ. 2) KODESEA = 4
IF (ISEASON .EQ. 3) KODESEA = 1
IF (ISEASON .EQ. 4) KODESEA = 2
110 CONTINUE
OPEN (3,FILE=SEAFIN(KODESEA),STATUS='UNKNOWN',ACCESS=
A 'SEQUENTIAL', FORM='BINARY',MODE='READ')
READ (3,END=300,ERR=400) DUD,FAM,FAKP,FAKABP
CLOSE (3)
LUFO=4
OPEN (4,FILE='NOISE.LST',STATUS='UNKNOWN',ACCESS='SEQUENTIAL',
A FORM='FORMATTED')
IF (ISE1 .NE. ISE2 .AND. ISE .NE. 1) GO TO 135
C.....
C.....INPUT NOISE
C.....
WRITE (*,1052)
1052 FORMAT (/1X,' INPUT MANMADE NOISE AT 3 MHZ (DBW) OR'/
A ' -1 FOR BUSINESS, -2 FOR RESIDENTIAL, -3 FOR RURAL, OR'/
B ' -4 FOR QUIET RURAL NOISE'/' AND OUTPUT CODE 1 FOR DBW'
C ' OR 2 FOR FA')
READ (*,*) NNOISE,IODBWDB
NOISE = NNOISE
IF (NNOISE .LT. -4.) NOISE = ABS(NNOISE)
C.....
C.....INPUT FMHZ
C.....
WRITE (*,1053)
1053 FORMAT (/1X,' INPUT SPECIFIC FMHZ DESIRED (.01-30.)'/
A ' OR 0.0 FOR COMPUTER ARRAY LOOP OF FMHZ'/
B ' OR -1.0 FOR USER ARRAY LOOP OF FMHZ'/
C ' OR -2.0 FOR LOGARITHMIC ARRAY LOOP OF FMHZ.')
READ (*,*) FREQ
NF=1
FREQA(NF)=FREQ
IF (FREQ-0.0) 125,122,130
122 WRITE (*,1054)
1054 FORMAT (/1X,' INPUT BEGINNING, ENDING, AND INCREMENT FOR FREQ')
READ (*,*) FBEG,FEND,FINC
FREQA(NF)=FBEG
IF (FBEG .LT. .01 .OR. FEND .GT. 30.) GO TO 280
DO 124 KF=2,100
NF=NF+1
FREQA(NF)=FREQA(NF-1)+FINC
IF ((FREQA(NF)+.005)-FEND) 124,129,129
124 CONTINUE
GO TO 280
125 IF (FREQ .NE. -1.0) GO TO 127
DO 126 KF=1,99
WRITE (*,1057)
1057 FORMAT (/1X,' INPUT FREQUENCY (0.0 TO END)')
READ (*,*) FREQA(NF)
IF (FREQA(NF) .EQ. 0.0) GO TO 129
NF=NF+1
126 CONTINUE
GO TO 280
127 IF (FREQ .NE. -2.0) GO TO 280
NF=11
DO 128 KF=1,11
FREQA(KF)=FREQL(KF)
128 CONTINUE
GO TO 130
129 IF ((FREQ .EQ. -1.) .OR. (FREQ .EQ. 0. .AND. FREQA(NF) .GT.
A FEND)) NF=NF-1
C.....
C.....INPUT TIME
C.....
130 WRITE (*,1055)
1055 FORMAT (/1X,' INPUT SPECIFIC LOCAL MEAN TIME (0-23)'/
A ' OR 25 FOR TIME BLOCKS')
READ (*,*) RLMT
IF (RLMT .LT. 0. .OR. RLMT .EQ. 24. .OR. RLMT .GT. 25.)
A GO TO 280
WRITE (*,1056)
1056 FORMAT (/1X,' INPUT SWITCH TO DESIGNATE NOISE VALUE '/
A ' STATISTICAL PARAMETERS OUTPUT FOR; 1=OVERALL MEDIAN, '/
B ' 2 = ATMOSPHERIC, 3=MANMADE'/2X,'ALL MEDIAN NOISE VALUES '
C 'WILL APPEAR BUT'/2X,'THE STATISTICAL VARIATIONS ARE ONLY '
D 'FOR'/2X,'FOR THE PARTICULAR NOISE TYPE SELECTED.')
READ (*,*) IPS
135 CONTINUE
IF (RLMT-25.) 140,200,280
C.....
C.....USE THIS BRANCH TO DO SPECIFIC TIME
C.....
140 CALL ANOIS1(RLMT,RLATD,RLONGD)
WRITE (LUFO,1002) RLATD,ALONGD,LOCNAME
IF (NNOISE .LT. -4) WRITE (LUFO,1016)
A SEASON(ISEASON),RLMT,NNOISE
IF (NNOISE .GE. -4) WRITE (LUFO,1014)
A SEASON(ISEASON),RLMT,NOSNAME(ABS(NNOISE))
1002 FORMAT(////2X,'LAT = ',F6.2,', LONG = ',F7.2,', ',A40)
1016 FORMAT (2X,A6,', LMT = ',F4.1,', 3 mhz MANMADE NOISE = ',I4,
A ' DBW'/)
1014 FORMAT (2X,A6,', LMT = ',F4.1,', ',A17/)
IF (IODBWDB .EQ. 1) WRITE (LUFO,1005)
IF (IODBWDB .EQ. 2) WRITE (LUFO,1013)
1005 FORMAT (13X,'---MEDIAN NOISE VALUES IN DBW-- STATISTICAL ',
A 'VALUES IN DB')
1013 FORMAT (13X,'--MEDIAN NOISE VALUES, FA(DB)-- STATISTICAL ',
A 'VALUES IN DB')
IF (IPS .EQ. 1) WRITE (LUFO,1010)
IF (IPS .EQ. 2) WRITE (LUFO,1011)
IF (IPS .EQ. 3) WRITE (LUFO,1012)
1010 FORMAT (50X,'OVERALL NOISE')
1011 FORMAT (48X,'ATMOSPHERIC NOISE')
1012 FORMAT (50X,'MANMADE NOISE')
WRITE (LUFO,1008)
1008 FORMAT (7X,'FMHZ',4X,'ATMO',5X,'GAL',1X,'MANMADE',1X,'OVERALL',
C 3X,'DL',3X,'DU',3X,'SL',3X,'SM',3X,'SU'/)
DO 150 IFREQ=1,NF
FREQ=FREQA(IFREQ)
CALL GENOIS(FREQ,NOISE,RLATD)
IF (IODBWDB .EQ. 1) GO TO 148
ATMO=ATMO+204.
GNOS=GNOS+204.
XNOISE=XNOISE+204.
RCNSE=RCNSE+204.
148 CONTINUE
IF (IPS .EQ. 1) WRITE (LUFO,1003) FREQ,ATMO,GNOS,XNOISE,RCNSE,
A DL,DU,SIGL,SIGM,SIGU
IF (IPS .EQ. 2) WRITE (LUFO,1003) FREQ,ATMO,GNOS,XNOISE,RCNSE,
A DLA,DUA,SLA,SMA,SUA
IF (IPS .EQ. 3) WRITE (LUFO,1003) FREQ,ATMO,GNOS,XNOISE,RCNSE,
A DLM,DUM,SLM,SMM,SUM
1003 FORMAT(4X,F7.3,4F8.1,5F5.1)
150 CONTINUE
GO TO 275
C.....
C.....USE THIS BRANCH TO DO TIME BLOCKS
C.....
200 CONTINUE
DO 270 IFREQ=1,NF
FREQ=FREQA(IFREQ)
WRITE (LUFO,1002) RLATD,ALONGD,LOCNAME
IF (NNOISE .LT. -4) WRITE (LUFO,1004)
A SEASON(ISEASON),FREQ,NNOISE
IF (NNOISE .GE. -4) WRITE (LUFO,1015)
A SEASON(ISEASON),FREQ,NOSNAME(ABS(NNOISE))
1004 FORMAT (2X,A6,', FMHZ = ',F6.3,', 3 MHZ MANMADE NOISE = ', I4,
A ' DBW'/)
1015 FORMAT (2X,A6,', FMHZ = ',F6.3,', ',A17/)
IF (IODBWDB .EQ. 1) WRITE (LUFO,1005)
IF (IODBWDB .EQ. 2) WRITE (LUFO,1013)
IF (IPS .EQ. 1) WRITE (LUFO,1010)
IF (IPS .EQ. 2) WRITE (LUFO,1011)
IF (IPS .EQ. 3) WRITE (LUFO,1012)
WRITE (LUFO,1006)
1006 FORMAT (1X,'TIME BLOCK',4X,'ATMO',5X,'GAL',1X,'MANMADE',1X,
C 'OVERALL',3X,'DL',3X,'DU',3X,'SL',3X,'SM',3X,'SU'/)
DO 260 ITB=1,6
TIME=TBHR(ITB)
CALL ANOIS1(TIME,RLATD,RLONGD)
CALL GENOIS(FREQ,NOISE,RLATD)
IF (IODBWDB .EQ. 1) GO TO 258
ATMO=ATMO+204.
GNOS=GNOS+204.
XNOISE=XNOISE+204.
RCNSE=RCNSE+204.
258 CONTINUE
IF (IPS .EQ. 1) WRITE (LUFO,1007) TIMEBLK(ITB),ATMO,GNOS,XNOISE,
A RCNSE,DL,DU,SIGL,SIGM,SIGU
IF (IPS .EQ. 2) WRITE (LUFO,1007) TIMEBLK(ITB),ATMO,GNOS,XNOISE,
A RCNSE,DLA,DUA,SLA,SMA,SUA
IF (IPS .EQ. 3) WRITE (LUFO,1007) TIMEBLK(ITB),ATMO,GNOS,XNOISE,
A RCNSE,DLM,DUM,SLM,SMM,SUM
1007 FORMAT (2X,A9,4F8.1,5F5.1)
260 CONTINUE
270 CONTINUE
275 CONTINUE
GO TO 100
280 WRITE (*,2010)
GO TO 100
300 WRITE (*,2020)
CLOSE (4)
STOP
400 WRITE (*,2030)
CLOSE (4)
STOP
500 CONTINUE
CLOSE (4)
WRITE (*,2000)
STOP
2000 FORMAT (//' NORMAL PROGRAM TERMINATION')
2010 FORMAT (//' ERROR ON INPUT, TRY AGAIN')
2020 FORMAT (//' END OF FILE ON DATA BASE')
2030 FORMAT (//' ERROR ON DATA BASE READ')
END
SUBROUTINE ANOIS1(RLMT,RLATD,RLONGD)
CR....A ROUTINE THAT USES RLMT TO DETERMINE THE TIMEBLOCK (KJ)
CR....AND ADJACENT TIME BLOCK (JK) (THIS IS THE PRIOR TIMEBLOCK
CR....FOR THE FIRST 2 HOURS OF KJ, THE SAME, IE JK=KJ, FOR THE 3RD
CR....HOUR OF KJ AND THE NEXT TIME BLOCK FOR THE LAST HOUR OF KJ)
CR....AND THEN CALLS NOISY TO FIGURE THE ATMOSPHERIC NOISE (ATNU
CR....OR ATNY) FOR EACH OF THESE TIME BLOCKS.
C.....
C.....THIS ROUTINE DETERMINES THE 1 MHZ ATMOSPHERIC NOISE
C.....
C.....FOURIER SERIES IN LATITUDE AND LONGITUDE FOR TWO DISCRETE
C.....LOCAL TIME BLOCKS
C.....
COMMON /ANOIS/ ATNU,ATNY,CC,TM,RCNSE,DU,DL,SIGM,SIGU,SIGL,KJ,JK
C.....LMT AT RCVR SITE
100 CC = RLMT
KJ= 6
IF(CC-22.) 105,110,110
105 KJ = CC/4. +1.
110 TM = 4*KJ-2
IF(CC-TM) 115,120,125
115 JK = KJ -1
GO TO 130
120 JK = KJ
GO TO 130
125 JK = KJ+1
130 IF(JK) 135,135,140
135 JK =6
GO TO 150
140 IF(JK-6) 150,150,145
145 JK = 1
C.....EAST LONGITUDE (IN DEGREES)
150 CEG= RLONGD
165 XLA =RLATD
C.....LATITUDE (IN DEGREES) "+" IS NORTH
CALL NOISY(KJ,XLA,CEG,ATNU)
CALL NOISY(JK,XLA,CEG,ATNY)
RETURN
END
SUBROUTINE NOISY (KJ, XLA, CEG, ANOS)
CR....A ROUTINE TO USE THE TIMEBLOCK (KJ), THE LAT (XLA), THE LONG
CR....(CEG), AND THE IONOSPHERIC COEFFICIENTS (FAKP AND FAKAB) TO
CR....DETERMINE THE ATMOSPHERIC NOISE (ANOS).
C.....NOISY IS A GENERAL PURPOSE ROUTINE USED TO EVALUATE A FOURIER
C.....SERIES IN TWO VARIABLES.
C.....KJ --- NUMBER OF FOURIER COEFFICIENT ARRAY TO BE USED
C.....XLA --- GEOGRAPHIC LATITUDE, DEGREES,
C.....CEG --- GEOGRAPHIC EAST LONGITUDE, DEGREES
C.....ANOS --- NOISE VALUE, MEDIAN POWER DB ABOVE KTB
C.....FAKABP --- NORMALIZING FACTORS FOR FOURIER SERIES
C.....KJ = 1 TO 6 IS ATMOSPHERIC NOISE
C.....
C.....* NOTE - XLA, CEG, ANOS, FAKABP ARE NOT ALWAYS AS PREVIOUSLY
C..... DEFINED
C.....FOURIER VARIABLES AND ATMOSPHERIC RADIO NOISE
C.....
COMMON /TWO/ DUD(5,12,5),FAM(14,12),FAKP(29,16,6),FAKABP(2,6)
DIMENSION SX (15), SY(29), ZZ (29)
IF (KJ - 6) 105,105,100
100 KJ=6
C.....LIMITS OF FOURIER SERIES
105 LM = 29
LN = 15
C.....HALF ANGLE (IN RADIANS)
110 Q = .0087266466 * CEG
C.....LONGITUDE SINES
DO 115 K = 1, 15
115 SX(K)=SIN(Q*K)
118 CONTINUE
C.....LONGITUDE SERIES
DO 125 J = 1, LM
R = 0.
DO 120 K = 1, LN
120 R = R + SX (K) * FAKP (J, K, KJ)
125 ZZ (J) = R + FAKP (J, 16, KJ)
C.....ANGLE PLUS 90 DEGREES (IN RADIANS)
Q = .01745329252 * (XLA + 90.)
C.....LATITUDE SERIES
DO 140 J=1,29
140 SY(J)=SIN(Q*J)
R = 0.
DO 130 K = 1, LM
130 R = R + SY (K) * ZZ (K)
C.....FINAL FOURIER SERIES EVALUATION (NOTE LINEAR NORMALIZATION)
135 ANOS = R + FAKABP(1,KJ)+FAKABP(2,KJ)* Q
RETURN
END
SUBROUTINE GENOIS(FREQ,NOISE,RLAT)
C.....
C.....THIS ROUTINE COMPUTES THE COMBINED NOISE DISTRIBUTION
C.....
COMMON /ANOIS/ ATNU,ATNY,CC,TM,RCNSE,DU,DL,SIGM,SIGU,SIGL,KJ,JK
COMMON /TON/ ATMO, GNOS, ZCNSE, XADJN, XNOISE, ZNOISE
COMMON /NSTAT/ DLA,DUA,SLA,SMA,SUA,DLM,DUM,SLM,SMM,SUM
DIMENSION XNINT(4)
C.....MAN-MADE NOISE LEVELS AS GIVEN BY CCIR REPORT 258.
DATA XNINT /76.8, 72.5, 67.2, 53.6/
DATA AFAC,BFAC,CFAC/7.87384,30.99872,5.56765/
C.....
C.....(DUA/7.87384)**2=(DUA/1.282)**2/(2*4.34294**2)
C..... =(DUA/SQRT(2*1.282**2*4.34294**2))**2
C.....
C.....DLA*DLA/30.99872=(DLA/1.282)**2/(4.34294)**2
C.....
C.....5.56765=4.34294*1.282
C.....
C.....DATA IS FA VALUES AT 1 MHZ
C.....CALCULATION OF NOISE LEVEL IS ITSA-1
C.....ATNU, ATNY ARE DB .GT. KTB FOR 1 MHZ
C.....ATNZ, ATNX ARE DB .GT. KTB FOR DESIRED FREQ,DUM
C.....ATNOS, GNOS, XNOIS ARE DB .GT. KTB FOR ALL CALCULATIONS
C.....AND ARE CONVERTED TO DBW(1 HZ BWDTH) AT END OF ROUTINE
C.....UPPER LIMIT IS 55 MHZ FOR NOISE
DUME = AMIN1(FREQ,55.)
MAN=NOISE
C.....FREQUENCY DEPENDENCE ATMOSPHERIC NOISE
C.....FREQUENCY DEPENDENCE
CALL GENFAM(RLAT,KJ,DUME,ATNU,ATNZ,DU,DL,SIGM,SIGU,SIGL)
CALL GENFAM(RLAT,JK,DUME,ATNY,ATNX,DX,DQ,SIGZ,SIGX,SIGSQ)
C.....BEGIN OF INTERPOLATION ON LOCAL TIME
SLOP = ABS(CC-TM)/4.
ATNOS = ATNZ + (ATNX - ATNZ) * SLOP
DUA= DU +(DX-DU)*SLOP
DLA= DL +(DQ-DL)*SLOP
SMA= SIGM+ (SIGZ-SIGM)*SLOP
SUA= SIGU +(SIGX-SIGU)*SLOP
SLA= SIGL+(SIGSQ-SIGL)* SLOP
C.....
95 AU=EXP((DUA/AFAC)**2 + (ATNOS/4.34294))
VU=AU*AU*(EXP(DUA*DUA/BFAC)-1.)
AL=EXP((DLA/AFAC)**2 + (ATNOS/4.34294))
VL=AL*AL*(EXP(DLA*DLA/BFAC)-1.)
C.....GALACTIC NOISE
105 GNOS = 52. - 23. * ALOG10(FREQ)
110 DUG=2.
AT=EXP((DUG/AFAC)**2 + (GNOS/4.34294))
AU=AU+AT
VU=VU+AT*AT*(EXP(DUG*DUG/BFAC)-1.)
DLG=2.
AT=EXP((DLG/AFAC)**2 + (GNOS/4.34294))
AL=AL+AT
VL=VL+AT*AT*(EXP(DLG*DLG/BFAC)-1.)
SMG = .5
SUG = .2
SLG = .2
C.....MAN MADE NOISE
MAN=NOISE
XNOIS = MAN
MA = IABS(MAN)
ZNOISE=XNOIS
IF(MAN) 120, 114, 115
C.....INDICATES -164 ON USER INPUT
114 MA = 4
GO TO 120
C.....CONVERT 3 MHZ DB .LT. 1 WATT INPUT VALUE TO FA AT 1 MHZ
115 XNOIS=204.0-XNOIS+13.22
C.....OBTAIN FA AT DESIRED FREQUENCY
XNOIS = XNOIS - 27.7 * ALOG10(FREQ)
GO TO 125
C....NEGATIVE ON USER INPUT INDICATES INDEX
120 MA = MIN0(4,MA)
CONN=27.7
IF(MA .EQ. 4) CONN=28.6
XNOIS = XNINT(MA) - CONN * ALOG10(FREQ)
ZNOISE = 204.0 - XNINT(MA) + 13.22
125 DUM=9.7
AT=EXP((DUM/AFAC)**2+(XNOIS/4.34294))
AU=AU+AT
VU=VU+AT*AT*(EXP(DUM*DUM/BFAC)-1.)
DLM=6.
AT=EXP((DLM/AFAC)**2+(XNOIS/4.34294))
AL=AL+AT
VL=VL+At*AT*(EXP(DLM*DLM/BFAC)-1.)
SUM=1.5
SMM=5.4
SLM=1.5
C.....NOW DETERMINATION OF NOISE LEVEL IS ITS-78(HFMUFES4)
C.....SWITCH TO DB .GT. WATT
ATNOS=ATNOS-204.
GNOS=GNOS-204.
XNOIS=XNOIS-204.
SIGTSQ=ALOG(1.+VU/(AU*AU))
XRNSE= 4.34294*(ALOG(AU)-SIGTSQ/2.) -204.
C.....UPPER DECILE
DU= CFAC*SQRT(SIGTSQ)
SIGTSQ=ALOG(1.+VL/(AL*AL))
C.....LOWER DECILE
DL= CFAC*SQRT(SIGTSQ)
205 QPA = 10. ** ((ATNOS - XRNSE) * .1)
QPG = 10.**((GNOS -XRNSE)*.1)
C.....PREDICTION ERRORS
C.....SIGM IS MEDIAN, SIGU IS UPPER AND SIGL IS LOWER
QPM = 10.**((XNOIS-XRNSE)*.1)
SIGM= SQRT((QPA*SMA)**2 +(QPG*SMG)**2 +(QPM*SMM)**2)
PV=QPA*EXP((DUA-DU)*.23026)
SIGU= (PV*SUA)**2+((PV-QPA)*SMA)**2
PV=QPG*EXP((DUG-DU)*.23026)
SIGU=SIGU+(PV*SUG)**2+((PV-QPG)*SMG)**2
PV=QPM*EXP((DUM-DU)*.23026)
SIGU=SQRT(SIGU+(PV*SUM)**2+((PV-QPM)*SMM)**2)
PV=QPA*EXP((DLA-DL)*.23026)
SIGL= (PV*SLA)**2+((PV-QPA)*SMA)**2
PV=QPG*EXP((DLG-DL)*.23026)
SIGL=SIGL+(PV*SLG)**2+((PV-QPG)*SMG)**2
PV=QPM*EXP((DLM-DL)*.23026)
SIGL=SQRT(SIGL+(PV*SLM)**2+((PV-QPM)*SMM)**2)
C.....RCVR SITE NOISE = TOTAL NOISE + ANTENNA EFFICENCY (ADDED TO SIGNAL
C.....WITH GAIN)
210 RCNSE = XRNSE
ZCNSE=RCNSE
ATMNO=ATNOS
XADJN=1.
XNOISE=XNOIS
ATMO=ATNOS
RETURN
END
SUBROUTINE GENFAM(Y2,IBLK,FREQ,Z,FA,DUA,DLA,DMS,DUS,DLS)
c**********************************************************************
c Re-written 3.June.93 by Greg Hand because previous version was
c really incorrect. It made an attempt to limit Sigma Fam (DMS)
c to a 10 MHz frequency, but the indicies I and J became
c confused, and the result was not correct. This current
c version should limit DMS to 10 MHz and the others to 20 MHz
c because the curves end at 20 MHz. Unfortunately, this error
c has probably existed since time began, and it may take a
c while for this corrected version to propagate into all version
c that exist. The magnitude of the error that would have been
c caused is not known, but it is believed to be small.
c**********************************************************************
C.....VERSION 03.NOV.92 input latitude Y2 now in radians
C.....GENFAM CALCULATES THE FREQUENCY DEPENDENCE OF THE ATMOSPHERIC
C.....NOISE AND GETS DECILES AND PREDICTION ERRORS FROM TABLES
C.....
COMMON /TWO/ DUD(5,12,5),FAM(14,12),FAKP(29,16,6),FAKABP(2,6)
DIMENSION V(5)
IBK=IBLK
C.....CHECK IF LATITUDE IS NORTH OR SOUTH
IF(Y2.lt.0.) IBK=IBK+6
U1 = - .75
X = ALOG10(FREQ)
U = (8. * 2. * * X - 11.) / 4.
KOP = 1
110 PZ = U1 * FAM (1, IBK) + FAM (2, IBK)
PX = U1 * FAM (8, IBK) + FAM (9, IBK)
DO 115 I = 3, 7
PZ = U1 * PZ + FAM (I, IBK)
115 PX = U1 * PX + FAM (I + 7, IBK)
IF(KOP.eq.2) go to 125
CZ = Z * PZ + PX
CZ = Z + Z - CZ
U1 = U
KOP = 2
GO TO 110
125 FA = CZ * PZ + PX
c Limit frequency to 20 MHz for DUA, DLA, DUS, DLS
c because curves in REP 322 only go to 20 MHz
if(FREQ.gt.20.) X=ALOG10(20.)
DO 145 I = 1, 5
c Limit frequency to 10 MHz for DMS (Sigma Fam)
c because curves in REP 322 only go to 10 MHz
if(I.eq.5 .and. FREQ.gt.10.) X=1.
Y = DUD(1,IBK,I)
DO 140 J = 2,5
140 Y = Y*X + DUD(J,IBK,I)
145 V(I) = Y
DUA = V(1)
DLA = V(2)
DUS = V(3)
DLS = V(4)
DMS = V(5)
RETURN
END