FORTRAN: C********************************************* PROGRAM DOPPLER_SHIFT C Program gives the doppler shift for a radio signal given the C frequency of operation in Megahertz (MHz) and the relative rate of speed C between the transmitter and receiver. C ***************************************** C By Dale Bickel, Senior Electronics Engineer, dale.bickel@fcc.gov C Audio Services Div., FCC (USA) C http://www.fcc.gov/mb/audio/ C C This Fortran CGI application may be copied and/or C modified freely. No restrictions are placed on its use. C ****************************************** C This program was created to develop a Fortran CGI. It C receives input from HTML and generates HTML output. C It could easily be modified to allow input from the C keyboard or a Fortran routine. C CGI access is required if the program is used as written. C The programming has not been optimized. C ****************************************** C Fortran 77 reminders: C Column 1 -- enter C for Comments C Column 2-5 -- statement labels C Column 6 -- continuation character C Column 7 -- start commands in this column C Column 72 -- Last column of statement -- use continuation C characters or another Format statement if command is longer C ****************************************** Double Precision Freq C Operating Frequency, in MHz Double Precision Doppler, Shift Integer Units C Metric=1, English=2 Integer Err Integer i Real Velocity, convert_v C STIN must be long enough to hold all of the input string C sent by the form. It can be bigger. Substring must be C big enough to hold the largest values sent by the form. Character *100 STIN Character *20 substring C The next line is necessary to see output on the browser! C Watch the placement of the quotes and the two returns (//). C The // are very important!!! write(6,100) 100 format("Content-type: text/html"//) C Now we receive the data from the input form. If the length C of the query_string environment from the getenv UNIX subroutine C is zero, then we don't have data from the GET method. So we C look for data using the standard input from a POST submission. C In either case, the received character string is saved in the C character string STIN, which MUST be of sufficient size to hold C the largest string length the form is expected to send. call getenv('QUERY_STRING', STIN) if(length(STIN).le.1) then C If we are here, we don't have a GET submission, so look for something C in standard input from a POST form. C "end=" statement tells where to go when the end of the input string C is reached read(5,1,end=2) STIN 1 format(A) 2 continue end if C Uncomment this line to see the received string c write(6,1) STIN C Now it's time to parse the data strings for the pertinent values C We search along the string and find the looked-for name=value pairs. C The "char2" subroutines then extract the value and convert it to C the requested variable type. C Note: Be sure the variables are set to zero before invoking the C "char2" functions, or you will not get proper results! This is C particularly important if your program does a second search of the C STIN string at some later point. C We know what data elements the program needs, so we search along C the string for name=value pairs. If a particular "name=" is found, C we convert the data immediately following into the corresponding C double precision,real, or integer value. The advantage of this approach C is that the name=value pairs do not need to be presented in any particular C order, which allows for more flexibility in forms. Also, we can C transmit as many fields as needed for the particular application C at hand, while allowing for other fields in different applications. C Parsing with the name elements also improves security in that C unwanted name=value pairs are not accepted into the program. C For each name=value pair, the last character is the one before the C next "&" or space in the string STIN Freq=0.0 Units=0 Velocity=0.0 Do i=1,(length(STIN)),1 if ((STIN(i:i).eq.'f') &.and.(STIN((i+1):(i+1)).eq.'r') &.and.(STIN((i+2):(i+2)).eq.'e') &.and.(STIN((i+3):(i+3)).eq.'q') &.and.(STIN((i+4):(i+4)).eq.'=')) then C Choose a substring length which will be larger than the maximum number C of characters expected for the double precision variable Freq. C That integer (or something smaller) can be entered into the second C variable in the call char2double subroutine. substring=STIN((i+5):(i+14)) call char2double(substring,9,freq,err) C Now we have the freq variable in hand. else if((STIN(i:i).eq.'u') &.and.(STIN((i+1):(i+1)).eq.'n') &.and.(STIN((i+2):(i+2)).eq.'i') &.and.(STIN((i+3):(i+3)).eq.'t') &.and.(STIN((i+4):(i+4)).eq.'s') &.and.(STIN((i+5):(i+5)).eq.'=')) then C Choose a substring length which will be larger than the maximum number C of characters expected for the integer variable Units. C That integer (or something smaller) can be entered into the second C variable in the call char2int subroutine. substring=STIN((i+6):(i+9)) call char2int(substring,1,units,err) else if((STIN(i:i).eq.'v') &.and.(STIN((i+1):(i+1)).eq.'e') &.and.(STIN((i+2):(i+2)).eq.'l') &.and.(STIN((i+3):(i+3)).eq.'o') &.and.(STIN((i+4):(i+4)).eq.'c') &.and.(STIN((i+5):(i+5)).eq.'i') &.and.(STIN((i+6):(i+6)).eq.'t') &.and.(STIN((i+7):(i+7)).eq.'y') &.and.(STIN((i+8):(i+8)).eq.'=')) then substring=STIN((i+9):(i+20)) call char2real(substring,11,velocity,err) end if end do C Parsing is complete C Uncomment next two lines to check received data. c write(6,8) freq, velocity, units c 8 format("

