www.pudn.com > Noise.rar > NOIS2.FOR
PROGRAM NOIS2
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.....THE MODIFICATION OF NOSCMPC (NOW NOIS1) TO NOIS2 CHANGES THE
C.....OUTPUT FORMAT SO THAT WHEN COMPUTATIONS ARE DONE BY TIME BLOCKS,
C.....A SET OF SEASONS IS OUTPUT FOR A GIVEN FREQUENCY INSTEAD OF THE
C.....REVERSE.
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(60),TBHR(6),FREQL(11)
DIMENSION AARR(4,60,6),GARR(4,60,6),XARR(4,60,6),
A RARR(4,60,6),DLARR(4,60,6),DUARR(4,60,6),SLARR(4,60,6),
B SMARR(4,60,6),SUARR(4,60,6)
CHARACTER*1 PGEJT
CHARACTER*6 SEASON(4),SEAFIN(4)
CHARACTER*9 TIMEBLK(6)
CHARACTER*17 NOSNAME(4)
CHARACTER*40 LOCNAME
DATA PGEJT /' '/
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.'/
D ' DO NOT ASK FOR MORE THAN 60 VALUES 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 295
DO 124 KF=2,60
NF=NF+1
FREQA(NF)=FREQA(NF-1)+FINC
IF ((FREQA(NF)+.005)-FEND) 124,129,129
124 CONTINUE
GO TO 295
125 IF (FREQ .NE. -1.0) GO TO 127
DO 126 KF=1,61
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 295
127 IF (FREQ .NE. -2.0) GO TO 295
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 295
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,295
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
WRITE (LUFO,1017) PGEJT
1017 FORMAT (1A1)
GO TO 275
C.....
C.....USE THIS BRANCH TO DO TIME BLOCKS
C.....
200 CONTINUE
DO 270 IFREQ=1,NF
FREQ=FREQA(IFREQ)
DO 265 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
AARR(ISE,IFREQ,ITB)=ATMO
GARR(ISE,IFREQ,ITB)=GNOS
XARR(ISE,IFREQ,ITB)=XNOISE
RARR(ISE,IFREQ,ITB)=RCNSE
IF (IPS .GT. 1) GO TO 260
DLARR(ISE,IFREQ,ITB)=DL
DUARR(ISE,IFREQ,ITB)=DU
SLARR(ISE,IFREQ,ITB)=SIGL
SMARR(ISE,IFREQ,ITB)=SIGM
SUARR(ISE,IFREQ,ITB)=SIGU
GO TO 265
260 CONTINUE
IF (IPS .GT. 2) GO TO 262
DLARR(ISE,IFREQ,ITB)=DLA
DUARR(ISE,IFREQ,ITB)=DUA
SLARR(ISE,IFREQ,ITB)=SLA
SMARR(ISE,IFREQ,ITB)=SMA
SUARR(ISE,IFREQ,ITB)=SUA
GO TO 265
262 CONTINUE
IF (IPS .NE. 3) GO TO 295
DLARR(ISE,IFREQ,ITB)=DLM
DUARR(ISE,IFREQ,ITB)=DUM
SLARR(ISE,IFREQ,ITB)=SLM
SMARR(ISE,IFREQ,ITB)=SMM
SUARR(ISE,IFREQ,ITB)=SUM
265 CONTINUE
270 CONTINUE
275 CONTINUE
C.....
C.....OUTPUT FOR TIME BLOCK COMPUTATIONS; ELSE GO FOR NEW INPUT
C.....
IF (RLMT-25.) 100,280,295
280 CONTINUE
DO 286 IFREQ=1,NF
DO 284 ISE=ISE1,ISE2
WRITE (LUFO,1002) RLATD,ALONGD,LOCNAME
IF (NNOISE .LT. -4) WRITE (LUFO,1004)
A SEASON(ISE),FREQA(IFREQ),NNOISE
IF (NNOISE .GE. -4) WRITE (LUFO,1015)
A SEASON(ISE),FREQA(IFREQ),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 282 ITB = 1,6
WRITE (LUFO,1007) TIMEBLK(ITB),AARR(ISE,IFREQ,ITB),
A GARR(ISE,IFREQ,ITB),XARR(ISE,IFREQ,ITB),RARR(ISE,IFREQ,ITB),
B DLARR(ISE,IFREQ,ITB),DUARR(ISE,IFREQ,ITB),SLARR(ISE,IFREQ,ITB),
C SMARR(ISE,IFREQ,ITB),SUARR(ISE,IFREQ,ITB)
1007 FORMAT (2X,A9,4F8.1,5F5.1)
282 CONTINUE
284 CONTINUE
WRITE (LUFO,1017) PGEJT
286 CONTINUE
GO TO 100
295 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