Parsed data: "F10.4,5x,F10.4,5x,I1,"

") C Decide what to do about the Units! if(units.eq.2) then ! We have English units. Velocity= velocity / 0.6213711922 C miles / hr to km / hr end if C Figure the doppler shift using the Doppler function. C Change MHz to Hz for the function DOPPLER C Change velocity from km/hr to meters/second Convert_v=1000./3600. SHIFT = DOPPLER( ( FREQ * 1000000 ), ( VELOCITY * Convert_v ) ) C Now set up the HTML output. The / at the end ogf the format statements C is not absolutely needed, but it does make the browser HTML "Source" C option readable as a page instead of a very long single line. write(6,850) write(6,855) write(6,860) C Red top bar is generated by a subroutine, topbar call topbar() write(6,865) write(6,870) write(6,875) write(6,880) Shift write(6,881) (Freq + (shift/1000000)) write(6,885) write(6,890) Freq if (units.eq.1) write(6,895) Velocity if (units.eq.2) write(6,895) Velocity * 0.6213711922 ! English units if(units.eq.1.and.shift.ge.0) write(6,900) 'toward' if(units.eq.1.and.shift.lt.0) write(6,900) 'away from' if(units.eq.2.and.shift.ge.0) write(6,905) 'toward' if(units.eq.2.and.shift.lt.0) write(6,905) 'away from' write(6,907) write(6,910) 850 format(""/) 855 format("Doppler Shift for a Radio Signal -- " &"ASD (FCC) USA"/) 860 format(""/) C Create HTML table in which to display the output 865 format("

"/) 870 format("

"/) 875 format("

Doppler Shift is "F15.9" Hertz (Hz)

") 881 format("Doppler-shifted frequency = "F15.9 " MHz" &"

") 885 format("


    For input data of:

") 890 format("

    • Frequency:   "F12.6 " MHz

      "/) 895 format("

    • Velocity:      " F10.5 ) 900 format(" km / hour "A" the radio source

      ") 905 format(" miles / hour "A" the radio source

      ") 907 format("The value used here for the speed of light " &" is 2.99792456 * 10**8 meters/second.

      ") 910 format("

") C Show Page location & end-of-file links call page_location() call asd_end(6) C Be sure your program contains (in the asd_end C subroutine in this example), or you may not see ANY output. Failure to C properly close HTML tags can also prevent viewing END C******************************************************************************C FUNCTION DOPPLER( FREQ, VELOCITY ) C Function calculates the doppler shift at a specified frequency and C relative velocity for electromnagnetic waves in air. It implements C the formula: C velocity * frequency C doppler shift = ____________________ C speed of propagation C where: C velocity = speed along a vector between the source and receiver C in meters per second C frequency = signal frequency in Hz C speed of propagation = rate at which waves travel in the C medium in meters per second. C C Arguments for this function are: C C FREQ = frequency of the RF signal in hertz C VELOCITY = relative velocity between the source and the receiver C in meters per second C C Speed of Light used here = 2.99792456 * 10**8 meters/second C C******************************************************************************C Double precision Freq,Doppler DOPPLER = (( VELOCITY ) * FREQ ) / ( 2.99792456 * 10**8 ) RETURN END C ************************************************************************** C LENGTH.F: c c Function by John Boursy, January 1984. c c This function receives a character string, and returns its length c as an integer. Note: this is different from the intrinsic LEN c function in FORTRAN. This function LENGTH returns the length of c the string out to the last non-blank character, while LEN returns c the entire length of the string (including blanks). c function length(string) c character string*(*) c length = len(string) c move back from end of string do 100 loop = length, 1, -1 if (string(loop:loop) .ne. ' ') goto 200 100 continue c completely blank string length = 0 c return 200 continue length = loop return end C =============================================================== C CHAR2DOUBLE.F: Subroutine char2double (char,len,doubleno,err) C By Dale Bickel, Feb 2000 C NOTE: Be sure the parameter corresponding to "doubleno" is C set to zero (0.0) before calling this subroutine, or the answer C will not be what you expect! Dimension digit(100) Character char*25 Double precision q integer i,j,p,minus,flag,len,err double precision doubleno c write(6,1130) char(1:len) 1130 format('Char string =' A /) j=0 p=1 q=1.0 minus=0 flag=0 Do 3365 i=1,len,1 3366 j=j+1 if(char(j:j).eq.'-') then minus=1 digit(j)=0 flag=1 go to 3366 else if( char(j:j).eq.'+') then minus=0 digit(j)=0 flag=1 go to 3366 else if( char(j:j).eq.'0') then digit(j)=0 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'1') then digit(j)=1 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'2') then digit(j)=2 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'3') then digit(j)=3 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'4') then digit(j)=4 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'5') then digit(j)=5 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'6') then digit(j)=6 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'7') then digit(j)=7 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'8') then digit(j)=8 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'9') then digit(j)=9 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.' '.or.char(j:j).eq.'') then C if we are here, & flag=1, then there are no more connected digits if(flag.eq.1) then go to 3367 else digit(j)=0 go to 3366 end if C Separator ' & ' may be changed as needed else if( char(j:j).eq.'&') then digit(j)=0 go to 3367 else if(char(j:j).eq.',') then digit(j)=0 go to 3366 else if( char(j:j).eq.'.') then p=0 else error=1 go to 3368 end if if(p.gt.0) then doubleno = doubleno * 10 + digit(j) else if (p.lt.0) then q = q * 0.1 doubleno = doubleno + (digit(j) * q ) end if go to 3366 3365 end do 3367 Continue if(minus.eq.1) doubleno=(-1) * abs(doubleno) if(minus.ne.1) doubleno=abs(doubleno) 3368 continue return end C ============================================================= C CHAR2INT.F subroutine char2int(char,len,int,err) C By Dale Bickel, Feb. 2000 C NOTE: Be sure the parameter corresponding to "int" is C set to zero (0.0) before calling this subroutine, or the answer C may not be what you expect! dimension digit(101) character char*100 integer i,j,minus,len,flag,err int=0 j=0 minus=0 flag=0 c write(6,1130) char(1:len) 1130 format('Char string =' A /) Do 1132 i=1,len,1 1133 j=j+1 if ( char(j:j).eq.'-') then minus=1 flag=1 digit(j)=0 go to 1133 else if( char(j:j).eq.'+') then minus=0 flag=1 digit(j)=0 go to 1133 else if( char(j:j).eq.'0') then digit(j)=0 flag=1 else if( char(j:j).eq.'1') then digit(j)=1 flag=1 else if( char(j:j).eq.'2') then digit(j)=2 flag=1 else if( char(j:j).eq.'3') then digit(j)=3 flag=1 else if( char(j:j).eq.'4') then digit(j)=4 flag=1 else if( char(j:j).eq.'5') then digit(j)=5 flag=1 else if( char(j:j).eq.'6') then digit(j)=6 flag=1 else if( char(j:j).eq.'7') then digit(j)=7 flag=1 else if( char(j:j).eq.'8') then digit(j)=8 flag=1 else if( char(j:j).eq.'9') then digit(j)=9 flag=1 else if( char(j:j).eq.',') then go to 1134 else if( char(j:j).eq.' ') then C If we are here & flag=1, then there are no more connected digits, C so don't read further if(flag.eq.1) then go to 1134 else digit(j)=0 go to 1133 end if C Change separator ' & ' if needed else if( char(j:j).eq.'&') then digit(j)=0 go to 1134 else err=2 go to 1134 end if int = int * 10 + digit(j) go to 1133 1132 end do 1134 Continue if(minus.eq.1) then int=int*(-1) else if(minus.ne.1) then int=abs(int) end if Return End C =============================================================== C CHAR2REAL.F: Subroutine char2real(char,len,realno,err) C By Dale Bickel, Feb 2000 C NOTE: Be sure the parameter corresponding to "realno" is C set to zero (0.0) before calling this subroutine, or the answer C will not be what you expect! Dimension digit(100) Character char*25 Double precision q integer i,j,p,minus,flag,len,err real realno c write(6,1130) char(1:len) 1130 format('Char string =' A /) j=0 p=1 q=1 minus=0 flag=0 Do 3365 i=1,len,1 3366 j=j+1 if(char(j:j).eq.'-') then minus=1 digit(j)=0 flag=1 go to 3366 else if( char(j:j).eq.'+') then minus=0 digit(j)=0 flag=1 go to 3366 else if( char(j:j).eq.'0') then digit(j)=0 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'1') then digit(j)=1 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'2') then digit(j)=2 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'3') then digit(j)=3 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'4') then digit(j)=4 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'5') then digit(j)=5 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'6') then digit(j)=6 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'7') then digit(j)=7 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'8') then digit(j)=8 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.'9') then digit(j)=9 flag=1 if(p.le.0) p=p-1 else if( char(j:j).eq.' ') then C if we are here, & flag=1, then there are no more connected digits if(flag.eq.1) then go to 3367 else digit(j)=0 go to 3366 end if C Separator ' & ' may be changed as needed else if( char(j:j).eq.'&') then digit(j)=0 go to 3367 else if(char(j:j).eq.',') then digit(j)=0 go to 3366 else if( char(j:j).eq.'.') then p=0 else error=1 go to 3368 end if if(p.gt.0) then realno = realno * 10 + digit(j) else if (p.lt.0) then q = q * 0.1 realno = realno + (digit(j) * q ) end if go to 3366 3365 end do 3367 Continue if(minus.eq.1) realno=(-1)*realno if(minus.ne.1) realno=abs(realno) 3368 continue return end subroutine topbar() write (6,560) write (6,561) write (6,562) write (6,563) write (6,564) 560 format("

") 561 format("
") 562 format("
        Doppler Shift " ) 563 format(" Results --- ASD (FCC) USA") 564 format("

") return end subroutine page_location() Write(6,601) 601 format("

This page is located at http://www.fcc.gov/mb/audio/bickel/doppler-shift.html." &"

") return end C ====================================================================== SUBROUTINE ASD_END(luout) integer luout C This subroutine sets up the HTML code C for the normal ASD Internet page ending. write(luout,1) write(luout,2) write(luout,3) write(luout,4) write(luout,5) write(luout,6) write(luout,7) write(luout,8) write(luout,9) write(luout,10) write(luout,11) write(luout,12) write(luout,13) write(luout,14) write(luout,15) write(luout,16) write(luout,17) write(luout,18) write(luout,19) write(luout,20) write(luout,21) write(luout,22) write(luout,23) write(luout,24) write(luout,25) write(luout,26) write(luout,27) write(luout,28) write(luout,29) write(luout,30) write(luout,31) write(luout,32) write(luout,33) write(luout,34) write(luout,35) write(luout,36) write(luout,37) write(luout,38) write(luout,138) write(luout,139) write(luout,140) write(luout,141) write(luout,142) write(luout,143) write(luout,144) write(luout,145) write(luout,146) write(luout,147) write(luout,148) write(luout,149) write(luout,150) write(luout,151) write(luout,152) write(luout,39) write(luout,40) write(luout,41) write(luout,42) write(luout,43) write(luout,44) write(luout,45) write(luout,46) write(luout,47) write(luout,48) write(luout,50) write(luout,51) write(luout,52) 1 format("
"/) 2 format("

ASD Information:

") 50 format("

"/) 52 format(" "//) Return C END OF Subroutine asd_end END C ===================================================================== HTML:

      Metric Units (POST method submission)

      Frequency (MHz)

      Velocity in kilometers per hour      

         
  • + velocity = approaching radio source      
  • - velocity = receding from radio source

      Metric units (units=1)

       




      English Units (GET method submission)

      Frequency (MHz)

      Velocity in Miles per hour      

         
  • + velocity = approaching radio source      
  • - velocity = receding from radio source

      English units (units=2)