5 - 5 /. &M. If 
 
 A/2-7<f 
 
 ft !b 
 
 
 NOAA Eastern Region Computer Programs 
 and Problems NWS ERCP - No. 16 
 
 r 
 
 RANP: 
 
 Stability Analysis Plot Program 
 
 Hugh M. Stone 
 
 National Weather Service Eastern Region 
 Garden City, New York 
 
 Scientific ‘Services Division 
 Eastern Region Headquarters 
 February 1984 
 
 AUG 1 7 1984 
 
 ILLINOiS STATE WATER SUPiVEV HORARY 
 
 U.S. DEPARTMENT OF 
 COMMERCE 
 
 / 
 
 National Oceanic and 
 Atmospheric Administration 
 
 / 
 
 National Weather 
 Service 
 
NOAA TECHNICAL MEMORANDUM 
 
 National Weather Service, Eastern Region Computer Programs and Problems 
 
 The Eastern Region Computer Programs and Problems (ERCP) series is a sub¬ 
 set of the Eastern Region Technical Memorandum series. It will serve as 
 the vehicle for the transfer of information about fully documented AFOS 
 application programs. The format ERCP - No. 1 will serve as the model 
 for future issuances in this series. 
 
 1 An AFOS version of the Flash Flood Checklist. Cynthia M. Scott, 
 
 March 1981. (PB81 211252). 
 
 2 An AFOS Applications Program to Compute Three-Hourly Stream Stages. 
 
 Alan P. Blackburn, September 1981. (PB82 156886). 
 
 3 PUPPY (AFOS Hydrologic Data Reporting Program). Daniel P. Provost, 
 
 December 1981. (PB82 199720). 
 
 4 Special Search Computer Program. Alan P. Blackburn, April 1982. 
 
 (PB83 175455). 
 
 5 Conversion of ALEMBICS Workbins. Alan P. Blackburn, October 1982. 
 
 (PB83 138313). 
 
 6 Real-Time Quality Control of SAOs. John A. Billet, January 1983. 
 
 (PB83 166082). 
 
 7 Automated Hourly Weather Collective from HRR Data Input. Lawrence 
 
 Cedrone, January 1983 (PB83 167122). 
 
 8 Decoders for FRH, FTJ and FD Products. Cynthia M. Scott, February 1983. 
 (PB83 176057). 
 
 9 Stability Analysis Program. Hugh M. Stone, March 1983. (PB83 197947). 
 
 10 Help for AFOS Message Comp. Alan P. Blackburn, May 1983. (PB83 213561). 
 
 11 Stability and Other Parameters from the First Transmission RAOB Data. 
 
 Charles D. Little, May 1983. (PB83 220475). 
 
 12 TERR, PERR, and BIGC: Three Programs to Compute Verification Statistics 
 
 Matthew R. Peroutka, August 1983. (PB84 127521). 
 
 13 Decoder for Manually Digitized Radar Observations. Matthew R. Peroutka, 
 
 June 1983. (PB84 127539). 
 
 14 Slick and Quick Data Entry for AFOS Era Verification (AEV) Program. 
 
 Alan P. Blackburn, December 1983. (PB84 138726). 
 
 15 MDR--Processing Manually Digitized Radar Observations. Matthew R. 
 Peroutka, November 1983. 
 
RANP 
 
 STABILITY ANALYSIS PLOT PROGRAM 
 
 Hugh M. Stone 
 
 Scientific Services Division 
 National Weather Service Eastern Region 
 Garden City, New York 
 
 I. General Information 
 
 A. Summary 
 
 New indicators of static stability, the energy indices Ell and EI2, are 
 now available (Stone, 1983) and may be computed with the AFOS application 
 program RAN. These indices, formerly called B1 and B2, are based on the 
 change of kinetic energy of a parcel as it moves upward through the atmos¬ 
 phere entraining environmental air during its ascent. Unlike the more 
 traditional stability indices, i.e. Lifted, K, Showalter, etc., which use 
 only a few levels of the sounding, the energy indices utilize all the 
 information in significant level sounding (UJ1) and should provide a 
 more accurate measure of static stability. 
 
 The RAN program computes the Ell and EI2 indices, the equilibrium level, 
 a variety of other traditional stability indices, and several other 
 parameters, which can be derived from significant level raob data; the 
 computation is done for a single raob station. For many purposes, the 
 geographical distribution of these parameters is more important than a 
 point value. The RANP program does the same computation as RAN, but 
 instead of using a single raob station, the computation may be done for 
 a group of stations specified in a list. The output consists of tabulated 
 values for 12 parameters and a graphic with plotted values of two of the 
 most important parameters, the Ell index and the equilibrium level EL. 
 
 A switch has been provided so RANP can also be run for a single station 
 specified in the RUN line. In this case, the output is identical to that 
 provided by the RAN program and provides a detailed analysis of the 
 significant level raob sounding. The RAN program may therefore be 
 replaced by RANP. 
 
 RANP was developed to run on an Eclipse S/230 minicomputer. Language used 
 is Data General FORTRAN IV. 
 
 II. Application 
 
 A. Program Description 
 
 The motivation for the development of the energy indices Ell and EI2 
 (formerly B1 and B2) and the method of computation has already been 
 given in ERCP No. 9 (Stone, 1983). Experience with these indices during 
 the 1983 convective season suggested that the entrainment rate used in 
 the computation was excessive. The Ell index had a bias toward stable 
 
 - 1 - 
 
conditions with convection occasionally beginning with values of Ell as 
 low as -80. Likewise, equilibrium levels seemed to be too low. 
 
 Changes in the entrainment rate have now been made to help correct these 
 defects. The method of computation is still the same except that the 
 entrainment rate for the energy index computation has been reduced from 
 100 percent to 60 percent. This means a 60 percent increase in mass of 
 the parcel over a 500mb ascent rather than the doubling of mass used 
 previously. We are still not sure this is the best entrainment rate and 
 it may need to be changed again. 
 
 Changing the entrainment rate from 100 to 60 percent usually has the 
 effect of making unstable indices more unstable, slightly stable indices 
 become unstable, and very stable indices can go either way depending on 
 the moisture distribution. 
 
 The equilibrium level is now computed separately using a zero entrainment 
 rate. The interior portions of large thunderstorms that may produce 
 severe weather are virtually unaffected by the entrainment process. 
 
 Since the radar tops of large storms are compared to the equilibrium level 
 to assess their potential for severe weather, we believe the zero entrain¬ 
 ment rate is appropriate. 
 
 The EI2 index was previously defined (Stone, 1983) as the change in 
 kinetic energy of a parcel as it moves from the level of maximum 
 instability (PMAX) to the equilibrium level. This definition is still 
 correct provided that the"equi1ibrium level" is computed with entrainment; 
 it is not the equilibrium level EL that appears in the output. 
 
 The equilibrium level EL is first determined in pressure units then the 
 mandatory level raob transmission (US1) is used to interpolate a value 
 in feet, which makes it easier to compare to radar tops which are also 
 reported in feet. If the mandatory levels are missing for any reason, 
 the interpolation is done using the U.S. Standard Atmosphere, with the 
 value followed by an "E" in the output to indicate estimated. The same 
 procedure is used for tropopause height which is read from the mandatory 
 level transmission and converted to feet for comparison to the equilibrium 
 level. Both equilibrium level and tropopause height in hundreds of feet 
 are given in the AF0S product WRKTPC (figure 1). 
 
 The following parameters are included in the AF0S product WRKTPC: 
 
 P0 surface pressure (mb) 
 
 PMAX pressure (mb) of highest wet bulb potential temperature 
 in the lowest 150mb of the sounding. Starting point 
 of parcel ascent. 
 
 EL Equilibrium level in (mb) and (Ft. X 10 2 ) 
 
 TR0P Tropopause level (Ft. X 10^) 
 
 Ell Energy Index 1. Change in kinetic energy of parcel 
 moving from level PMAX to 400mb level. (J/Kg X 10) 
 
 EI2 Energy Index 2. Change in kinetic energy of parcel 
 moving from level PMAX to the "equilibrium level 
 computed with entrainment" (J/Kg X 10) 
 
 - 2 - 
 
LI 
 
 Lifted Index (°C) 
 
 
 KI 
 
 K Index (°C) 
 
 
 SWI 
 
 Showalter Index (°C) 
 
 
 CCL 
 
 Convective Condensation Level (mb) 
 
 
 ETCCL 
 
 Amount of low level heating required for 
 
 surface parcel to 
 
 
 ascend dry adiabatical ly to CCL level. 
 
 (J/Kg X 10) 
 
 Missing values indicated by 
 
 Two of the most important parameters, the energy indexEIland the equili¬ 
 brium level EL in hundreds of feet, are plotted on the AFOS graphic 
 NMCGPHEIS (figure 2). Ell appears to the upper right of the station circle 
 and EL to the upper left. Positive (unstable) values of Ell are plotted 
 with a solid station circle and negative (stable) values with an open 
 station circle. The graphic EIS uses map background 2, North America. 
 
 A zoom of 4:1 or more must be used. The raob stations used in the computa¬ 
 tion must be listed in the RDOS file STNSl (figure 3). 
 
 If RANP is run for a single station, the output goes into AFOS products 
 WRKTPA (figure 4) and WRKTPB (figure 5). These are the same products 
 created by the program RAN and have the same format, which was explained 
 in ERCP No. 9 (Stone, 1983). 
 
 B. Machine Requirements 
 
 Using a list of 32 raob stations, covering approximately the eastern third 
 of the United States, the total runtime is usually around 8 minutes. Two 
 FORTRAN channels are open during the program run. One RDOS channel is 
 used at the end of the computation to insert headings and endings for the 
 AFOS alphanumeric products. Disk space required for the program RANP.SV is 
 122 RDOS blocks with an accompanying overlay file RANP.OL occupying 28 RDOS 
 blocks. 
 
 C. Database 
 
 Products that are referenced: 
 
 1. CCCSGLXXX : significant level raob soundings listed in file STNSl or 
 given in run line. 
 
 2. CCCMANXXX : corresponding mandatory level raob soundings. If these 
 are not available for any reason, the program will still run, but a 
 U.S. Standard Atmosphere will be assumed in the computation of 
 equilibrium level in feet and tropopause height will be missing. 
 
 Files/products that are created: 
 
 1. INDEXX : temporary storage file for data that are eventually stored 
 as AFOS products WRKTPA, WRKTPC, or WRKTPD. INDEXX is deleted at the 
 end of the computation. 
 
 2. INDEXY : temporary storage for data that are eventually stored as AFOS 
 product WRKTPB. INDEXY is deleted at the end of the computation. 
 
 - 3 - 
 
3. HMSGPH.01 : temporary storage file for graphics data that are eventually 
 stored as AFOS product NMCGPHEIS. HMSGPH.01 is deleted at the end of 
 the computation. 
 
 D. Structure of the Software 
 
 RANP is the main program. The program checks the system clock to determine 
 which raob data to process. After 00Z, the program uses 00Z data from the 
 current date; likewise, after 12Z, 12Z data is used. Sufficient time must 
 be allowed after these cutoff times for the new raob data to arrive in the 
 database. The database may be checked prior to beginning the computation 
 by using the global switch "C"; see Part III, Section B. The computation 
 is done for each raob station listed in the file STNS1 or for the single 
 station specified in the run line. If the computation is done for a single 
 station, the date and time of the raob report are not checked for currency. 
 
 All of the computations are accomplished by a series of calls to various 
 subroutines. Interpolationsand extrapolations of temperature and dewpoint 
 in all of the subroutines are done assuming a linear variation of the 
 quantity with the logarithm of pressure. At the end of the computation, 
 the alert light is turned on and all temporary files are deleted. 
 
 Sixteen of the subroutines (indicated by *) are also common to the program 
 RAN (Stone, 1983), but most of them have been changed or corrected and 
 are repeated here for reference. 
 
 The function of the various subroutines are as follows: 
 
 PECOS * 
 
 Reads the temperature portion of the UJ1 raob specified in the array JST, 
 utilizing the AFREAD subroutine (Peroutka, 1981). 
 
 TEMPI * 
 
 This subroutine called by DECOS for decoding temperature and dewpoint. 
 INDX1 * 
 
 Computes lifted index, K index, and Showalter index. When surface pressure 
 is less than 850mb, K and Showalter index cannot be computed. This will 
 be indicated by 999 on the output. 
 
 BNDX * 
 
 Determines pressure level PMAX that has the highest wet bulb potential 
 temperature in the lowest 150mb of the sounding. If an identical maximum 
 value is found at 2 levels, the lowest level (highest pressure) is selected 
 for PMAX. A modified raob is created which has its base at level PMAX and 
 an additional significant level is added at level PX = 400mb, if a signi¬ 
 ficant level does not already exist there. If the raob terminates below 
 level PX, but within 50mb of PX, a level PX is extrapolated, so that the 
 index Ell may still be computed. 
 
 - 4 - 
 
RANN2 * 
 
 The principal subroutine, does all the energy area computations as the 
 parcel is raised from the bottom to the top of the sounding. The first 
 half of the subroutine raises a parcel along a dry adiabat from PMAX to 
 the lifting condensation level (LCL). Since entrainment is allowed during 
 the dry ascent, the LCL is usually slightly higher than it would be if 
 there were no entrainment. 
 
 The second half of the subroutine continues a moist ascent above the LCL. 
 Entrainment is continued all the way using the method proposed by Austin 
 (1948). 
 
 A 50mb step is used for the parcel ascent, but if a significant level is 
 present within the next 50mb, the step is reduced to terminate at that 
 level. Steps are likewise shortened, if the energy area changes sign, 
 or if the LCL is reached during the next 50 millibars. The 50mb step 
 was selected because it gives sufficient accuracy and is economical in 
 computer time. On rare occasions when the parcel temperature and environ¬ 
 mental temperature are very close over a large depth of the atmosphere, 
 the 50mb step may be unsatisfactory. In such a case, the computation is 
 restarted using a lOmb step. 
 
 The stability indices Ell (Bl) and EI2 (B2) are computed after the ascent 
 has been completed. The level of free convection is also determined here. 
 
 The subroutine RANN2 is called three times: 
 
 (1) The first call calculates the variable ETCCL, which represents 
 the amount of low level heating required for a surface parcel to 
 reach the convective temperature and then move dry adiabatically 
 to the convective condensation level, CCL. No entrainment is 
 allowed in the calculation of ETCCL. 
 
 (2) The second call computes equilibrium level with zero entrainment. 
 
 (3) The third call computes the energy indices, the lifting condensation 
 level LCL, and the level of free convection LFC. Sixty percent 
 entrainment is normally used here. 
 
 CCL1 * 
 
 Computes the convective condensation level CCL. 
 
 MODRB * 
 
 Called immediately after CCL1 is finished to modify the original raob so 
 ETCCL can be computed. 
 
 WOBF SATLFT TCQNOF 1 4HR0F DPTOF VAPFW * 
 
 All thermodynamic computations are done using these six subroutines from 
 the National Severe Storms Forecast Center, MO. (Doswell, et al., 1982). 
 
 - 5 - 
 
ITCVT * 
 
 Converts ASCII characters to integer values. This is a modification of 
 function INTCVT in AFREAD.LB (Peroutka, 1981). 
 
 FTCVT * 
 
 Converts ASCII characters to floating point values. This is a modification 
 of function FLTCVT in AFREAD.LB (Peroutka, 1981). 
 
 PULYR * 
 
 Determines all potential (convective) unstable layers and computes lapse 
 rate of wet bulb potential temperature in the layers and amount of lifting 
 required to achieve saturation at the base and top pressure of the layer. 
 
 TPA 
 
 Outputs data for single station analysis to INDEXX file, which is later 
 stored as AFOS product WRKTPA. 
 
 TPB 
 
 Calls subroutine PULYR to determine potentially unstable layers with 
 results output to INDEXY file, for subsequent transfer to AFOS product 
 WRKTPB. 
 
 FTCV 
 
 This function is used for reading numerical data input by switches in the 
 RUN line. It is a modification of function FLTCVT in AFREAD.LB (Peroutka, 
 1981). 
 
 DECOM 
 
 Reads the mandatory level raob data, US1, utilizing the AFREAD subroutine 
 (Peroutka, 1981). 
 
 IVCK 
 
 This function, used by DECOS and DECOM, checks the date time group of the 
 raob to assure that the correct version is being used. 
 
 WND 
 
 Used by DECOM for decoding winds of US1 raob data. 
 HEIGHT 
 
 Computes height of an arbitrary pressure by interpolating or extrapolating 
 heights of mandatory levels. 
 
 - 6 - 
 
JREAL 
 
 Rounds a floating point number to an integer. 
 STLOC 
 
 This uses the subroutine BNSCH to search the station directory file to 
 find X and Y coordinates of each raob station for plotting on a graphic. 
 
 BNSCH 
 
 Subroutine for binary search of data in the station directory file. 
 (This program written by Rich Thomas, AOD). 
 
 GPT 
 
 Creates a graphic displaying geographical distribution of Ell and EL 
 using subroutines given by MacDonald (1981). 
 
 ISCR 
 
 Converts a positive or negative integer of up to three digits to ASCII 
 characters. This is used to convert Ell and EL for plotting on graphics 
 
 JSCR 
 
 Converts a positive two digit integer to ASCII characters. This is used 
 to get date/time numbers for plotting on graphics. 
 
 MTITL 
 
 Makes date/time heading for graphics and converts number of month to 
 three letter abbreviation in ASCII characters. 
 
 The complete program would not fit in memory without the use of overlays 
 
 If the computation is done for the list of raob stations in file STNS1, 
 the following overlays are used: 
 
 OV0 - Subroutines STLOC, BNSCH 
 
 0V1 - Subroutines GPT, ISCR, JSCR, MTITL. 
 
 These are used for creating the graphic EIS. 
 
 If the computation is done for a single raob station, the following 
 overlays are used: 
 
 0V2 - Subroutines TPB, PULYR 
 0V3 - Subroutine TPA 
 
 These are used to output results to AFOS products WRKTPB and WRKTPA. 
 
 - 7 - 
 
Ill Program Reference 
 
 A. Preparation 
 
 The following AFOS products must be added to the database (CCC is the 
 local node): 
 
 CCCWRKTPA 
 
 CCCWRKTPB 
 
 CCCWRKTPC 
 
 CCCWRKTPD 
 
 NMCGPHEIS 
 
 The program RANP.SV, its overlay file RANP.OL, and the list of raob 
 stations in file STNS1 must be on the main disk DP0 or DP0F with a 
 link to DP0. 
 
 The file STNS1 (figure 3) may contain up to 50 raob stations (significant 
 level AFOS identifiers). The list is read using the FORMAT (5A2). If 
 a list of more than 50 raob stations is needed, the parameter "NRAOB" 
 must be changed in the main program RANP and the subroutines GPT and 
 STLOC. 
 
 Significant level raob data for all stations specified in STNS1 must 
 be in the database. Corresponding mandatory level data should also be 
 in the database; if it is missing, the U.S. Standard Atmosphere is 
 assumed for the computation of equilibrium level in feet. 
 
 B. Initiating the Program 
 
 To run the program at the ADM to compute stability indices for the 
 list of stations in file STNS1, type: 
 
 RUN:RANP 
 
 A switch is available for changing the entrainment rate from its basic 
 value of 60 percent. For example, if you wished to compare values of 
 Ell to values of B1 which used 100 percent entrainment (Stone, 1983), 
 you could type: 
 
 RUN:RANP 100/E 
 
 We recommend that this switch not be normally used. 
 
 A global switch "C" may be used to check the database for the avail¬ 
 ability of significant level raobs. If a new raob is not available, 
 or if the raob is not in proper format, or if it cannot be read for any 
 reason, a message indicating the trouble is output to AFOS product 
 WRKTPD (figure 6). To check the database at the ADM console, type: 
 
 RUN:RANP/C 
 
 - 8 - 
 
This check takes approximately 1% minutes for 32 raob stations. 
 
 A global switch "S" may be used to obtain a detailed raob analysis for 
 a single station. In this case, at the ADM, type: 
 
 RUN:RANP/S CCCSGLXXX 
 
 The local switch "E" for changing the entrainment rate may also be 
 used in combination with the "S" switch. Running time for the single 
 station computationis usually around 40 to 60 seconds. 
 
 C. Output 
 
 The alert light is turned on when the program is finished. Output goes 
 to various AFOS products depending on the global switches used: 
 
 SWITCH OUTPUT 
 
 None WRKTPC and EIS 
 
 C WRKTPD 
 
 S WRKTPA and WRKTPB 
 
 D. Cautions or Restrictions on Use 
 
 If significant level raob data is missing, or not in proper format, or 
 raob terminates below 450mb, or a dewpoint is missing below the 700mb 
 level, the computation is not performed and a message indicating the 
 trouble will appear in AFOS product WRKTPC or WRKTPA. This situation 
 will be indicated on the EIS graphic by a station circle with an "M" 
 inside it. 
 
 If mandatory level raob data are missing or not in proper format, a 
 message indicating this is printed on the Dasher. A U.S. Standard 
 Atmosphere is then assumed and the computation continues. 
 
 As the program works its way through the list of raob stations in file 
 STNS1, numbers appear on the Dasher indicating which raob data is 
 currently being processed, i.e. "9" would indicate that data for the 
 ninth station on the list is currently being computed. A mistake in 
 the significant level raob data, such as a completely unrealistic 
 temperature for some level, can cause the program to hang up. This 
 is a very rare event, but if it happens, the numbers printed on the 
 Dasher indicate which raob is causing the trouble. The report can 
 either be corrected or purged and the program restarted. 
 
 When printing any of the alphanumeric products WRKTPA, B, C, or D 
 from the ADM using the command "PRINT:", an extraneous line of 
 printing frequently appears on the PPM copy. This problem will hope¬ 
 fully be corrected by AFOS Version AOD 10.00. Meanwhile, a perfect 
 copy can be obtained by using the command, "PRINT:WRKTPA", "B", "C", 
 or "D". 
 
 - 9 - 
 
E. Load Line 
 
 RLDR/P RANP DECOS TEMPI RANN2 CCL1 MODRB INDX1 BNDX UOBF SATLFT TCOHOF 
 UMROF DPTOF VAPFU DECOM IVCK UND HEIGHT JREAL FTCV 
 CTPB PULYR, TPA, STLOC BNSCH, GPT ISCR JSCR MTITL] 
 
 OUT AFREAD.LB ITCVT FTCVT TOP.LB AG.LB UTIL.LB FORT.LB 
 
 F. Program Listings: 
 
 See pages 16 through 55. 
 
 Subroutine Index on page 55. 
 
 - 10 - 
 
ACKNOWLEDGEMENT 
 
 Thanks to Cynthia Scott for programming advice, and Fortune Vilcko for 
 
 the typing of this manuscript. 
 
 REFERENCES 
 
 Austin, J.M., 1948: A Note on Cumulus Growth in a Nonsaturated Environment, 
 Journal of Meteorology , 5, 103-107. 
 
 Doswell, C.A., J. T. Schaefer, D. W. McCann, T. W. Schlatter, and H. B. Wobus, 
 1982: Thermodynamic Analysis Procedures at the National Severe Storms 
 Forecast Center, Preprints, 9th Conf. Weather Forecasting and Analysis , 
 
 Amer. Meteor. Soc., Seattle, 304-309. 
 
 MacDonald, A.E., 1981: AFOS Graphics Creation from FORTRAN, NOAA Western 
 Region Computer Programs and Problems NWS WRCP-No. 18 , National Weather 
 Service, Salt Lake City, UT. 
 
 Peroutka, M., 1981: Accessing the AFOS Database, NOAA Western Region Computer 
 Programs and Problems NWS WRCP-No. 23 , National Weather Service, Salt 
 Lake City, UT. 
 
 Stone, H.M., 1983: Stability Analysis Program, NOAA Eastern Region Computer 
 Programs and Problems NWS ERCP-No. 9, National Weather Service, Garden 
 City, NY 
 
 - 11 - 
 
RAOB INDICES 
 
 FOR 
 
 2/ 2/84 
 
 12Z DP = 
 
 50. 
 
 EFF = 
 
 60 
 
 I. 
 
 PX = 
 
 400. 
 
 
 ENERGY 
 
 UNITS : J/KG X 10 
 
 EL 8. TROP IN 
 
 HNDS FT 
 
 
 
 
 
 
 
 STN 
 
 P0 
 
 PMAX 
 
 EL(MB) ! 
 
 EL(FT) TROP 
 
 Ell 
 
 E12 
 
 LI 
 
 KI 
 
 SUI 
 
 CCL 
 
 ETCCL STN 
 
 1 
 
 CAR 
 
 995. 
 
 845. 
 
 845. 
 
 47. 286. 
 
 -146. 
 
 999. 
 
 26. 
 
 8. 
 
 11. 
 
 640. 
 
 111. CAR 
 
 2 
 
 PUM 
 
 1021. 
 
 871. 
 
 871. 
 
 41. 329. 
 
 -228. 
 
 999. 
 
 27. 
 
 -21. 
 
 17. 
 
 495. 
 
 299. PUM 
 
 3 
 
 ALB 
 
 1017. 
 
 907. 
 
 907. 
 
 32. 358. 
 
 -290. 
 
 999. 
 
 33. 
 
 -24. 
 
 20. 
 
 485. 
 
 332. ALB 
 
 4 
 
 BUF 
 
 995. 
 
 845. 
 
 845. 
 
 50. 364. 
 
 -217. 
 
 999. 
 
 22. 
 
 -23. 
 
 16. 
 
 633. 
 
 164. BUF 
 
 5 
 
 DAY 
 
 982. 
 
 832. 
 
 832. 
 
 54. 380. 
 
 -164. 
 
 999. 
 
 17. 
 
 -11 . 
 
 12. 
 
 616. 
 
 127. DAY 
 
 6 
 
 PIT 
 
 979. 
 
 829. 
 
 829. 
 
 55. 366. 
 
 -207. 
 
 999. 
 
 19. 
 
 -26. 
 
 17. 
 
 554. 
 
 211. PIT 
 
 7 
 
 CHH 
 
 1023. 
 
 873. 
 
 873. 
 
 41. 307. 
 
 -242. 
 
 999. 
 
 25. 
 
 -48. 
 
 17. 
 
 456. 
 
 317. CHH 
 
 8 
 
 ACY 
 
 1026. 
 
 876. 
 
 876. 
 
 41. 376. 
 
 -295. 
 
 999. 
 
 29. 
 
 -25. 
 
 20. 
 
 504. 
 
 323. ACY 
 
 
 UAL 
 
 NEU 
 
 RAOB NOT AVAILABLE 
 
 
 
 
 
 
 
 
 10 
 
 I AD 
 
 1016. 
 
 866. 
 
 866. 
 
 44. 372. 
 
 -265. 
 
 999. 
 
 27. 
 
 -18. 
 
 18. 
 
 536. 
 
 293. IAD 
 
 11 
 
 HTS 
 
 991. 
 
 850. 
 
 850. 
 
 49. 999. 
 
 -199. 
 
 999. 
 
 18. 
 
 -17. 
 
 13. 
 
 576. 
 
 171. HTS 
 
 12 
 
 HAT 
 
 1028. 
 
 1014. 
 
 1014. 
 
 4. 379. 
 
 -316. 
 
 999. 
 
 25. 
 
 -39. 
 
 22. 
 
 505. 
 
 338. HAT 
 
 13 
 
 GSO 
 
 993. 
 
 843. 
 
 843. 
 
 52. 365. 
 
 -207. 
 
 999. 
 
 20. 
 
 -15. 
 
 15. 
 
 539. 
 
 212. GSO 
 
 14 
 
 CHS 
 
 1024. 
 
 1012. 
 
 1012. 
 
 4. 371. 
 
 -279. 
 
 999. 
 
 19. 
 
 -24. 
 
 16. 
 
 558. 
 
 219. CHS 
 
 15 
 
 BNA 
 
 999. 
 
 849. 
 
 849. 
 
 50. 377. 
 
 -192. 
 
 999. 
 
 16. 
 
 -22. 
 
 13. 
 
 574. 
 
 164. BNA 
 
 16 
 
 AHN 
 
 994. 
 
 844. 
 
 844. 
 
 52. 359. 
 
 -204. 
 
 999. 
 
 17. 
 
 -29. 
 
 15. 
 
 552. 
 
 184. AHN 
 
 17 
 
 AYS 
 
 1019. 
 
 1000. 
 
 1000. 
 
 7. 344. 
 
 -264. 
 
 999. 
 
 20. 
 
 -13. 
 
 14. 
 
 545. 
 
 210. AYS 
 
 18 
 
 BVE 
 
 1021. 
 
 1000. 
 
 1000. 
 
 4.E 999. 
 
 -180. 
 
 999. 
 
 12. 
 
 5. 
 
 15. 
 
 760. 
 
 62. BVE 
 
 19 
 
 JAN 
 
 1011. 
 
 861. 
 
 861. 
 
 44.E 999. 
 
 -228. 
 
 999. 
 
 20. 
 
 -23. 
 
 15. 
 
 490. 
 
 244. JAN 
 
 20 
 
 CKL 
 
 1006. 
 
 856. 
 
 856. 
 
 46.E 999. 
 
 -213. 
 
 999. 
 
 19. 
 
 -20. 
 
 14. 
 
 570. 
 
 182. CKL 
 
 21 
 
 AQQ 
 
 1023. 
 
 873. 
 
 873. 
 
 41.E 999. 
 
 -222. 
 
 999. 
 
 18. 
 
 -26. 
 
 14. 
 
 521. 
 
 211. AQQ 
 
 22 
 
 TBU 
 
 1020. 
 
 929. 
 
 929. 
 
 24.E 999. 
 
 -142. 
 
 999. 
 
 14. 
 
 -4. 
 
 13. 
 
 636. 
 
 130. TBU 
 
 23 
 
 EYU 
 
 1019. 
 
 869. 
 
 869. 
 
 42.E 999. 
 
 -91 . 
 
 999. 
 
 5. 
 
 7. 
 
 14. 
 
 766. 
 
 60. EYU 
 
 24 
 
 PBI 
 
 1020. 
 
 1000. 
 
 783. 
 
 69.E 999. 
 
 -105. 
 
 0. 
 
 6. 
 
 -1. 
 
 6. 
 
 715. 
 
 114. PBI 
 
 25 
 
 SSM 
 
 989. 
 
 839. 
 
 839. 
 
 49. 346. 
 
 -160. 
 
 999. 
 
 21. 
 
 7. 
 
 14. 
 
 637. 
 
 148. SSM 
 
 26 
 
 FNT 
 
 988. 
 
 904. 
 
 904. 
 
 31. 369. 
 
 -202. 
 
 999. 
 
 19. 
 
 -11 . 
 
 12. 
 
 649. 
 
 130. FNT 
 
 27 
 
 GRB 
 
 986. 
 
 836. 
 
 836. 
 
 50. 372. 
 
 -184. 
 
 999. 
 
 26. 
 
 -31 . 
 
 16. 
 
 543. 
 
 200. GRB 
 
 28 
 
 PIA 
 
 987. 
 
 837. 
 
 821. 
 
 56. 355. 
 
 -117. 
 
 0. 
 
 16. 
 
 5. 
 
 8. 
 
 644. 
 
 92. PIA 
 
 29 
 
 SLO 
 
 993. 
 
 843. 
 
 843. 
 
 50. 376. 
 
 -138. 
 
 999. 
 
 15. 
 
 -0. 
 
 11. 
 
 598. 
 
 134. SLO 
 
 30 
 
 UMN 
 
 961. 
 
 811. 
 
 811. 
 
 60.E 999. 
 
 -86. 
 
 999. 
 
 14. 
 
 5. 
 
 5. 
 
 644. 
 
 114. UMN 
 
 31 
 
 LIT 
 
 997. 
 
 847. 
 
 701. 
 
 99.E 999. 
 
 -115. 
 
 -5. 
 
 20. 
 
 -5. 
 
 7. 
 
 522. 
 
 222. LIT 
 
 32 
 
 LCH 
 
 1020. 
 
 897. 
 
 897. 
 
 33.E 999. 
 
 -133. 
 
 999. 
 
 14. 
 
 19. 
 
 11 . 
 
 582. 
 
 205. LCH 
 
 Figure 1. Example of WRKTPC 
 
 - 12 - 
 
PUMSGLCAR 
 
 PUMSGLPUM 
 
 ALBSGLALB 
 
 BUFSGLBUF 
 
 CLESGLDAY 
 
 PITSGLPIT 
 
 BOSSGLCHH 
 
 PHLSGLACY 
 
 UBCSGLUAL 
 
 UBCSGLIAD 
 
 CRUSGLHTS 
 
 RDUSGLHAT 
 
 RDUSGLGSO 
 
 CAESGLCHS 
 
 MEMSGLBNA 
 
 ATLSGLAHN 
 
 ATLSGLAYS 
 
 NEUSGLBVE 
 
 JANSGLJAN 
 
 BHMSGLCKL 
 
 BHMSGLAQQ 
 
 MI ASGLTBU 
 
 MIASGLEYLJ 
 
 MIASGLPBI 
 
 ARBSGLSSM 
 
 ARBSGLFNT 
 
 MKESGLGRB 
 
 CHISGLPIA 
 
 CHISGLSLO 
 
 STLSGLUMN 
 
 LITSGLLIT 
 
 NEUSGLLCH 
 
 Figure 2. Example of EIS graphic. 
 
 Figure 3. Example 
 of file STNS1. 
 
 - 13 - 
 
RAOB ANALYSIS FOR PBI 2/ 2/84 12Z UNITS : J/KG X 10 
 
 ASSUMED EFF = 60. PERCENT ENTRAINMENT PER 500MB ASCENT, FOR Ell, EI2 8, EL60 
 ASSUMED EFF = 0. PERCENT ENTRAINMENT PER 500MB ASCENT, FOR EL 
 
 P0 = 1020. PTOP = 100. PMAX (MAX INSTABILITY) = 1000. PX => 400. 
 
 EL = 783. MB ( 69.E HND FT) LCL = 898. LFC = 865. 
 
 BASED ON PARCEL MVG FM LVL -PMAX- 
 
 E12 = 
 
 0. 
 
 ENERGY PMAX TO EL60 
 
 Ell 
 
 = 
 
 -105. 
 
 ENERGY PMAX TO PX 
 
 EI2P = 
 
 3. 
 
 POSITIVE PART 
 
 
 EI IP 
 
 = 
 
 3. 
 
 POSITIVE 
 
 PART 
 
 EI2N = 
 
 -2. 
 
 NEGATIVE PART 
 
 
 EI IN 
 
 = 
 
 -108. 
 
 NEGATIVE 
 
 PART 
 
 PI 
 
 P2 
 
 ENERGY GAINED 
 
 (LOST) 
 
 IN 
 
 LAYER 
 
 
 
 1000. 
 
 865. 
 
 -2. 
 
 
 
 
 
 
 
 865. 
 
 784. 
 
 3. 
 
 
 
 
 
 
 
 784. 
 
 100. 
 
 -814. 
 
 
 
 
 
 
 
 EX - 
 
 -106. 
 
 
 
 
 
 
 
 
 LI - 
 
 6. KI 
 
 = -1. SUI = 
 
 6. 
 
 
 
 
 
 
 CCL = 
 
 715. ETCCL = 114. CONV 
 
 TEMP = : 
 
 34. 
 
 7 ( 94. 
 
 5F ) UAVG 
 
 = 7.73 G/KG 
 
 DEEPEST POT. UNSTABLE LYR : 1000. - 789. MB, TULAPSE = 3.6 SEE URKTPB 
 
 Figure 4. Example of WRKTPA 
 
 POTENTIAL (CONVECTIVE) UNSTABLE LAYERS FOR PBI 2/ 2/84 12Z 
 
 PI 
 
 P2 
 
 429. 
 
 392. 
 
 615. 
 
 453. 
 
 1000. 
 
 789. 
 
 SIGNIF 
 
 ICANT LEVELS 
 
 P 
 
 T 
 
 100. 
 
 -70.3 
 
 108. 
 
 -72.7 
 
 126. 
 
 -65.3 
 
 259. 
 
 -48.3 
 
 300. 
 
 -39.7 
 
 349. 
 
 -32.5 
 
 360. 
 
 -32.9 
 
 392. 
 
 -28.7 
 
 429. 
 
 -22.9 
 
 453. 
 
 -20.1 
 
 500. 
 
 -14.9 
 
 615. 
 
 -4.3 
 
 621. 
 
 -4.7 
 
 630. 
 
 -4. 1 
 
 729. 
 
 6.4 
 
 775. 
 
 5.6 
 
 789. 
 
 0.6 
 
 805. 
 
 2.4 
 
 850. 
 
 5.8 
 
 1000. 
 
 17.4 
 
 1015. 
 
 15.8 
 
 1020. 
 
 12.2 
 
 
 Figure 
 
 DP 
 
 TULAPSE 
 
 37. 
 
 3.3 
 
 162. 
 
 0.2 
 
 211. 
 
 3.6 
 
 TD 
 
 TU 
 
 -100.3 
 
 30.7 
 
 -102.7 
 
 28.7 
 
 -95.3 
 
 28.2 
 
 -78.3 
 
 18.2 
 
 -69.7 
 
 17.8 
 
 -62.5 
 
 16.7 
 
 -62.9 
 
 15.6 
 
 -58.7 
 
 15.0 
 
 -26.0 
 
 16.2 
 
 -25. 1 
 
 15.8 
 
 -16.3 
 
 16. 1 
 
 -5.4 
 
 16. 1 
 
 -13.7 
 
 13.7 
 
 -23. 1 
 
 12.2 
 
 -23.6 
 
 11.6 
 
 -24.4 
 
 9. 1 
 
 -29.4 
 
 5.8 
 
 2.0 
 
 11.9 
 
 5.5 
 
 12.7 
 
 10.4 
 
 13.3 
 
 11.1 
 
 12.4 
 
 10.6 
 
 10.4 
 
 Example of WRKTPB 
 
 DPI 
 
 DP2 
 
 22. 
 
 160 
 
 11. 
 
 36 
 
 100. 
 
 300 
 
 BULB POTENTIAL TEMP) 
 
 - 14 - 
 
SGL REPORTS MISSING OR INCORRECT FORMAT, 2/ 2/84 
 UAL NEU RAOB NOT AVAILABLE 
 
 Figure 6. Example of WRKTPD 
 
 12Z 
 
 - 15 - 
 
n n 
 
 C RANP.FR 
 
 C THIS VERSION UORKS WITH C „E AND S SWITCH. 
 
 C "RANP" COMPUTES STABILITY INDICES FOR SET OF RAOB STATIONS, 
 
 C SPECIFIED IN FILE: "STNS1" WITH 
 C OUTPUT TO AFOS PRODUCT "URKTPC" AND "NMCGPHEIS". 
 
 C 
 
 C GLOBAL SWITCH "C" DOES CHECK OF DATABASE ONLY; "SGL" REPORTS THAT 
 C CANNOT BE READ ARE LISTED IN "WRKTPD". 
 
 C 
 
 C GLOBAL SWITCH "S" MAY BE USED FOR A SINGLE STATION COMPUTATION WITH 
 C OUTPUT TO AFOS PRODUCTS "WRKTPA" & "WRKTPB". 
 
 C 
 
 C ZERO PERCENT ENTRAINMENT ALWAYS USED FOR EQUILIBRIUM LEVEL. 
 
 C SIXTY PERCENT ENTRAINMENT FOR ALL OTHER COMPUTATIONS, BUT MAY BE 
 C CHANGED WITH LOCAL SWITCH "E". 
 
 C 
 
 C 
 
 C 
 
 FOLLOWING PARAMETER MUST EQUAL OR EXCEED NUMBER OF RAOB STNS TO BE 
 PROCESSED, AND MUST AGREE WITH -NRAOB- PARAMETER IN SUBROUTINES -GPT- 
 AND 'STLOC'. 
 
 PARAMETER NRAOB=50 
 
 ISTCNRAOB,2) 
 
 COMMON/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TSC0:50),TSD(0:50) 
 COMMON/T/RLCL,RLFC,EL,B2,B2P, B2N,IALL,B1, BIP,BIN,EX 
 COMMON/CCL/PCCL,ETCCL,TS0,TSD0,L,TSCCL,TCCL,TDCCL,WAVG 
 COMMON/G/PP(0:20),ET(20),TU(0:50),DP,EFF, KMOD,KK 
 COMMON/GG/NJ,PPB(15),PPT(15),DELPP(15),DTWDP(15),DPB(15),DPT(15), 
 
 1 PTMAX,PBMAX,TWLAPSE,DMAX ; FOR PULYR SUBROUTINE 
 COMMON/TT/PT(0:50),TST(0:50), TSDT(0:50) 
 
 COMMON/V/JNOM, PX 
 COMMON/H/IHDR1(11),KEY(5) 
 
 COMMON/ZZZ/ZZ(0:12) 
 
 DIMENSION IXX(NRAOB),IYY(NRAOB),JB(NRAOB),JEL(NRAOB) 
 
 DIMENSION H(0:12),T(0:12),TD(0:12),D(0:12),S(0:12) 
 
 INTEGER SW(2),DAT(10) 
 
 EXTERNAL OV0,OV1,0V2,0V3 
 DATA IHDR1/" RKTPC000" 
 
 DATA KEY/"URKTPC"/ 
 
 "ZZ" HEIGHT OF STANDARD PRESSURE SURFACES, U. S. STANDARD ATMOSPHERE 
 DATA ZZ/0.,111.,1457.,3012.,5574.,7185.,9164.,10363.,11784.,13608., 
 1 16180.,999.,0./ 
 
 IFD=10 ; OUTPUT DEVICE FOR ERROR MESSAGES FROM DECOM 
 IFC=20 ; OUTPUT DEVICE FOR ERROR MSGS FM DECOS, BNDX, 
 
 CNVM=.032808399 ; CONVERSION FACTOR, M TO FT X 10-2 
 
 CALL KFILL (KEY,IER) 
 
 IHDR1(1)=KEY(1) 
 
 ; OV0 & OV1 - NO SWITCH, 0V2 8. 0V3 
 177777K,177777K,"70",142600K,6412K/ 
 
 - S SWITCH 
 
 INDX1 SUBROUTINES 
 
 IHDR1(2)=KEY(2) 
 IEND=101603K 
 DP=50. 
 
 I ALL=1 
 PX=400. 
 
 ; ENDING FOR AFOS PRODUCT 
 
 ; 50 MB STEP 
 
 ; IALL=2 TO PRINT EVERY LVL IN RANN2 SUBROUTINE 
 ; CUT-OFF PRESSURE FOR Ell INDEX 
 N=0 ; COUNTER FOR NUMBER OF RAOB STATIONS 
 
 CALL FCOM (IC,IER) 
 
 CALL COMCM (IC,DAT,11,SW,IER) ; READING: RUN:RANP 
 ICK=0 
 
 IF (ISWSET(SW,"C")) ICK=1 ; 
 
 IF (ISWSET(SW,"S")) ICK=2 ; 
 
 IF (ICK.EQ.0) GO TO 45 ; 
 
 IF (ICK.EQ.2) GO TO 50 
 IHDR1(5)="D0" 
 
 ICK=1 DENOTES DATABASE CHECK ONLY 
 
 ICK=2 DENOTES SINGLE STATION COMPUTATION 
 
 ICK=0 DENOTES FULL COMPUTATION FOR LIST OF STATIONS 
 
 - 16 - 
 
GO TO 41 
 
 45 CALL CFILU("HMSGPH.01",2,IER) ; CREATING GRAPHIC FILE 
 
 IF (IER.NE.l) URITE (10,35) IER 
 
 35 FORMAT (1H ,"IER - \I4," CFILU, PROGRAM RANP, STATEMENT 35") 
 
 GO TO 49 
 
 C SINGLE STATION COMPUTATION 
 
 50 IHDR1(5)="A0" ; DENOTES INDEXX TO STORE IN URKTPA 
 
 DO 51 1 = 1, 10 
 
 51 DAT(I)=0 
 
 CALL COMCMCIC,DAT,11,SU,IER) ; READING CCCSGLXXX 
 DO 52 1=1,5 
 
 52 JST(I)=DAT(I) 
 
 JER=1 ; INDICATOR THAT SINGLE STATION COMPUTATION COMPLETED OK 
 
 C 
 
 49 DO 43 1 = 1, 10 
 
 43 DAT(I)=0 
 
 CALL COMCM (IC,DAT,11,SU,IER) ; READING ENTRAINMENT RATE 
 
 IF (ISUSETCSU,"E")) GO TO 40 ; SPECIAL EFF HAS BEEN READ 
 
 EFF0=60. ; NORMAL ENTRAINMENT RATE IN PERCENT 
 
 GO TO 41 
 
 40 EFF0=FTCV(DAT,$44) 
 
 URITE (10,42) EFF0 
 
 42 FORMAT (1H , "EFF0 = \F5.0) 
 
 GO TO 41 
 
 44 CALL FORKE ("RANP","EFF0",IER) 
 
 CALL KLOSE(IC,IER) 
 
 STOP 
 
 41 CONTINUE 
 
 CALL KLOSE (IC,IER) 
 
 CALL FOPEN (20,"INDEXX",300) 
 
 CALL FGTIME (IHR,IMIN,ISEC) ; GET TIME 
 
 CALL DATE (KDATE,IER) ; (MO,DY,YR) GET DATE 
 
 KDATE(3)=KDATE(3)-1900 ; MAKING 2 DIGIT YEAR 
 
 KDAT=KDATE(2) ; SAVE ORIGINAL KDATE(2) FOR SINGLE STN COMPUTATION 
 
 IHOUR=0 
 
 KTIME=IHR*100+IMIN 
 
 C 
 
 IF (KTIME.GT.1200) IH0UR=12 ; DOES LATEST TIME 
 IM=ICK+1 
 
 GO TO (20,53,58),IM 
 
 58 URITE (20,59) ; LEAVING ROOM FOR HEADER AT BGNG OF INDEXX FILE 
 
 59 FORMAT (12X," ") 
 
 KDATE(2)=0 ; SIGNIFIES NOT TO DO DATE/TIME CHECK 
 
 GO TO 54 
 
 53 URITE (20,29) (KDATE(I),1=1,3),IHOUR 
 
 29 FORMAT (12X, 11 SGL REPORTS MISSING OR INCORRECT FORMAT, ", 
 
 1 12,12,12,2X,12,"Z") 
 
 GO TO 31 
 
 20 URITE (20,21) (KDATE(I),1=1,3),IHOUR,DP,EFF0,PX 
 
 21 FORMAT (12X," RAOB INDICES FOR ",12,"/",12,,12, 
 
 1 2X,12,"Z",3X,"DP = ",F4.0,3X,"EFF = ",F5.0,3X,"PX = ",F5.0 
 
 2 /"< 15X 12>", " ENERGY UNITS : J/KG X 10",5X, "EL 8. TROP IN HNDS FT") 
 URITE (20,23) 
 
 23 FORMAT ("<15X12>",3X,"STN",3X,"P0",2X,"PMAX",IX,"EL(MB)", IX,"EL(FT)“ 
 
 1 ,IX,"TROP",3X,"EI1",3X,"EI2",3X,"LI",3X,"KI",2X,"SUI",2X, "CCL", IX, 
 
 2 "ETCCL",IX,"STN") 
 
 URITE (20,27) 
 
 27 FORMAT ("< 15X 12>") ; BLANK LINE 
 
 31 CALL OPEN (22, "STNS1", 1,IER) ; FILE STNS CONTAINS RAOB ID'S 
 
 IF (IER.NE.l) STOP OPEN ERROR 
 
 - 17 - 
 
5 READ (22,3,END=8) (JST(I),1-1,5) 
 
 3 FORMAT (5A2) 
 
 N=N+1 
 
 CALL TYPED(N) ; TYPES N ON DASHER TO MONITOR PROGRESS 
 
 IF (N.EQ.20.OR.N.EQ.40.OR.N.EQ.60.OR.N.EQ.80) URITE C10,48) ; NXT LINE 
 48 FORMAT (1H ) 
 
 IST(N,D-JSTC4) ; MAKING STATION ID FOR PLOTTING 
 IST(N,2)-JST(5) 
 
 54 CALL DECOS (JST,KDATE(2),IHOUR,JNO,P,TS,TSD,IFC,$26) 
 
 IF (ICK.EQ.1) GO TO 5 ; SGL READ OK 
 
 DO 76 1=0,JNO 
 
 IF (TSD(I).NE.999.) GO TO 76 
 IF CPC I).GE.700.) GO TO 7 
 
 TSD(I)=TS(I)-30. ; IF DEUPT MISG ABV 700MB, ASSUME DRY 
 
 76 CONTINUE 
 
 GO TO 6 
 
 7 URITE (20,10) N,(JST(J),J-4,5),P(I) 
 
 10 FORMAT ("<15><12>",12,IX,2A2," DEUPOINT MISSING AT P = ”,F5.0) 
 
 GO TO 26 
 
 6 KMOD=0 ; FOR ETCCL CALCULATION 
 
 CALL CCL1 (IFC,$26) 
 
 CALL MODRB ; MODIFIES RAOB FOR ETCCL COMPUTATION 
 
 CALL RANN2 (PT,TST,TSDT,JNOM,PX) ; CALLED FOR ETCCL ONLY, JNOM FM MODRB 
 CALL INDX1 (RLI,RKI,RUI,$26,IFC) 
 
 CALL BNDX (IFC,$26) ; MODIFY RAOB FOR MAX INSTABILITY 
 
 EFF=0. ; ZERO ENTRAINMENT FOR EQUILIBRIUM LVL 
 KM0D=2 ; FOR NORMAL COMPUTATION UITH RANN2 
 
 CALL RANN2 (PT,TST,TSDT,JNOM,PX) ; COMPUTE EL LVL, JNOM FROM BNDX 
 EL0=EL ; SAVE EL UITH ZERO ENTRAINMENT RATE 
 EFF =EFF0 ; RESET ENTRAINMENT RATE FOR ALL OTHER COMPUTATIONS 
 
 JEFF =JREAL(EFF) 
 
 CALL RANN2 (PT,TST,TSDT,JNOM,PX) ; COMPUTE STABILITY INDICES 
 EL=EL0 ; USE EL UITH ZERO ENTRAINMENT 
 C. 
 
 C THIS SECTION USES MANDATORY LVLS TO GET "EL" AND "TROP" IN FEET. 
 
 JST(2)=JST(2)-" 5"+" M" ; MAKING ID FOR MANDATORY LVLS 
 JST(3)="AN" 
 
 IDECOM=1 ; INDICATOR THAT MANDATORY LVLS USED FOR EL AND TROP 
 
 KDATE(2)=KDAT ; RESETTING KDATE(2) 
 
 CALL DECOM (JST,KDATE(2),IHOUR,H,T,TD,D,S,$9,IFD,PTROP) ; READ MANDATORY LVLS 
 17 IF (EL.NE.0.) GO TO 14 
 
 EL 1=999. ; EQUILIBRIUM LEVEL NOT COMPUTED 
 
 GO TO 15 
 
 14 CONTINUE 
 
 CALL HEIGHT (H,EL,EL 1,$9) ; CONVERT EL TO METERS 
 EL 1=EL1*CNVM ; CONVERT M TO FT X 10-2 
 
 15 CONTINUE 
 
 IF (PTROP.NE.999.) GO TO 13 
 TR0P=999. ; TROP NOT OBSERVED 
 
 GO TO 16 
 
 13 CALL HEIGHT (H,PTROP,TROP,$30) ; GET TROP IN METERS 
 
 TROP =TROP*CNVM ; CONVERT M TO FT X 10-2 
 
 GO TO 16 
 
 30 URITE (10,33) (JST(I),1=1,5),PTROP 
 
 33 FORMAT (1H ,5A2," PTROP = \F8.0," ERROR RANP, STATEMENT 33") 
 
 TROP=999. 
 
 GO TO 16 
 C 
 
 C CANNOT USE MANDATORY LVLS (NOT AVBL, TOO LARGE EXTRAPOLATION, ETC.) 
 
 9 IDECQM=0 ; MANDATORY LVLS NOT USED 
 
 - 18 - 
 
DO 11 1=0,12 
 
 11 H(I)=22(1) ; SUBSTITUTE U. S. STANDARD ATMOSPHERE 
 
 PTR0P=999. 
 
 GO TO 17 
 C 
 
 C OUTPUT FOLLOUS 
 16 CONTINUE 
 
 IF (ICK.EQ.2) GO TO 56 
 JB(N)=JREAL(B1) 
 
 JEL CN)=JREAL(EL 1) 
 
 IF CIDECOM.EQ.1) GO TO 12 ; MANDATORY LEVELS USED 
 
 URITE (20,28) N,(JST(I),I=4,5),P(0),PT(0),EL,ELI,TROP,B1,B2,RLI,RKI 
 1 ,RUI,PCCL,ETCCL,(JST(I),1=4,5) ; NO MANDATORY LVLS USED 
 
 28 FORMAT ("<15X12>",12,1X,2A2,F5.0,3F6.0,"E",F5.0,1X,2F6.0,3F5.0, 
 
 1 2F5.0,IX,2A2) 
 
 GO TO 5 
 
 12 URITE (20,22) N,(JST(I),I=4,5),P(0),PT(0),EL,EL 1,TROP,B1,B2,RLI,RKI 
 
 1 ,RUI,PCCL,ETCCL,(JST(I),I=4,5) ; MANDATORY LVLS USED..TROP 8. EL 
 
 22 FORMAT ("<15X12>", 12,IX,2A2,F5.0,3F6.0,1X,F5.0,IX,2F6.0,3F5.0, 
 
 1 2F5.0,IX,2A2) 
 
 GO TO 5 
 
 26 CONTINUE 
 
 JER=0 ,- INDICATES SINGLE STATION COMPUTATION NOT COMPLETED 
 IF (ICK.EQ.2) GO TO 55 
 
 C INSERT DUMMY VALUES FOR STAB INDICES FOR PLOT HERE I 
 JB(N)=999 
 JEL(N)=999 
 GO TO 5 
 
 8 URITE (10,48) ; NEXT LINE 
 
 CALL CLOSE (22, IER) 
 
 IF (IER.NE.l) STOP CLOSE ERROR 
 GO TO 55 
 C 
 
 C OUTPUT FOR SINGLE STATION ANALYSIS 
 56 CALL GCHN (ICHN,IER) 
 
 IF (IER.NE.l) TYPE "GCHN ERROR FOR OVERLAY 0V2 8< 3, IER = ",IER 
 
 CALL OVOPN (ICHN,"RANP.OL",IER) ; OPEN RANP.OL 
 
 IF (IER.NE.l) TYPE "RANP.OL OPENING ERROR, IER = ",IER 
 
 CALL OVLOD (ICHN,0V2,-1,IER) ; LOAD 0V2 
 
 IF (IER.NE.l) TYPE "0V2 LOADING ERROR, IER = 11 , IER 
 
 CALL FOPEN (21,"INDEXY",300) 
 
 CALL TPB ; COMP. OF POT UNSTBL LYRS AND OUTPUT TO CHANNEL 21 
 CALL CLOSE (21,IER) 
 
 CALL OVLOD (ICHN,0V3,-1,IER) ; LOAD 0V3 
 IF (IER.NE.l) TYPE "0V3 LOADING ERROR, IER = ",IER 
 
 CALL TPA(JEFF,EL 1,RLI,RKI,RUI,IDECOM) ; OUTPUT FOR SNGL STN RAOB ANALYSIS 
 
 CALL KLOSE (ICHN,IER) 
 
 IF (IER.NE.l) TYPE "KLOSE ERROR FOR ICHN, IER = ",IER 
 C 
 C 
 
 55 CALL CLOSE (20, IER) 
 
 IF (IER.NE.l) TYPE "CHANNEL 20 CLOSE ERROR, IER = ",IER 
 C 
 
 C INSERT HEADING AND ENDING ON INDEXX 
 
 CALL GCHN (ICHN, IER) ; GET RDOS CHANNEL 
 CALL OPENN (ICHN,"INDEXX",0,IER) 
 
 CALL URS (ICHN, IHDR1,22,IER) ; HEADER INSERTION 
 CALL KLOSE (ICHN,IER) 
 
 CALL GCHN (ICHN,IER) ; GET RDOS CHANNEL 
 
 CALL OPENA (ICHN,"INDEXX",0,IER) ; OPEN FOR APPENDING 
 
 - 19 - 
 
CALL URS (ICHN,IEND,2,IER) ; ENDING FOR AFOS PRODUCT 
 CALL KLOSE (ICHN,IER) 
 
 CALL FSTORE ("INDEXX",0,IER) ; STORE INTO URKTPA,C, OR D 
 GO TO (57,39,66),IM ; IM-ICK+1 
 C 
 
 C INSERT HEADING AND ENDING ON INDEXY 
 
 66 IF (JER.EQ.0) GO TO 63 
 IHDR1(5)="B0" 
 
 CALL GCHN (ICHN,IER) ; GET RDOS CHANNEL 
 CALL OPENN (ICHN,"INDEXY",0,IER) 
 
 CALL URS (ICHN,IHDR1,22,IER) ; HEADER INSERTION 
 CALL KLOSE (ICHN,IER) 
 
 CALL GCHN (ICHN, IER) ; GET RDOS CHANNEL 
 CALL OPENA (ICHN,"INDEXY",0,IER) ; OPEN FOR APPENDING 
 CALL URS (ICHN,IEND,2, IER) ; ENDING FOR AFOS PRODUCT 
 CALL KLOSE (ICHN,IER) 
 
 CALL FSTORE ("INDEXY",0,IER) ; STORE INTO URKTPB 
 CALL FORKP ("RANP","URKTPA,URKTPB",IER) 
 
 GO TO 46 
 C 
 
 C CREATE GRAPHIC EIS 
 57 CALL GCHN (ICHN,IER) 
 
 IF (IER.NE.l) TYPE "GCHN ERROR FOR OVERLAY OV0 & 1, IER = ",IER 
 
 CALL OVOPN (ICHN,"RANP.OL",IER) ; OPEN RANP.OL 
 
 IF (IER.NE.l) TYPE "RANP.OL OPENING ERROR, IER = ",IER 
 
 CALL OVLOD (ICHN,OV0,-1,IER) ; LOAD OV0 
 
 IF (IER.NE.l) TYPE "OV0 LOADING ERROR, IER = ",IER 
 
 CALL STLOC(N,IXX,IYY,1ST) 
 
 CALL OVLOD (ICHN,OV1,-1,IER) ; LOAD OV1 
 
 IF (IER.NE.l) TYPE "OV1 LOADING ERROR, IER = ",IER 
 
 CALL GPT(N,IXX,IYY,JB,JEL,1ST,IHOUR,KDATE,JEFF) ; CREATE AFOS GRAPHIC 
 CALL KLOSE (ICHN,IER) 
 
 IF (IER.NE.l) TYPE "KLOSE ICHN, IER = ",IER 
 
 CALL FORKP ("RANP","URKTPC & EIS", IER) ; TURN ON ALERT LIGHT 
 GO TO 46 
 
 39 CALL FORKP ("RANP","URKTPD",IER) 
 
 63 DO 68 1=1,1000 
 
 68 TIMEUASTE=l./2. ; DELAY FOR CALL TO DFILU 
 
 46 DO 61 1=1,1000 
 
 CALL DFILU ("INDEXX",IER) ; DELETE INDEXX FILE 
 IF (IER.EQ.1) GO TO 62 
 
 61 CONTINUE 
 
 IF (IER.NE.l) TYPE "INDEXX FILE NOT DELETED, IER = ",IER 
 
 62 GOTO (32,38,60),IM ; IM=ICK+1 
 
 60 IF (JER.EQ. 1) GO TO 67 
 
 CALL FORKP ("RANP","URKTPA",IER) 
 
 STOP 
 
 67 DO 64 1=1,1000 
 
 CALL DFILU ("INDEXY",IER) ; DELETE INDEXY FILE 
 IF (IER.EQ. 1) GO TO 65 
 
 64 CONTINUE 
 
 IF (IER.NE.l) TYPE "INDEXY FILE NOT DELETED, IER = ",IER 
 
 65 STOP 
 
 32 DO 37 1 = 1, 1000 
 
 CALL DFILU ("HMSGPH.01",IER) ; DELETE GRAPHIC FILE 
 
 IF (IER.EQ.1) GO TO 38 ; THIS LOOP IS NECESSARY, FOR SLOU CLOSING 
 
 37 CONTINUE 
 
 IF (IER.NE.l) URITE (10,36) IER 
 
 36 FORMAT (1H ,"IER = ",I4," HMSGPH.01 NOT DELETED - RANP, STATEMENT 36") 
 
 38 STOP 
 
 - 20 - 
 
n n 
 
 END 
 
 * 
 
 * 
 
 SUBROUTINE DECOS <JST,IDATE,IHOUR,JNO,P,TS,TSD,IFC,Q) 
 
 C DECODES RAOB SIGNIFICANT LEVELS UP TO 100MB 
 C JST...AFOS IDENTIFIER 
 
 C IDATE/IHOUR IS THE DATE/HOUR UANTED FOR DECODING. 
 
 C IDATE=0 MEANS DATE AND HOUR NOT TO BE TESTED. 
 
 C JNO... NO. OF SIGNIFICANT LEVELS DECODED. 
 
 C P...PRESSURE, TS...TEMPERATURE, TSD...DEUPOINT. 
 
 C IFC...OUTPUT DEVICE, Q...ABNORMAL ERROR RETURN STATEMENT NUMBER. 
 
 DIMENSION JST(5),P(0:50),TS(0:50),TSD(0:50) 
 
 DIMENSION IOUT(40) 
 
 INTEGER D 
 
 CALL AFREAD (1,JST,$100) 
 
 CALL AFREAD (2, IOUT,$50,$125) 
 
 C TEST FOR NEU RAOB CODE FORMAT 
 
 15 IF (IOUT(4) .EQ. "TT". AND. IOUT(5) .EQ. "BB 11 ) GO TO 9 
 
 GO TO 10 ; OLD RAOB CODE 
 
 9 IF (I0UT(6).EQ." 5".OR.I0UT(6).EQ." 6".OR.I0UT(6).EQ." 
 
 1 OR.IOUT(6).EQ." 8") GO TO 11 
 
 K=-5 ; DOUBLE SPACE AFTER TTBB 
 
 Kl—3 
 K2=-2 
 GO TO 12 
 
 11 K=-6 ; SINGLE SPACE AFTER TTBB 
 
 K1 =-3 
 
 K2=-2 
 GO TO 12 
 
 C OLD RAOB CODE FORMAT 
 
 10 K=0 
 
 IF (I0UT(6).EQ." U".AND.IOUT(?).EQ."J1") K=4 
 
 Kl=K/2 
 
 K2=K 1 
 
 IF (I0UT(9+K1).EQ." 5".OR.I0UT(9+K1).EQ." 6".OR.I0UT(9+K1).EQ." 7". 
 
 1 OR.I0UT(9+K1).EQ." 8") GO TO 12 ; TESTING FOR DOUBLE SPACE AFTER TTBB 
 
 K=K-1 
 
 12 JDATE=ITCVT(18+K,2,$900)-50 
 JHOUR=ITCVT(20+K,2,$900) 
 
 IF (IDATE.EQ.0) GO TO 13 
 IVCHECK = IVCK(IDATE,IHOUR,JDATE,JHOUR) 
 
 GO TO (13,14,133,135),IVCHECK 
 14 CALL PRVRF(IER) 
 
 IF (IER.NE. 1) GO TO 135 
 CALL AFREAD (3,JST,$102) 
 
 CALL AFREAD (2,IOUT,$50,$125) ; READ 1ST LINE OF PRVS VERSION 
 
 GO TO 15 
 
 TEST FOR MISSING RAOB 10142 ETC. 
 
 13 11A=ITCVT(30+K,4,$900) 
 
 1IB=ITCVT(34+K,1,$900) 
 
 IIIA=ITCVT(36+K,3,$900) 
 
 IF (IIA.EQ.5151.AND.I IB.EQ.5.AND.IIIA.EQ.101) GO TO 126 
 C 
 
 JNO=0 
 
 DO 1 1=0,2 
 11=6*1 
 12=11+11 
 
 - 21 - 
 
11 = ITCVT(30+K+12,2,$900) 
 
 IJJ=I*11 
 
 IF (IJJ.NE.II) GO TO 127 ; TEST FOR IMPROPER FORMAT 
 
 IF (IOUTC17+K1+I1).EQ."/V".OR.IOUT(17+K1+I1).EQ."/ ") GO TO 1 ; SIG LVL PRS MISG 
 P(JNO)=FTCVT(32+K+12,3,$901) 
 
 IF (PCJNO).LT.100.) P(JNO)=P(JNO)+1000. 
 
 TS(JNO)=FTCVT(36+K+I2,3,$901) 
 
 IF CIOUTC20+K1 + I1) .EQ. "//" .OR. IOUTC20+K2+11) .EQ. "/ ") GO TO 2 ; DEUPT MISG 
 
 TSD(JNO)=FTCVT(39+K+12,2,$901) 
 
 GO TO 3 
 
 2 TSDCJNO)=999. 
 
 3 CALL TEMPICTSCJNO),TSDCJNO)) ; TEMPERATURE DECODER 
 JNO=JNO+l 
 
 1 CONTINUE 
 
 C FIRST LINE OF RAOB IS FINISHED HERE 
 C STATEMENT 4 STARTS 2ND AND SUBSEQUENT LINES 
 JNO=JNO-1 
 I JK=22 
 
 4 CALL AFREAD (2,IOUT,$50,$125) 
 
 DO 5 1=0,4 
 
 11=6*1 
 12=11+11 
 IJK=IJK+11 
 
 IF (IJK.EQ.110) IJK = 11 
 IJK1=12+1 
 
 IF (IOUTC11+2).EQ."//") GO TO 5 ; SIG LVL PRESSURE MISG 
 
 1515=ITCVT(12+1,3,$900) 
 
 IF (1515.EQ.515) GO TO 53 ; TEST FOR 51515 101XX GROUP ENDING MSG 
 
 JI=ITCVT(IJK1,2,$900) 
 
 IF (IJK.NE.JI) GO TO 128 ; TEST FOR IMPROPER FORMAT 
 
 IF CJNO.EQ.50) GO TO 51 
 
 JNO=JNO+l 
 
 PCJNO)=FTCVT(12+3,3,$901) 
 
 IF CPCJNO).LT.100.) PCJNO)=P(JNO)+1000. 
 
 TS(JNO)=FTCVT(12+7,3,$901) 
 
 10=IOUT(11+6) 
 
 IF (IO.EQ."/ ".OR.10.EQ."/=") GO TO 6 
 TSD(JNO)=FTCVT(12+10,2,$901) 
 
 GO TO 7 
 
 6 TSD CJNO)=999. 
 
 7 CALL TEMPICTSCJNO),TSD(JNO)) 
 
 IF CIO.EQ."/=".OR.10.EQ."0 =".OR.10.EQ."1 =".OR.10.EQ."2 = ".OR.IO.EQ. 
 
 1 "3=".OR.IO.EQ."4=".OR.IO.EQ."5=".OR.IO.EQ."6-".OR.IO.EQ."7=".OR.10. 
 
 2 EQ."8=".0R.IO.EQ."9=") GO TO 53 ; TEMPERATURES FINISHED 
 
 5 CONTINUE 
 
 GO TO 4 ; RETURNS TO 4 TO DO 3RD AND SUBSEQUENT LINES 
 
 53 CONTINUE 
 
 C IF UIND DATA REQUIRED, READ IT HERE... 
 
 RETURN 
 
 51 URITE CIFC,52) (JSTCI),I=4,5),P(JNO) 
 
 52 FORMAT ("<15X12>\ 1X,2A2,IX,"51 SIGNIFICANT LEVELS HAVE BEEN DECOD 
 1 ED, LEVELS ABOVE ",F5.0,"MB DISREGARDED.") 
 
 RETURN 
 
 50 URITE (IFC,54) (JSTCI),I=4,5) 
 
 54 FORMAT ("<15X12>",3X,2A2," AFREAD ERROR 50 - DECOS") 
 
 RETURN Q 
 
 100 URITE (IFC,55) (JSTCI),I=4,5) 
 
 55 FORMAT ("<15X12>",3X,2A2," AFREAD ERROR 100 - DECOS") 
 
 RETURN Q 
 
 102 URITE (IFC,103) (JSTCI),I=4,5) 
 
 - 22 - 
 
103 FORMAT ("< 15X12>",3X,2A2, " AFREAD ERROR 102 - DECOS") 
 
 RETURN Q 
 
 125 WRITE (IFC,56) (JST(I),1=4,5) 
 
 56 FORMAT ("<15X12>",3X,2A2,» AFREAD ERROR 125 - DECOS") 
 
 RETURN Q 
 
 126 WRITE (IFC,57) (JST(I),1=4,5) 
 
 57 FORMAT ("<15X12>",3X,2A2," STATION MISSING - DECOS") 
 
 RETURN Q 
 
 127 WRITE (IFC,129) (JST(I),1=4,5),IJJ,11 
 
 129 FORMAT ("<15X12>",3X,2A2, " IMPROPER FORMAT (1ST LINE) LOOKING FOR: 
 
 1 ",13," FOUND: ",I3," DECOS") 
 
 RETURN Q 
 
 128 WRITE (IFC,130) (JSTCI),1=4,5),IJK,JI 
 
 130 FORMAT ("<15X12>",3X,2A2," IMPROPER FORMAT (2ND + LINE) LOOKING FOR 
 
 1 ",13," FOUND: ",I3," DECOS") 
 
 RETURN Q 
 
 900 WRITE (IFC,131) (JST(I),I=4,5) 
 
 131 FORMAT ("<15><12>",3X,2A2," SGL RAOB ERROR - SUBROUTINE ITCVT") 
 RETURN Q 
 
 901 WRITE (IFC, 132) (JST(I),I=4,5) 
 
 132 FORMAT ("<15X12>",3X,2A2, " SGL RAOB ERROR - SUBROUTINE FTCVT") 
 RETURN Q 
 
 133 WRITE (IFC,134) (JST(I),1=4,5) 
 
 134 FORMAT ("<15X12>",3X,2A2," NEW RAOB NOT AVAILABLE") 
 
 RETURN Q 
 
 135 WRITE (IFC,136) (JST(I),I=4,5) 
 
 136 FORMAT ("<15X12>",3X,2A2," DESIRED VERSION NOT FOUND - DECOS") 
 RETURN Q 
 
 END 
 
 * 
 
 * 
 
 SUBROUTINE TEMPI (T,TD) 
 
 C COMPUTES + OR - TEMPERATURE, AND COMPUTES DEWPOINT 
 TT=AMOD(T,2.) 
 
 IF (TT.EQ.l.) T—T 
 T=T*.1 
 
 IF (TD.EQ.999.) RETURN 
 IF (TD.LE.50.) GO TO 1 
 TD=T-(TD-50.) 
 
 RETURN 
 
 1 TD=T-TD*. 1 
 
 RETURN 
 END 
 
 * 
 
 C SUBROUTINE -RANN2- COMPUTES ENERGY AREAS ON THERMODYNAMIC DIAGRAM, 
 
 C USING PARCEL METHOD, WITH SELECTED ENTRAINMENT RATE AND PRESSURE STEP 
 C JNOJ = NO. OF LEVELS IN RAOB: PA,TSA,TSDA 
 C PX = PRESSURE LEVEL ENDING "Bl" INDEX COMPUTATION 
 
 C IMPORTANT...KMOD MUST BE PROPERLY SET, BEFORE THIS SUBROUTINE IS CALLED. 
 C IF KMOD = -1 BELOW STATEMENT 108, THEN CCL MODIFIED RAOB IS USED. 
 SUBROUTINE RANN2 (PA,TSA,TSDA,JNOJ,PX) 
 
 COMMON/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 COMMON/G/PP(0:20),ET(20),TW(0:50),DP,EFF,KMOD,KK 
 COMMON/T/RLCL,RLFC,EL,B2,B2P,B2N,IALL,B1,BIP,BIN,EX 
 COMMON/CCL/PCCL,ETCCL,TS0,TSD0,L,TSCCL,TCCL,TDCCL,WAVG 
 
 - 23 - 
 
DIMENSION PA(0:50),TSA(0:50),TSDA(0:50) 
 
 THETA(T,P2,P1)=T*(P2/P1)**.2857142 ; DRY ADIABATIC (T,P1) TO (THETA,P2) 
 KDP=0 ; KDP RESET TO 1, IF 2ND PASS THRU RANN2, UITH REDUCED DP 
 
 DPSAVE=DP ; SAVES ORIGINAL DP, PASSED THRU COMMON/G 
 
 R=287.04 ; GAS CONSTANT FOR DRY AIR .. J/KG PER DEG K 
 
 R=R*.1 ; SCALING ENERGY UNITS 
 
 EF1=.00002*EFF ; ENTRAINMENT FACTOR PER MILLIBAR 
 
 KMOD=KMOD-1 ; KMOD = -1, UHEN OPERATING ON CCL MODIFIED RAOB 
 
 108 IF (KMOD.EQ.-l) GO TO 106 
 TS0=TSA(0) 
 
 TSD0=TSDA(0) 
 
 106 IF (TS0.NE.TSD0) GO TO 92 
 
 TC=TS0 ; PARCEL INITIALLY SATURATED 
 RLCL=PA(0) 
 
 GO TO 107 
 
 92 TC=TCONOF(TS0,TSD0) ; CONDENSATION TEMP 
 
 PC=PA(0)*((TC+273.16)/(TS0+273.16))**(12857142) ; COND. PRES. 
 
 IF (KMOD.EQ.-l) PC=PCCL ; PC COMPUTED ABOVE IS NOT EXACTLY PCCL 
 
 107 TH=THETA(TS0+273.16,1000.,PA(0))-273.16 ; POT. TMP DEG C 
 
 UTH=UOBF(TH) 
 
 UTC=UOBF(TO 
 
 THU=TH-UTH+UTC ; EQUIV UET BULB POT TMP (DEG C) 
 
 C LIFT DRY AD IABATICALLY UNTIL TP=TC AT PRESSURE PC 
 DO 7 1=1,20 
 7 ET(I)=0. 
 
 DTI=0. 
 
 IF (KMOD.EQ.-l) DTI=TS0-TSA(0) 
 
 J =0 
 J J =0 
 JK=0 
 KJ=0 
 EN=0. 
 
 EP=0. 
 
 P1 =PA(J) 
 
 PP(0)=PA(0) 
 
 KK = 1 
 KKK=0 
 TP=TSA(J) 
 
 IF (KMOD.EQ.-l) TP=TS0 
 
 IF (TSDA(J).EQ.999.) TSDA(J)=TSA(J)-30. ; IF MISG, ASSUME DRY 
 UP=UMROF(PI,TSDA(J)) 
 
 IF (IALL.EQ.2) URITE (10,86) 
 
 86 FORMAT (1H ,"PI",8X,"P2",10X,"TE",13X,"TP",13X,"DTI",12X,"DT2", 
 
 1 12X,"E") 
 
 IF (TS0.EQ.TSD0) GO TO 15 ; PARCEL INITIALLY SATURATED 
 
 13 P2=P1-DP 
 
 MJ=0 
 
 IF (PC-P2) 3,4,4 
 4 P2=PC 
 
 RLCL=PC ; LIFTING CONDENSATION LVL 
 3 IF (PA(J+l)-P2) 5,6,6 
 
 6 P2=PA(J+l) 
 
 J=J+1 
 MJ= 1 
 KJ= 1 
 
 30 PLOG1=ALOG(PA(J)/PA(J+l)) 
 
 FACTORT=(TSA(J)-TSA(J+l))/PLOG1 
 
 IF (TSDA(J+1).EQ.999.) TSDA(J+l)=TSA(J+l)-30. ; IF MISG, ASSUME DRY 
 FACTORD=(TSDA(J)-TSDA(J+l))/PLOG1 
 KJ= 1 
 
 - 24 - 
 
5 IF (KJ.EQ.0) GO TO 30 ; INSURES FACTORED COMPUTED 1ST TIME THRU 
 
 IF (JJ.EQ.0) TP0=TP ; SAVE ORIGINAL TP 
 
 IF (JJ.EQ.l) TP®TP0 ; RESETS TP TO ORIGINAL VALUE, IF P2 ADJUSTED 
 TP*TP+273.16 ; CONVERT TO DEG K 
 
 TP=THETA (TP,P2,Pl)-273.16 ;DRV ADIABATIC LIFT PI TO P2 DEG C 
 PL0G2-AL0G(P2/PA(J+l)) 
 
 TE=TSA(J+1)+PL0G2*FACT0RT ; ENVIRONMENTAL TEMP AT P2 
 DP 1=P1-P2 
 
 IF (KMOD.EQ.-l) GO TO 42 ; NO ENTRAINMENT BELOU CCL LEVEL 
 
 IF (EFF.EQ.0.) GO TO 42 ; EFF=0. FOR NO ENTRAINMENT 
 
 EF=EF1*DP1 
 
 TP=(TP+273. 16+EF*(TE+273.16))/(1. +EF)-273.16 ; DEG C 
 
 TDE=TSDA(J+1)+PL0G2*FACT0RD ; DEG C 
 UE=UMROF(P2,TDE) ; G/KG MIXING RATIO OF ENVIRONMENT 
 
 UP=(UP+EF*UE)/(1.+EF) ; MIXING RATIO OF PARCEL AFTER MIXING 
 
 X=.0200*(TP-12.5+7500./P2) ; CORRECTION FOR NON-IDEAL GAS 
 
 UFU=1.+.0000045*P2+.00140*X*X ; CORRECTION FOR NON-IDEAL GAS 
 E2=UP*.00l*P2/( (UP*.001+.62197)*UFU) ; VAPOR PRES (MB) OF PARCEL 
 ES2=VAPFU(TP) ; SATURATION VAPOR PRES OF PARCEL 
 ES=ES2-E2 
 
 IF (ES) 40,40,41 ; GOES TO 40, IF PARCEL SATURATED 
 
 41 IF (ES.LE..01) GO TO 40 ; CLOSE ENOUGH FOR SATURATION 
 
 TDP=DPTOF(E2) ; DEUPOINT OF PARCEL AFT MXG (DEG C) 
 
 TC=TCONOF (TP,TDP) 
 
 PC=P2*((TC+273.16)/(TP+273.16))**(1.x.2857142) 
 
 GO TO 42 
 40 TC=TP 
 
 PC=P2 
 RLCL=PC 
 
 C SINCE LCL HAS BEEN CHANGED, NEU -THU- IS ALSO REQUIRED 
 
 TH=THETA(TC+273.16,1000.,PC)-273.16 ; POT TEMP DEG C 
 
 UTH=UOBF(TH) 
 
 UTC=UOBF(TC) 
 
 THU=TH-UTH+UTC 
 
 42 DT2=TP-TE 
 
 IF (JJ.EQ.0) GO TO 96 
 
 TI=DT1-DT2 
 
 JJ=0 
 
 JK= 1 
 
 IF (TI) 10,10,11 
 
 96 IF (KMOD.NE.-l) GO TO 14 
 
 IF (P2.GT.PC) GO TO 14 
 KKK = 1 
 
 GO TO 11 ; LAST STEP IN COMPUTING CCL ENERGY 
 
 14 IF (JK.NE.l) GO TO 66 ; JK-1, IF PREVIOUS PASS UAS A CROSSING PT 
 
 JK=0 
 
 IF (DT2) 10,10,11 
 
 66 IF (DT2) 8,8,9 
 
 8 IF (DTI) 10,10,12 
 
 9 IF (DTI) 12,11,11 
 
 C GOES TO 12 IF DRY ADIABAT CROSSES ENVIRONMENTAL TEMP 
 12 P2=P1-ABS(DTI)/(ABS(DTI)+ABS(DT2))*DP1 ; APPROX PRES UHERE DT2=0. 
 
 IF (KK.LE.20) GO TO 75 
 TYPE "ET DIMENSION EXCEEDS 20" 
 
 GO TO 110 
 75 KKK=1 
 
 JJ = 1 
 
 IF (MJ.EQ.0) GO TO 5 
 
 C MJ=1 MEANS J, UHICH HAS JUST BEEN SET AT STATEMENT 6, MUST BE RESET 
 C TO INTERPOLATE PROPERLY 
 
 - 25 - 
 
J=J-1 
 
 MJ=0 
 
 GO TO 30 
 
 10 E =.5*(DT2+DT1)*ALOG(P1/P2) 
 
 EN=EN+E 
 
 IF (IALL.EQ.2) URITE (10,85) P1,P2,TE,TP,DT1,DT2,E 
 85 FORMAT (1H ,2F10.3,5E15.6) 
 
 P1 =P2 
 DTI=DT2 
 
 IF (KKK.EQ.0.AND.P2.NE.PA(JNOJ)) GO TO 62 
 
 ET(KK) =EN*R ; CONVERTS TO J/KG UNITS 
 
 PPCKK)=P2 
 
 KK=KK+1 
 
 EN=0. 
 
 KKK=0 
 
 62 IF (P2.EQ.PC) GO TO 15 ; PARCEL SATURATED 
 
 GO TO 13 
 
 11 E=.5*(DT2+DT1)*AL0G(P1/P2) 
 
 EP=EP+E 
 
 IF (IALL.EQ.2) URITE (10,85) P1,P2,TE,TP,DTI,DT2,E 
 P1 =P2 
 DTI=DT2 
 
 IF (KKK.EQ.0.AND.P2.NE.PA(JNOJ)) GO TO 63 
 ET(KK)=EP*R ; CONVERTS TO J/KG UNITS 
 PP(KK)=P2 
 KK=KK+1 
 EP=0. 
 
 KKK=0 
 
 63 IF (P2.EQ.PC) GO TO 15 ; PARCEL SATURATED 
 
 GO TO 13 
 
 C 
 
 C LIFT PARCEL ALONG SATURATION ADIABATIC 
 C 
 
 15 CONTINUE 
 
 IF (KMOD.NE.-l) GO TO 84 
 DTI=0. 
 
 ETCCL=ET(1) 
 
 RETURN ; REMOVE, IF FULL COMPUTATION OF CCL MODIFIED SOUNDING IS DESIRED 
 KK=1 ; KK SET FROM 2 BACK TO 1, CCL ENERGY HAS JUST BEEN COMPUTED 
 
 84 JJ =0 
 
 JK=0 
 ISTOP=0 
 KKK=0 
 
 24 P2=P1-DP 
 MJ=0 
 
 IF (PA(J+l)-P2) 16,17,17 
 17 P2=PA(J+l) 
 
 IF (PA(J+l).GT.PA(JNOJ)) GO TO 25 
 ISTOP=1 
 GO TO 16 
 
 25 J=J+1 
 MJ= 1 
 
 88 PLOG1=ALOG(PA(J)/PA(J+l)) 
 
 FACTORT=(TSA(J)-TSA(J+l))/PLOG1 
 
 IF (TSDA(J+l) .EQ.999.) TSDAU+1) =TSA(J+l)-30. ; IF MISG, ASSUME DRY 
 FACTORD=(TSDA(J)-TSDA(J+l))/PLOG1 
 KJ = 1 
 
 16 IF (KJ.EQ.0) GO TO 88 
 
 IF (JJ.EQ.0) THU0=THU ; SAVE ORIGINAL THU 
 
 IF (JJ.EQ.l) THU=THU0 ;RESETS THU TO ORIGINAL VALUE, IF P2 ADJUSTED 
 
 - 26 - 
 
TP-SATLFT (THU,P2) ; TEMP OF PARCEL AT P2 ON -THLK UET ADIABAT 
 PL0G2=AL0G(P2/PA(J+l)) 
 
 TE=TSA(J+1)+PL0G2*FACT0RT ; ENVIRONMENTAL TEMP AT P2 
 DP1=P1-P2 
 
 IF (EFF.EQ.0.) GO TO 67 ; EFF=0. FOR NO ENTRAINMENT 
 
 TDE-TSDA(J+1)+PL0G2*FACT0RD ; ENVIRONMENTAL DEUPT AT P2 
 UE=UMROF (P2,TDE) ; MIXING RATIO (G/KG) OF ENVIRONMENT 
 UP=UMROF (P2,TP) ; MIXING RATIO OF SATURATED PARCEL 
 
 EF-EF1*DP1 
 
 UP=(UP+EF*UE)/(l.+EF) 
 
 TP=(TP+273.16+EF*(TE+273.16))/(1.+EF)-273.16 
 
 X=.0200*(TP-12.5+7500./P2) ; CORRECTION FOR NON-IDEAL GAS 
 
 UFU=1.+.0000045*P2+.00140*X*X ; CORRECTION FOR NON-IDEAL GAS 
 
 E2=UP*.00 l*P2/( (UP*.001+.62197)*UFU) ; VAPOR PRES (MB) OF PARCEL 
 TDP=DPT0F(E2) ; DEUPT OF PARCEL AFT MXG 
 IF (TDP.GT.TP) TDP=TP 
 TC=TCONOF(TP,TDP) 
 
 TH=THETA(TP+273.16,1000.,P2)-273.16 ; POT TEMP DEG C 
 UTH=UOBF(TH) 
 
 UTC=UOBF(TC) 
 
 THU=TH-UTH+UTC ; EQUIV UET BULB POT TEMP (DEG C) 
 
 TP=SATLFT(THU,P2) ; PARCEL TEMP AFT EVAPORATING LIQUID UATER 
 
 67 DT2=TP-TE 
 
 C IF ADDITIONAL INFORMATION ON LEVELS IS NEEDED, INSERT PRINT STATEMENT HERE 
 IF (JJ.EQ.0) GO TO 23 ; JJ-1 IF NEU P2 HAS BEEN COMPUTED FOR CROSSOVER. 
 
 TI=DT1-DT2 
 J J =0 
 JK = 1 
 
 IF (TI) 20,20,22 
 
 23 IF (JK.NE.l) GO TO 65 ; JK-1, IF PREVIOUS PASS UAS A CROSSING PT 
 
 JK=0 
 C 
 
 C IN CASE SAT. ADIABAT INTERSECTS ENVIRONMENTAL TEMP IN 2 PLACES CREATING 
 
 C A VERY SMALL POSITIVE AREA, THIS AREA UILL BE IGNORED (STATEMENT 101). 
 
 CHECK=DT2*ET(KK-1) ; USUALLY NEGATIVE 
 IF (CHECK.LT.0.) GO TO 100 
 IF (DT2) 101,102,102 
 
 101 EN=ET(KK-1) 
 
 KK=KK- 1 
 
 TYPE "STATEMENT 101 USED IN RANN2" 
 
 GO TO 20 
 
 C IF STATEMENT 102 IS USED, PRESSURE STEP IS REDUCED AND ENTIRE COMPUTATION 
 
 C IS REPEATED. THIS OCCURS UHEN DT2 CHANGES SIGN SEVERAL TIMES IN A SHORT 
 
 C PRESSURE DISTANCE. THIS SHOULD BE A VERY RARE OCCURENCE 
 
 102 DP-10. ; REDUCE PRESSURE STEP TO 10MB. 
 
 IF (KDP.EQ.0) GO TO 109 
 
 GO TO 110 ; RANN2 CANNOT BE COMPLETED UITH REDUCED PRESSURE STEP 
 
 109 KDP=KDP+1 
 
 TYPE "STATEMENT 102 USED IN RANN2" 
 
 GO TO 108 ; REPEAT ENTIRE ENERGY CALCULATION UITH 10MB PRES STEP 
 
 C 
 
 100 IF (DT2) 20,20,22 
 
 65 IF (DT2) 18,18,19 
 
 18 IF (DTI) 20,20,21 
 
 19 IF (DTI) 21,22,22 
 
 C GOES TO 21 IF UET ADIABAT CROSSES ENVIRONMENTAL TEMP 
 21 P2=P1-ABS(DTI)/(ABS(DTI)+ABS(DT2))*DP1 
 
 IF (KK.LE.20) GO TO 76 
 TYPE "ET DIMENSION EXCEEDS 20" 
 
 GO TO 110 
 
 - 27 - 
 
76 
 
 KKK = 1 
 JJ = 1 
 
 IF (MJ.EQ.0) GO TO 16 
 C MJ-1 MEANS J, UHICH HAS JUST BEEN SET AT STATEMENT 25, MUST BE RESET 
 C TO INTERPOLATE PROPERLY 
 J=J-1 
 MJ=0 
 
 GO TO 88 
 
 20 E =.5*(DT2+DT1)*ALOG(P1/P2) 
 
 EN=EN+E 
 
 IF (IALL.EQ.2) URITE (10,85) P1,P2,TE,TP,DTI,DT2,E 
 P1 =P2 
 DTI=DT2 
 
 IF (P2.NE.PX) GO TO 99 
 
 EX=EN*R ; SUBTOTAL FOR ENERGY AREA ENDING AT PX 
 
 KX=KK 
 
 99 IF (KKK.EQ.0.AND.P2.NE.PA(JNOJ)) GO TO 60 
 
 ET(KK)=EN*R ; CONVERTING TO J/KG UNITS 
 PP(KK)=P2 
 KK=KK+1 
 EN=0. 
 
 KKK=0 
 
 60 IF (ISTOP.EQ.1.AND.P1.EQ.PA(JNOJ)) GO TO 26 
 GO TO 24 
 
 22 E=.5*(DT2+DT1)*AL0G(P1/P2) 
 
 EP=EP+E 
 
 IF (IALL.EQ.2) URITE (10,85) P1,P2,TE,TP,DT1,DT2,E 
 P1 =P2 
 DTI=DT2 
 
 IF (P2.NE.PX) GO TO 104 
 
 EX=EP*R ; SUBTOTAL FOR ENERGY AREA ENDING AT PX 
 KX=KK 
 
 104 IF (KKK.EQ.0.AND.P2.NE.PA(JNOJ)) GO TO 61 
 ET(KK)=EP*R ; CONVERTING TO J/KG UNITS 
 PP(KK)=P2 
 KK=KK+1 
 EP=0. 
 
 KKK=0 
 
 61 IF (ISTOP.EQ.1.AND.PI.EQ.PA(JNOJ)) GO TO 26 
 GO TO 24 
 
 26 CONTINUE 
 
 C 
 
 C KK = NUMBER OF ENERGY AREAS IN SOUNDING + 1 
 KK1=KK-1 
 KK2=KK-2 
 KK3=KK-3 
 EL=0. 
 
 B2=999. 
 
 B2P=999. 
 
 B2N=999. ; 999 DENOTES THAT VARIABLE IS UNDEFINED 
 
 RLFC=0. 
 
 C DETERMINE -LFC- LEVEL 
 
 IF (KK.EQ.2.AND.ET(1).GT.0.) RLFC=PP(0) 
 
 IF (KK.EQ.3.AND.ET(1).LT.0.) RLFC=PP(1) 
 
 IF (KK.GE.4.AND.ET(1).LT.0.) RLFC=PP(1) 
 
 IF (KK.GE.4.AND.ET(1).GT.0.) RLFC=PP(2) 
 
 C IN ALL OTHER CASES RLFC IS UNDEFINED...RLFC=0. 
 
 C 
 
 IF (ET(KKl).GT.0.) GO TO 70 ; HIGHEST AREA IS +, NO INDICES COMPUTED 
 
 C -EL- LEVEL DETERMINED HERE 
 
 - 28 - 
 
EL=PP(KK2) 
 
 C COMPUTE ENERGY INDICES BELOU EL LEVEL 
 
 IF (KK.EQ.2) GO TO 70 ; ONLY ONE LAYER, ALL NEGATIVE 
 
 B2-0. 
 
 B2P*0. 
 
 B2N=0. 
 
 IF (ET(l) .LT.0.) GO TO 58 
 DO 74 1=1,KK2,2 
 74 B2P=B2P+ET(I) 
 
 IF (KK.GT.3) GO TO 68 
 B2N=0. 
 
 GO TO 69 
 
 68 DO 73 I=2,KK3,2 
 
 73 B2N=B2N+ET(I) 
 
 GO TO 69 
 
 58 DO 91 1=1,KK3,2 
 
 91 B2N=B2N+ET(I) 
 
 DO 103 I=2,KK2,2 
 103 B2P=B2P+ET(I) 
 
 69 B2=B2P+B2N 
 
 70 CONTINUE 
 C 
 
 C COMPUTE B1 INDEX (ENERGY AREAS ENDING AT PX) 
 
 KX1=KX-1 
 B1 =0. 
 
 B 1P=0. 
 
 B 1N=0. 
 
 DO 105 1=1,KX1 
 
 IF (ET(I).LT.0.) B1N=B1N+ET(I) 
 
 IF (ETC I).GT.0.) B1P=B1P+ET(I) 
 
 105 CONTINUE 
 
 IF (EX.LT.0.) B1N=B1N+EX 
 IF (EX.GT.0.) B1P=B1P+EX 
 B1=B1P+BIN 
 RETURN 
 
 C GOES TO 110, IF RANN2 CANNOT BE COMPLETED DUE TO MANY SIGN CHANGES OF DT2 
 
 C OVER A SMALL PRESSURE INTERVAL, OR TOO MANY ENERGY AREAS (KK.GT.20). 
 
 110 EL=0. 
 
 B1=999. 
 
 B1P=999. 
 
 B1N=999. 
 
 B2=999. 
 
 B2P=999. 
 
 B2N=999. 
 
 URITE (10,111) (JST(I),1=4,5) 
 
 111 FORMAT (1H ,2A2, " RANN2 SUBROUTINE DID NOT COMPLETE. 11 ) 
 
 DP=DPSAVE ; RESTORE DP TO ORIGINAL VALUE, IF IT UAS CHANGED. 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 SUBROUTINE CCL1 (IFC,Q) 
 
 C COMPUTES CCL AND CONVECTIVE TEMPERATURE 
 
 C0MM0N/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 COMMON/CCL/PCCL,ETCCL,TS0,TSD0,L,TSCCL,TCCL,TDCCL,UAVG 
 INTEGER Q 
 
 THETA(T,P2,P1)=T*(P2/P1)**.2857142 ; DRY ADIABATIC (T,P1) TO (THETA,P2) 
 DP1=100. ; AVERAGES MIXING RATIO OVER FIRST -DPI- MBS. 
 
 - 29 - 
 
USUM=0. 
 
 J=0 
 
 P1=P(0) 
 
 TDE1=TSD(0) 
 
 Ul=UliROF (P(0) ,TDE1) 
 
 PFINISH=P1-DP 1 
 
 3 P2=PFINISH 
 
 IF (P(J+l)-P2) 1,2,2 
 2 P2=P(J+l) 
 
 TDE2=TSD(J+l) ; ENVIRONMENT DEUPT AT P2 
 
 J=J+1 
 
 GO TO 9 
 
 1 PL0G1=AL0G(P(J)/P(J+D) 
 
 FACTORD=(TSD(J)-TSD(J+l))/PLOGl 
 PL0G2=AL0G(P2/P(J+1)) 
 
 TDE2=TSD(J+1)+FACT0RD*PL0G2 ; ENVIRONMENT DEUPT AT P2 
 9 U2 =UMROF(P2,TDE2) ; MIXING RATIO AT P2 
 
 PL0G3=AL0G(P1/P2) 
 
 U=.5*(U1+U2)*PL0G3 ; AVG MIX RATIO IN LYR P1-P2 
 
 USUM=USUM+U 
 P1 =P2 
 U1 =U2 
 
 IF CP2.GT.PFINISH) GO TO 3 
 C COMPUTE AVG VALUES FOR FIRST -DPI- MBS. 
 
 PLOG4=ALOG(P(0)/PFINISH) 
 
 UAVG=USUM/PLOG4 
 
 C DETERMINE LAYER CONTAINING CCL, CHECKING FROM TOP OF ATMOS DOUNUARD 
 DO 4 I=0,JNO 
 11=JNO-1 
 
 US =UMROF(P C11),TS(11)) 
 
 IF (US-UAVG) 4,5,6 
 
 4 CONTINUE 
 
 URITE (10,8) (JST(I),1=4,5) 
 
 8 FORMAT (1H ,2A2," ERROR IN CCL1") 
 
 STOP 
 
 5 PCCL=P(II) 
 
 TCCL=TS(II) 
 
 TDCCL=TSD(II) 
 
 TSCCL=THETA(TCCL+273.16,P(0),PCCL)-273.16 ; CONVECTIVE TEMP DEG C 
 
 L=JNO+l 
 
 JJNO=JNO-1 
 
 RETURN ; CCL LEVEL IS ALSO A RAOB SIGNIFICANT LEVEL 
 
 6 J-II+1 
 JJNO=JNO 
 
 IF (J.EQ.(JNO+1)) GO TO 32 ; SHORT RAOB 
 
 C MXG RATIO INTERSECTS ENVIRONMENTAL TEMP BTUN P(J) AND P(J-l) 
 
 C THIS LAYER UILL BE SUBDIVIDED UNTIL SATURATION VAPOR PRESSURE AT 
 C MIDPOINT OF LAYER IS SUFFICIENTLY CLOSE (.01 G/KG) TO UAVG. 
 
 C THIS DETERMINES THE CCL LEVEL. 
 
 P1 =P(J-1) ; BOTTOM 
 
 P2=P(J) ; TOP 
 
 T1=TS(J-1) ; BOTTOM 
 
 T2=TS(J) ; TOP 
 
 31 ALOG1=ALOG(P1/P2) 
 
 PM=.5*(P1+P2) ; MIDPOINT PRESSURE 
 
 AL0G2=AL0G(PM/P2) 
 
 TPM=T2+(T1-T2)/AL0G1*AL0G2 ; MIDPOINT TEMPERATURE 
 
 USM=UMROF(PM,TPM) ; MIDPOINT SATURATION MIXING RATIO 
 IF(ABS(USM-UAVG).LE..01) GO TO 29 ; TEST FOR TOLERANCE 
 
 IF (USM-UAVG) 28,29,30 
 
 - 30 - 
 
cm a 
 
 28 
 
 P2*PM 
 T2=TPM 
 GO TO 31 
 30 P1=PM 
 
 T1=TPM 
 GO TO 31 
 
 29 PCCL-PM ; CCL PRESSURE 
 
 TCCL=TPM ; CCL TEMPERATURE 
 C COMPUTE DEUPOINT AT CCL LEVEL 
 ALOG1=ALOG(P(J-1)/P(J)) 
 
 AL0G2=AL0G(PM/P(J)) 
 
 TDCCL=TSD(J)+(TSD(J-1)-TSD(J))/AL0G1*AL0G2 
 
 IF (TDCCL.GT.TCCL) TDCCL=TCCL ; CORRECTION FOR DEUPOINT EXCEEDING 
 1 TEMPERATURE BY SMALL AMT 
 
 TSCCL=THETA(TCCL+273.16,P(0),PCCL)-273.16 ; CONVECTIVE TEMP DEG C 
 
 L=J ; INDEX NUMBER OF ADDED CCL LEVEL 
 
 RETURN 
 
 32 URITE (IFC,33) (JST(I),I=4,5),P(JNO) 
 
 33 FORMAT ("<15X12>",3X,2A2,"RAOB TERMINATES TOO SOON, P(JNO) = ", 
 
 1 F5.0," CCL1") 
 
 RETURN Q 
 END 
 
 * 
 
 * 
 
 C THIS SUBROUTINE TO BE CALLED AFTER -CCL1- IS CALLED 
 SUBROUTINE MODRB 
 
 C0MM0N/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 COMMON/CCL/PCCL,ETCCL,TS0,TSD0,L,TSCCL,TCCL,TDCCL,UAVG 
 COMMON/TT/PT(0:50),TST(0:50),TSDT(0:50) 
 
 COMMON/V/JNOM, PX 
 C MODIFY ORIGINAL RAOB FOR 
 TS0=TSCCL 
 
 IF (L.EQ. (JNO+D) GO 
 C MOVE SGFNT LVLS ABV PCCL 
 I =JNO 
 
 1 TST(1+1)=TS(I) 
 
 TSDT(1 + 1)=TSD(I) 
 
 PT(I+l)-P(I) 
 
 1 = 1-1 
 
 IF (I.GE.L) GO TO 1 
 C ONE ADDITIONAL LVL ADDED 
 TST(L)=TCCL 
 TSDT(L)=TDCCL 
 PT(L)=PCCL 
 
 C COMPLETE THE RAOB BELOU THE CCL LEVEL 
 3 LL=L-1 
 
 DO 2 1=0,LL 
 TST(I)=TS(I) 
 
 TSDT(I)=TSD(I) 
 
 PT(I)=P(I) 
 
 MODIFY TSD(0) TO CONFORM TO UAVG, AVG MIXING RATIO IN LOUEST 100 MBS 
 X=.0200*(TSDT(0)-12.5+7500./PT(0)) ; NON-IDEAL GAS CORRECTION 
 
 UFU=1.+.0000045*PT(0)+.00140*X*X ; NON-IDEAL GAS CORRECTION 
 
 E2=.001*UAVG*PT(0)/((UAVG*.001+.62197)*UFU) ; VAPOR PRESSURE 
 
 TSD0=DPTOF(E2) 
 
 JNOM=JJNO+l 
 RETURN 
 END 
 
 SOLAR HEATING BLO CCL 
 ; SFC TEMP RESET 
 
 TO 3 ; CCL LEVEL IS A RAOB SGFNT LEVEL 
 
 UP ONE LVL 
 
 AT PCCL 
 
 - 31 - 
 
SUBROUTINE INDX1 (RLI,RKI,RUI,Q,IFC) 
 
 COMPUTES LIFTED INDEX, K INDEX, AND SHOUALTER INDEX 
 IF SFC PRES LESS THAN 850MB, K AND SHOUALTER SET = 999. 
 
 IFC DENOTES OUTPUT DEVICE FOR ERROR MSG FM THIS SUBROUTINE 
 
 COMMON/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 DIMENSION PL(3),TL(3),TDL(3) 
 
 INTEGER Q 
 
 THETA(T,P2,P1)=T*(P2/P1)**.2857142 ; DRY ADIABATIC (T,P1) TO (THETA,P2) 
 IHI=0 ; INDICATOR FOR SFC PRESSURE GREATER THAN 850MB. 
 
 PL(1)=850. 
 
 PL(2)=700. 
 
 PL(3)=500. 
 
 DP 1=50. ; AVERAGES OVER FIRST -DPI- MBS. 
 
 USUM=0. 
 
 THSUM=0. 
 
 J =0 
 
 P1 =P(0) 
 
 TE1=TS(0) 
 
 TDE1=TSD(0) 
 
 TH1=THETA(TE1+273.16,1000.,P(0)) ; POT TEMP 
 
 U1=UMROF(P(0),TDE1) 
 
 PF INISH=P1-DP 1 
 P2=PFINISH 
 IF (P(J+l)-P2) 1,2,2 
 P2=P(J+l) 
 
 J=J+1 
 
 PLOG1=ALOG(P(J)/P(J+l)) 
 FACTORT=(TS(J)-TS(J+l))/PLOGl 
 FACTORD=(TSD(J)-TSD(J+l))/PLOG1 
 PL0G2=AL0G(P2/P(J+l)) 
 TE2=TS(J+1)+FACT0RT*PL0G2 ; 
 TDE2=TSD(J+l)+FACT0RD*PL0G2 ; 
 TH2=THETA(TE2+273.16,1000.,P2) 
 U2=UMR0F(P2,TDE2) 
 PL0G3=AL0G(P1/P2) 
 
 TH =. 5* (TH 1+TH2) *PL0G3 
 U=.5*(U1+U2)*PL0G3 
 THSUM=THSUM+TH 
 USUM=USUM+U 
 
 ENVIRONMENT TEMP AT P2 
 ENVIRONMENT DEUPT AT P2 
 ; POT TEMP AT TE2,P2 
 ; MIXING RATIO AT P2 
 
 ; AVG POT TEMP IN LYR P1-P2 
 ; AVG MIX RATIO IN LYR P1-P2 
 
 P1 =P2 
 
 TH1=TH2 
 U1=U2 
 
 IF (P2.GT.PFINISH) GO TO 3 
 COMPUTE AVG VALUES FOR FIRST -DPI- MBS. 
 
 PLOG4=ALOG(P(0)/PFINISH) 
 
 THAVG=THSUM/PLOG4 
 UAVG=USUM/PLOG4 
 PPARCEL=P(0)-.5*DP1 
 
 TPARCEL=THETA(THAVG,PPARCEL,1000.)-273.16 ; DEG 
 
 X=.0200*(TPARCEL-12.5+7500./PPARCEL) ; NON-IDEAL 
 UFU=1. + . 0000045*PPARCEL+. 00 140*X>kX ; NON-IDEAL 
 
 E2=.001*UAVG*PPARCEL/( (UAVG*.001+.62197)*UFU) ; 
 TDPARCEL=DPT0F(E2) 
 
 TC=TCONOF(TPARCEL,TDPARCEL) 
 
 TH=THAVG-273.16 ; POT TEMP DEG C 
 
 UTH=UOBF(TH) 
 
 C 
 
 GAS CORRECTION 
 GAS CORRECTION 
 VAPOR PRES (MB) 
 
UTC=UOBF CTC) 
 
 THU-TH-UTH+UTC ; EQUIV LET BULB POT TEMP (DEG C) 
 
 TP500=SATLFT(THU,500.) 
 
 C GET TEMP AND DELFT AT 850,700,500 MBS 
 DO 5 J = 1,3 
 DO 4 I«0,JNO 
 IF (PL(J)-P(I)) 4,6,7 
 
 4 CONTINUE 
 
 URITE (IFC, 10) (JST(I),1=4,5),P(JNO) 
 
 10 FORMAT ("< 15>< 12>",3X,2A2, 11 RAOB TERMINATES TOO SOON, P(JNO) = ",F5.0) 
 
 RETURN Q 
 
 6 TL (J)=TS(I) 
 
 TDL(J)=TSD(I) 
 
 GO TO 5 
 
 7 IF (J.NE. 1) GO TO 8 
 
 IF (I.NE.0) GO TO 8 
 IHI = 1 
 
 GO TO 5 ; SFC PRESSURE LESS THAN 850MB 
 
 8 FACTOR=ALOG(PL(J)/P(I))/ALOG(P(I-l)/P(I)) 
 
 TL(J)=TS(I)+FACTOR*(TS(I-1)-TS(I)) 
 
 TDL(J)=TSD(I)+FACTORS(TSD(I-1)-TSD(I)) 
 
 5 CONTINUE 
 
 RLI=TL(3)-TP500 ; LIFTED INDEX 
 
 IF (IHI.EQ.0) GO TO 9 ; COMPUTE K AND SHOUALTER INDICES 
 
 RKI=999. ; K INDEX MISG 
 
 RUI=999. ; SHOUALTER INDEX MISG 
 
 RETURN 
 
 9 RKI=(TL(1)-TL(3))+TDL(1)-(TL(2)-TDL(2)) ; K INDEX 
 C COMPUTE SHOUALTER INDEX 
 
 TC =TCONOF(TL(1),TDL(1)) 
 
 TH=THETA(TL(1)+273.16,1000.,850.)-273.16 ; DEG C 
 
 UTH=UOBF(TH) 
 
 UTC=UOBF(TC) 
 
 THU=TH-UTH +UTC ; EQUIV UET BULB POT TEMP 
 TP=SATLFT(THU,500.) 
 
 RUI=TL(3)-TP ; SHOUALTER INDEX 
 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 SUBROUTINE BNDX (IFC,Q) 
 
 C DETERMINES LEVEL OF MAXIMUM INSTABILITY IN LOUER 150MBS OF RAOB, 
 
 C ADJUSTS ORIGINAL RAOB, SO LEVEL OF MAX INSTABILITY IS FIRST SGFNT 
 
 C LEVEL AND ADDS ADDITIONAL PRES LEVEL PX, IF PX IS NOT A SGFNT LEVEL. 
 
 C IF RAOB TERMINATES BELOU PX, IT IS EXTRAPOLATED TO PX, IF TOP LEVEL IS UITHIN 50 MBS 
 C IFC DENOTES OUTPUT DEVICE FOR ERROR MSG FM THIS SUBROUTINE. 
 
 C0MM0N/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 
 COMMQN/TT/PT(0:50),TST(0:50),TSDT(0:50) 
 
 COMMON/V/JNOM,PX 
 DIMENSION PB(2),TB(2),TDB(*_) 
 
 INTEGER Q 
 
 THETA(T,P2,P1)=T*(P2/P1)**.2857142 ; DRY ADIABATIC (T,P1) TO (THETA,P2) 
 
 DP2=150. 
 
 C GET TEMP AND DEUPT AT P(0)-DP2 AND PX 
 PB(1)=P(0)-DP2 
 PB(2)=PX 
 DO 5 J=l,2 
 DO 4 1=0,JNO 
 
 - 33 - 
 
IF (PB(J)-P(I)) 4,6,7 
 
 4 CONTINUE 
 1 = 1-1 
 
 IF (J.EQ.2.AND.(P(JNO)-PB(2)).LT.50.) GO TO 7 ; EXTRAPOLATES, IF UITHIN 50MBS 
 URITE (IFC,3) (JST(I),1=4,5),P(JNO) 
 
 3 FORMAT ("<15><12>",3X,2A2," RAOB TERMINATES TOO SOON, P(JNO) = ",F5.0," BNDX") 
 
 RETURN Q 
 
 6 TB(J)-TS(I) 
 
 TDB(J)=TSD(I) 
 
 GO TO 5 
 
 7 FACTOR=ALOG(PB(J)/P(I) )/ALOG(P( I-l)/P( I)) 
 
 TB(J)=TS(I)+FACTOR*(TS(I-1)-TS(I)) 
 
 TDB(J) =TSD(I) +FACTOR*(TSD(I-1)-TSD(I)) 
 
 5 CONTINUE 
 
 C FIND LARGEST POTENTIAL UET BULB TEMPERATURE IN FIRST DP2 MBS 
 THUMAX=-1000. 
 
 11=0 
 
 DO 1 1=0,JNO 
 IF (P(I)-PB(l)) 8,10,10 
 
 10 TC=TCONOF (TS(I),TSD(I)) 
 
 TH=THETA(TS(I)+273.16,1000., P (I))-273.16 ; DEG C 
 UTH=UOBF(TH) 
 
 UTC=LJOBF (TO 
 
 THU=TH-UTH +UTC ; UET BULB POTENTIAL TEMPERATURE 
 IF (THU-THUMAX) 1,1,2 
 2 THUMAX=THU 
 
 11 = I 
 
 PMAX=P(D 
 TMAX=TS(I) 
 
 TDMAX=TSD(I) 
 
 1 CONTINUE 
 
 8 IF (P(I-l).EQ.PB(l)) GO TO 9 
 
 TC=TCONOF (TB(1),TDB(1)) 
 
 TH=THETA(TB(l)+273.16,1000.,PB(1))-273.16 ; DEG C 
 
 UTH=UOBF(TH) 
 
 UTC=UOBF(TC) 
 
 THU=TH-UTH+UTC ; UET BULB POT TEMP 
 IF (THU-THUMAX) 9,9,12 
 12 THUMAX=THU 
 
 11=1-1 
 PMAX=PB(1) 
 
 TMAX=TB(1) 
 
 TDMAX=TDB(1) 
 
 9 CONTINUE 
 
 C MODIFY RAOB SO LOUEST LEVEL HAS MAXIMUM UET BULB POTENTIAL TEMPERATURE 
 PT(0)=PMAX 
 TST(0)=TMAX 
 TSDT(0)=TDMAX 
 JNOO=JNO-11 
 DO 11 J=l,JNOO 
 PT(J)=P(J+II) 
 
 TST(J)=TS(J+II) 
 
 TSDT(J)=TSD(J+II) 
 
 11 CONTINUE 
 
 DO 14 J=l,JNOO 
 IF (PB(2)-PT(J)) 14,17,16 
 14 CONTINUE 
 
 J=JNOO+l 
 
 GO TO 20 ; EXTRAPOLATE RAOB 
 
 16 I=JNOO 
 
 - 34 - 
 
18 
 
 MOVE ALL LEVELS ABOVE PB<2) UP 1 LEVEL 
 
 TST(I+1)«TST(I) ; 
 
 TSDT(I+1)=TSDT(I) 
 
 PTC 1 + 1)"PTC I) 
 
 1 = 1-1 
 
 IF (I.GE.J) GO TO 18 ; J SET IN DO 14 LOOP 
 
 20 TSTCJ)=TB(2) ; ADD TBC2) LEVEL 
 
 TSDTCJ)*TDB(2) 
 
 PTCJ)=PB(2) 
 
 JNOM=JNOO+l 
 GO TO 19 
 
 1? JNOM=JNOO 
 
 19 CONTINUE 
 
 RETURN 
 END 
 
 * 
 
 * 
 
 SUBROUTINE DECOM C1ST,IDATE,IHOUR,Z,T,TD,D,S,Q,IFD,PTROP) 
 
 C DECODES MANDATORY LVL RAOB DATA UP TO AND INCLUDING MAX UND (77/66 GRP) 
 
 C SUBROUTINE SEARCHES FOR SPECIFIED DATE CIDATE) & HOUR CIHOUR) 
 
 C 1ST...AFOS IDENTIFER, IFD... OUTPUT DEVICE 
 C Q...ABNORMAL ERROR RETURN STATEMENT NUMBER 
 
 C 2...C0 = SFC PRES), Cl,2_10 = HGTS), Cll = TROP DATA), (12 = MAX UND) 
 
 C T...TEMPERATURE, TD...DEUPOINT, D...UND DIR, S...UND SPEED 
 C TC12) = LOUER UIND SHEAR, TDC12) = UPPER UIND SHEAR 
 C PTROP = Z(ll) IS TROP PRESSURE FROM "88" GROUP, THIS REDUNDANCY FOR 
 C BENEFIT OF RANP PROGRAM! 
 
 C 
 
 c 
 
 MISSING DATA 
 
 i INDICATED AS FOLLOUS 
 
 i: 
 
 c 
 
 HEIGHT 
 
 Z( 1.10) 
 
 — 
 
 999 
 
 c 
 
 PRESSURE 
 
 ZC11,12) 
 
 
 999 
 
 c 
 
 TEMPERATURE 
 
 T & TD (1, . . ., 11) 
 
 
 999 
 
 c 
 
 UND SHEAR 
 
 T 8, TDC12) 
 
 j-* 
 
 999 
 
 c 
 
 UND 
 
 D & S(0.12) 
 
 
 -99 
 
 C 
 
 INTEGER Q 
 
 DIMENSION IST(5),Z(0:12),T(0:12),TD(0:12),D(0:12),S(0:12),IOUTC40) 
 COMMON/SI/ISC0:12) 
 
 DATA IS/99,00,85,70,50,40,30,25,20,15,10,88,77/ 
 
 KS=0 ; INDICATOR FOR LAST LEVEL OF UIND DATA REPORTED 
 CALL AFREAD Cl,1ST,$100) 
 
 CALL AFREAD (2,IOUT,$50,$125) ; READ 1ST LINE 
 
 7 LC= 1 ; LINE COUNTER 
 
 IF (IOUT(4).EQ."TT".AND.IOUT(5).EQ."AA") GO TO 3 ; NEU RAOB FORMAT 
 
 GO TO 4 ; OLD RAOB FORMAT 
 
 C 
 
 C NEU RAOB FORMAT 
 
 3 IF (I0UTC6).EQ." 5".OR.I0UTC6).EQ." 6".OR.I0UTC6).EQ." 7".OR. 
 
 1 I0UTC6).EQ." 8") GO TO 1 ; TESTING FOR SINGLE SPACE AFT TTAA 
 
 K=-5 ; DOUBLE SPACE AFTER TTAA 
 
 K1 =-3 
 K2=-2 
 GO TO 2 
 
 1 K=-6 ; SINGLE SPACE AFTER TTAA 
 
 K1 =-3 
 K2=-2 
 GO TO 2 
 C 
 
 C OLD RAOB FORMAT 
 
 - 35 - 
 
o n 
 
 4 
 
 1 
 
 DATE 
 
 HOUR 
 
 TESTING IDT 8, IHR FOR COR VERSION 
 
 10 
 
 C 
 
 5 
 
 C 
 
 C 
 
 K=0 
 
 IF (I0UT(6).EQ." U".AND.I0UTC7).EQ."SI") K=4 
 K1=K/2 
 K2=0 
 
 IF (I0UTC9+K1).EQ." 5".OR.I0UTC9+K1).EQ." 6".OR.I0UTC9+K1).EQ." ?". 
 
 OR.I0UTC9+K1).EQ." 8") GO TO 2 ; TESTING FOR SINGLE SPACE AFT TTAA 
 
 K=K-1 
 
 IDT-ITCVT (18+K,2,$900)-50 
 IHR=ITCVT (20+K,2,$900) ; 
 
 IVCHECK=IVCK(IDATE,IHOUR,IDT,IHR) 
 
 GO TO (5, 10, 116, 114), IVCHECK 
 CALL PRVRF CIER) 
 
 IF (IER.NE.1) GO TO 114 
 CALL AFREAD (3,IST,$102) 
 
 CALL AFREAD (2,IOUT,$50,$125) ; 
 
 GO TO 7 
 
 TEST FOR MISSING RAOB 10142 ETC. 
 
 11A=ITCVT (30+K,4,$900) 
 
 IIB=ITCVT (34+K,1,$900) 
 
 111A = ITCVT (36+K,3,$900) 
 
 IF (IIA.EQ.5151.AND.IIB.EQ.5.AND.11IA.EQ.101) GO TO 110 
 KKK=IOUT(11+K1) ; INDICATOR FOR LAST LEVEL OF UND DATA 
 
 KKK2=IOUT(11+K2) ; 2ND INDICATOR FOR LAST LEVEL OF UND DATA 
 
 KSS=1 ; SOME UIND DATA AVAILABLE 
 
 IF (KKK.EQ."0/".OR.KKK.EQ."2/".0R.KKK2.EQ."/ ") KSS=0 ; NO UND DATA AVBL 
 IF (KSS.EQ.l) KS-ITCVT(22+K,1,$900) ; READ INDICATOR FOR LAST LVL OF UND 
 
 BEGIN READING SFC PRES GRP 
 
 READ 1ST LINE OF PREVIOUS VERSION 
 
 K=29+K j 
 JC=-1 
 KC=4 j 
 
 LC = 1 j 
 
 GO TO 19 
 
 SET CHARACTER INDEX 
 SET LEVEL INDEX 
 SET GROUP INDEX 
 LINE COUNTER 
 
 C 
 
 18 
 
 SET GROUP INDEX 
 (2,IOUT,$50,$125) ; 
 
 LINE COUNTER 
 (KG.EQ.1.AND.JC.LT.12) GO TO 20 
 (KG.EQ.1.AND.JC.EQ. 12) GO TO 26 
 
 KC=0 ; 
 CALL AFREAD 
 LC=LC+1 ; 
 IF 
 IF 
 
 READ 2ND AND SUBSEQUENT LINES 
 
 ; READ TEMP/DEUPT GRP NEXT 
 
 ; READ MAX UND GRP 
 
 IF (KG.EQ.2.AND.KSS.EQ.1.AND.(I2.GE.KS.0R.IZ2.EQ.88)) GO TO 26 
 
 C 
 
 19 
 
 80 
 
 81 
 
 READ HEIGHT GROUP 
 
 KG = 1 
 
 KC-KC+1 
 
 JC-JC+1 
 
 GO TO 81 ; DELETE THIS LINE FOR TEST, LINE 088 
 
 NEXT THREE STATEMENTS FOR TEST ONLY 
 
 JD=JC-1 ; TEMPO TEST !!!!!!!!!!! 
 
 IF (JD.GE.0) URITE (IFD,80) LC,KC,K,JC,2(JD),T(JD),TD(JD),D(JD),S(JD) 
 
 FORMAT (1H ,4I3,F8.0,2F9.1,2F8.0) ; TEMPO TEST 
 
 CONTINUE 
 
 IZ =ITCVT(1+K,1,$900) ; INDICATOR FOR PRES LEVEL 
 
 IZ2 =ITCVT(1+K,2,$900) ; 2ND INDICATOR FOR PRES LEVEL 
 
 : NORMAL 
 
 NORMAL, 66 ENCODED INSTEAD OF 77 
 77 GROUP NOT REPORTED, 51515 READ 
 : SOME LEVELS MISG 
 
 ,OR.JC.EQ.12)) GO TO 34 ; 88 OR 77 GRP ON NXT LINE 
 FORMAT ERROR 
 
 IF 
 
 IF 
 
 IF 
 
 IF 
 
 IF 
 
 (IZ2.EQ. ISCJC)) GO TO 27 
 (IZ2.EQ.66) GO TO 27 
 (IZ2.EQ.51) GO TO 79 
 (IZ2.EQ.88) GO TO 29 
 (IZ2.EQ.00.AND.(JC.EQ. 
 
 GO TO 112 
 
 11-1 
 
 (UAL 
 
 - 36 - 
 
27 
 
 C 
 
 29 
 
 33 
 
 C 
 
 34 
 
 C 
 
 C 
 
 C 
 
 20 
 
 30 
 
 31 
 
 22 
 
 23 
 
 28 
 
 C 
 
 c 
 
 c 
 
 21 
 
 26 
 
 Z(JC)=FTCVT(3+K,3,$901) ; HEIGHT (OR SFC, TROP, MAX UND PRES) 
 
 IF (JC.EQ. ll.AND.Z(JC).EQ.999.) GO TO 69 ; TROP NOT OBSERVED 
 
 IF (JC.EQ. 12.AND.Z(JC).EQ.999.) GO TO 69 ; MAX UND NOT OBSERVED 
 
 IF (JC.EQ.12) GO TO 21 ; READ MAX UND GRP 
 
 IF (KC.LT.10) GO TO 20 
 K>-6 
 
 GO TO 18 
 
 DO 33 I=JC,10 ; SETTING LVLS MISG (SHORT RAOB) 
 
 Z(I)=-99.9 ; UILL BE CHANGED TO -999., STATEMENT 63 
 
 T(I)*999. 
 
 TD(I)=999. 
 
 D(I)=-99. 
 
 S(I)=-99. 
 
 JC=11 
 GO TO 27 
 
 KG=3 ; GO TO NEXT LINE TO READ 83 OR 77 GRP (UAL) 
 
 K=0 
 
 JC=JC-1 
 GO TO 18 
 
 READ TEMPERATURE/DEUPOINT GROUP 
 
 KG=2 
 
 KC=KC+1 
 
 KL=7+K 
 
 KLL=(KL+5)/2 
 
 KLM=KLL-2 
 
 IF (IOUT(KLM).EQ." /".OR.IOUT(KLM).EQ."//") GO TO 22 ; TEMP MISG 
 
 T(JC)=FTCVT(KL,3,$901) ; READ TEMPERATURE 
 
 IF (IOUT(KLL).EQ."/ ".OR.IOUT(KLL).EQ."//") GO TO 30 ; DEUPT MISG 
 
 TD(JC)=FTCVT(10+K,2,$901) ; READ DEUPOINT 
 
 GO TO 31 
 
 TD(JC)=999. ; DEUPOINT MISSING 
 
 CALL TEMPI (T(JC),TD(JC)) 
 
 GO TO 23 
 
 T(JC)=999. ; GOES HERE, IF TEMP AND DEUPT BOTH MISG 
 
 TD(JC)=999. 
 
 CONTINUE 
 
 IF ((KSS.EQ.1.AND.(IZ.GE.KS.OR.IZ2.EQ.00)).OR.IZ2.EQ.88.OR.IZ2.EQ. 
 
 1 99) GO TO 21 ; TEST UHETHER OR NOT TO READ UND GRP 
 
 IF (KC.EQ. 10) GO TO 28 
 
 K=K+12 
 
 D(JC)=-99. ; 
 
 UND 
 
 MISG 
 
 S(JC)=-99. 
 
 GO TO 19 ; 
 
 SKIP 
 
 UNDS 
 
 K=0 
 
 D(JC)=-99. 
 
 S(JC)=-99. 
 
 GO TO 18 ; 
 
 SKIP 
 
 UNDS 
 
 READ UIND GROUP 
 
 
 
 IF (KC.LT.10) GO TO 26 
 
 K=-12 
 
 GO TO 18 
 
 KG=3 
 
 KC=KC+1 
 
 IF (JC.EQ.12.AND.KC.GT.1) K=K-6 ; READING 77 UND GRP 
 
 - 37 - 
 
24 
 
 25 
 
 40 
 
 79 
 
 69 
 
 C 
 
 C 
 
 71 
 
 72 
 
 76 
 
 77 
 
 78 
 
 C 
 
 C 
 
 C 
 
 C 
 
 C 
 
 73 
 
 61 
 
 60 
 
 64 
 
 63 
 
 62 
 
 KUOC13-HO/2+1 
 
 IF (IOUT(KLK).EQ."//") GO TO 24 ; UIND MISSING 
 
 D(JC)-FTCVT(13+K,2,$901) ; READ UND DIR 
 
 S(JC)=FTCVT(15+K,3,$901) ; READ UND SPEED 
 
 CALL UND (D(JC),S(JC)) 
 
 GO TO 25 
 
 D(JC)=-99. ; UND MISSING 
 
 S C JO =-99. 
 
 CONTINUE 
 
 IF (IZ2.EQ.77.0R.IZ2.EQ.66) GO TO 71 ; MAX UND READ, DO UND SHEAR NXT 
 
 IF (KC.LT.10) GO TO 40 
 
 K=0 
 
 GO TO 18 
 CONTINUE 
 K=K+18 
 GO TO 19 
 
 Z (JC) =999. ; MAX UND GROUP NOT REPORTED 
 
 T(JO =999. ; GOES HERE, IF TROP OR MAX UND NOT OBSERVED 
 
 TD (JO =999. 
 
 D (JC) =-99. 
 
 S(JC)=-99. 
 
 IF (JC.EQ.12) GO TO 73 ; FINISHED 
 
 K=K+6 
 
 GO TO 19 ; READ 77 GROUP 
 
 READ 77 UIND SHEAR GROUP 
 CONTINUE 
 
 IF (KC.LT.10) GO TO 72 
 
 CALL AFREAD (2,IOUT,$50,$125) ; READ NXT LINE FOR UND SHEAR 
 
 K=-18 
 
 IFOUR=ITCVT(19+K,1,$900) 
 
 IF (IFOUR.NE.4) GO TO 112 
 KMK=(20+K)/2 
 
 IF (IOUT(KMK).NE."4/") GO TO 76 ; 
 T(JC)=999. ; 
 GO TO 77 
 
 T(JC)=FTCVT(20+K,2,$901) ; LOUER 
 IF (I0UT(KMK+2).NE."/ ") GO TO 78 ; 
 TD(JC)=999. ; 
 GO TO 73 ; 
 TD(JC)=FTCVT(22+K,2,$901) ; UPPER 
 
 READ LOUER UND SHEAR 
 LOUER UND SHEAR MISSING 
 
 UND SHEAR 
 
 READ UPPER UND SHEAR 
 UPPER UND SHEAR MISSING 
 FINISHED 
 UND SHEAR 
 
 SECONDARY UND MAXIMUM, IF ANY,(2ND 77 OR 66 GROUP) IS NOT DECODED 
 
 DECODE PRESSURE/HEIGHT VALUES: Z(0)/Z(1)_Z(10) 
 
 IF (Z(0).LT.100.) Z(0)=Z(0)+1000. ; SFC PRES 
 
 IF (Z(1).LE.500.) GO TO 60 
 
 Z(1)=-(Z(1)-500.) ; 1000MB LEVEL BLO SEA LEVEL 
 
 URITE (IFD,61) (IST(I),1=4,5),Z(1) 
 
 FORMAT ("<15><12>",3X,2A2," 1000MB LVL BLO SEA LEVEL, Z(1) = ",F5.0) 
 Z(2)=Z(2)+1000. ; 850MB 
 
 IF (Z(3).GT.500.) GO TO 64 
 Z (3) =Z(3)+3000. 
 
 GO TO 63 
 
 Z(3)=Z(3)+2000. ; 700MB 
 
 DO 62 1=4,10 
 
 Z(I)=Z(I)*10. ; 500 TO 100 MB 
 
 DO 74 1=7, 10 
 
 IF (Z(I).EQ.-999.) GO TO 75 ; LEVELS MISSING 
 
 - 38 - 
 
74 
 
 75 
 
 250 TO 100 MB 
 
 C 
 
 c 
 
 900 
 
 65 
 
 901 
 
 66 
 
 50 
 
 51 
 
 100 
 
 101 
 
 102 
 
 103 
 
 125 
 
 126 
 
 110 
 
 111 
 
 112 
 
 113 
 
 114 
 
 115 
 
 116 
 117 
 
 Z( I) =Z( D + 10000. 
 CONTINUE 
 PTROP-Z(ll) 
 RETURN 
 
 ERROR RETURNS 
 
 URITE (IFD,65) (IST(I),I=4,5) 
 
 FORMAT ("<15X12>",3X,2A2," ERROR IN ITCVT - DECOM") 
 
 RETURN Q 
 
 URITE (IFD,66) (IST(I),1=4,5) 
 
 FORMAT ("<15><12>"3X,2A2," ERROR IN FTCVT - DECOM") 
 
 RETURN Q 
 
 URITE (IFD,51) (IST(I),1=4,5) 
 
 FORMAT ("<15><12>”,3X,2A2," AFREAD ERROR 50 - DECOM") 
 
 RETURN Q 
 
 URITE (IFD,101) (IST(I),1=4,5) 
 
 FORMAT ("<15X12>",3X,2A2," AFREAD ERROR 100 - DECOM") 
 
 RETURN Q 
 
 URITE (IFD,103) (IST(I),1=4,5) 
 
 FORMAT ("<15><12>",3X,2A2," AFREAD ERROR 102 - DECOM") 
 
 RETURN Q 
 
 URITE (IFD,126) (IST(I),I-4,5) 
 
 FORMAT ("<15><12>",3X,2A2," AFREAD ERROR 125 - DECOM") 
 
 RETURN Q 
 
 URITE (IFD,111) (IST(I),1=4,5) 
 
 FORMAT ("<15><12>",3X,2A2," STATION MISSING - DECOM") 
 
 RETURN Q 
 
 URITE (IFD,113) (IST(I),1-4,5),IS(JC) 
 
 FORMAT ("<15><12>",3X,2A2," FORMAT ERROR AT LEVEL ",I2," - DECOM") 
 RETURN Q 
 
 URITE (IFD,115) (IST(I),1=4,5) 
 
 FORMAT ("<15X12>",3X,2A2," DESIRED VERSION NOT FOUND - DECOM") 
 RETURN Q 
 
 URITE (IFD,117) (IST(I),1=4,5) 
 
 FORMAT ("< 15>< 12>",3X,2A2, " NEIJ RAOB NOT AVBL - DECOM") 
 
 RETURN Q 
 END 
 
 * 
 
 C 
 
 C 
 
 c 
 
 c 
 
 c 
 
 c 
 
 c 
 
 c 
 
 1 
 
 2 
 
 * 
 
 FUNCTION IVCK (IDATE,IHOUR,IDT,IHR) 
 
 CHECKS DATE/TIME GROUP TO GET DESIRED VERSION 
 
 IDATE,IHOUR...DATE/HOUR UANTED. IDT,IHR... DATE/HOUR OF CURRENT VERSION 
 OUTPUT IS AN INTEGER UITH VALUE 1 TO 4: 
 
 IVCK = 1 CURRENT VERSION IS UANTED 
 
 2 PREVIOUS VERSION IS UANTED 
 
 3 NEU VERSION IS NOT AVAILABLE 
 
 4 VERSION UANTED IS TOO FAR BACK, CANNOT BE RETRIEVED 
 DESIGNED TO RETRIEVE VERSIONS UP TO ABOUT 10 DAYS IN THE PAST. 
 
 IDTCHECK=IDATE-IDT 
 IF (IDTCHECK) 1,3,2 
 IVCK=2 
 
 IF (IDTCHECK.LT.-10) IVCK=4 
 IF (IDTCHECK.LT.-20) IVCK=3 
 RETURN 
 IVCK=2 
 
 IF (IDTCHECK.LT.20) IVCK=4 
 IF (IDTCHECK.LT.10) IVCK=3 
 RETURN 
 
 - 39 - 
 
3 IHRCHECK=IHOUR-IHR 
 IF (IHRCHECK) 4,5,6 
 
 4 IVCK=2 
 RETURN 
 
 5 IVCK-1 
 RETURN 
 
 6 IVCK=3 
 RETURN 
 END 
 
 * 
 
 * 
 
 SUBROUTINE UND (D,S) 
 
 C UIND DECODE...D = DIRECTION S= SPEED 
 IF (S.LT.500.) GO TO 1 
 D=D*10.+5. 
 
 S=S-500. 
 
 RETURN 
 1 D=D*10. 
 
 RETURN 
 
 END 
 
 >K 
 
 * 
 
 SUBROUTINE HEIGHT (ZZ,PRES,HGT,Q) 
 
 C GIVES HGT OF PRES SFC ACCORDING TO HEIGHTS OF STANDARD LVLS IN "ZZ" ARRAY 
 INTEGER Q 
 
 DIMENSION ZZ(0:12) 
 
 COMMON/PS/SP(10) 
 
 DATA SP/1000.,850.,700.,500.,400.,300.,250.,200.,150.,100./ 
 
 DO 1 1=1,10 
 IF (PRES-SP(I)) 1,2,3 
 
 1 CONTINUE 
 
 1=1-1 ; "I" IS INCREASED TO 11, UHEN "DO 1" LOOP IS FINISHED 
 
 IF ((SP(10)-PRES).LE.50.) GO TO 3 ; EXTRAPOLATE UPUARD 
 
 RETURN Q ; PRES IS NOT UITHIN RANGE 
 
 2 HGT=ZZ(I) ; PRES IS A STANDARD PRESSURE SFC 
 
 RETURN 
 
 3 IF (I.EQ.l) 1=1+1 
 
 SPC=SP(I-1)-PRES 
 
 IF (SPC.LT.-100.) RETURN Q ; IF PRES MORE THAN 1100MB, DON'T EXTRAPOLATE 
 IF (ZZCI).EQ.-999..AND.SPC.GT.50.) RETURN Q ; 50MB LIMIT ON UPUARD EXTRAPOLATION 
 IF (ZZCI-1).EQ.-999.) RETURN Q ; CANNOT CONTINUE, LUR LVL MISG 
 IF CZZCI).EQ.-999.) 1=1-1 ; EXTRAPOLATES UPUARD IF UITHIN 50MB 
 
 HGT=ZZ(I)+(ZZ(I-1)-ZZ(I))/ALOG(SP(I-1)/SP(I))*ALOG CPRES/SP(I)) 
 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 FUNCTION JREAL (R) 
 
 C ROUNDS REAL "R" TO INTEGER VALUE 
 RA=ABS(R) 
 
 JREAL=RA ; TRUNCATES POSITIVE R TO INTEGER 
 
 RD=RA-JREAL ; DECIMAL PORTION 
 IF CRD.GE..5) JREAL=JREAL+1 
 
 IF (R.LT.0.) JREAL=-JREAL ; CHANGE TO ORIGINAL SIGN 
 
 - 40 - 
 
RETURN 
 
 END 
 
 * 
 
 * 
 
 FUNCTION FTCV(DAT,Q) 
 
 C 
 
 C THIS FUNCTION IS FOR USE IN READING NUMERICAL DATA INPUT BV SWITCHES 
 C ASCII CHARACTERS IN "DAT" ARE UNPACKED, SCANNED, AND INTERPRETED 
 C AS REAL NUMBERS. IF NO DECIMAL POINT IS DETECTED, IT IS ASSUMED 
 
 C TO FOLLOW THE LAST NUMERAL IN THE FIELD. THE SCAN BEGINS 
 
 C WITH CHARACTER IBGN. N CHARACTERS ARE SCANNED. 
 
 C ABNORMAL RETURN TO STATEMENT ~Q~. 
 
 C THIS IS A MODIFICATION OF FUNCTION FLTCVT IN AFREAD.LB 
 C 
 
 DIMENSION IOUTUC20) 
 
 INTEGER Q,DAT(10) 
 
 LOGICAL NEG 
 IBGN=1 
 
 CALL UNPACK(DAT,20,IOUTU) 
 
 C 
 
 C DETERMINE NUMBER OF CHARACTERS TO READ 
 N=0 
 
 DO 1 1=1,20 
 
 IF (IOUTUCI).EQ.0) GO TO 2 
 
 1 N=N+1 
 C 
 
 2 CONTINUE 
 FTCV=0. 
 
 NEG=.FALSE. 
 
 IEND=IBGN+N-1 
 
 100 
 
 IF (IOUTUCIEND).NE. 
 
 32) 
 
 GO 
 
 H 
 
 O 
 
 
 IF (IEND.EQ.IBGN) RETURN 
 
 
 
 IEND=IEND-1 
 
 GO TO 100 
 
 
 
 
 200 
 
 DO 250 I = IBGN,IEND 
 IF (IOUTUCI).NE.32) 
 
 GO 
 
 TO 
 
 300 
 
 250 
 
 CONTINUE 
 
 RETURN 
 
 
 
 
 300 
 
 IF (IOUTUCI).EQ.43) 
 
 GO 
 
 TO 
 
 400 
 
 
 IF (IOUTUCI).NE.45) 
 
 GO 
 
 TO 
 
 500 
 
 NEG=.TRUE. 
 
 400 1=1+1 
 
 500 J=I 
 
 DO 600 I=J,IEND 
 
 IF (IOUTU(I).EQ.32) IOUTUCI)=48 
 IF (IOUTU(I).LT.48.OR.IOUTUCI).GT.57) GO TO 700 
 FTCV=FTCV*10+IOUTU(I)-48 
 600 CONTINUE 
 
 IF CNEG) FTCV=-FTCV 
 RETURN 
 
 700 IF (IOUTUCI).NE.46) GO TO 800 
 
 J-I + l 
 DIV=10. 
 
 DO 750 I=J,IEND 
 
 IF (IOUTUCI).EQ.32) IOUTU(I)=48 
 
 IF (IOUTU(I).LT.48.OR.IOUTUCI).GT.57) GO TO 800 
 
 FTCV=FTCV+(IOUTU(I)-48)/DIV 
 
 DIV»DIV*10. 
 
 - 41 - 
 
750 
 
 CONTINUE 
 
 IF (NEG) FTCV—FTCV 
 RETURN 
 800 RETURN Q 
 END 
 
 * 
 
 * 
 
 OVERLAY 0V2 
 SUBROUTINE TPB 
 
 C COMPUTATION OF POTENTIAL UNSTABLE LYRS AND OUTPUT FOR URKTPB 
 
 C0MM0N/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 COMMON/G/PP(0:20),ET(20),TU(0:50),DP,EFF,KMOD,KK 
 COMMON/GG/NJ,PPB(15),PPT(15),DELPP(15),DTUDP(15),DPB(15),DPT(15), 
 
 1 PTMAX,PBMAX,TULAPSE,DMAX 
 
 THETA(T,P2,P1)=T*(P2/P1)**.2857142 ; DRY ADIABATIC (T,P1) TO (THETA,P2) 
 
 C 
 
 C COMPUTE UET BULB POTENTIAL TEMP AT ALL SGFNT LEVELS ABV SFC 
 DO 78 I =0,JNO 
 
 TC-TCONOF(TS(I),TSD(I)) ; CONDENSATION TEMPERATURE 
 TH=THETA(TS(I)+273.16,1000.,P( I))-273.16 ; POT TEMP DEG C 
 
 UTH=UOBF(TH) 
 
 UTC=UOBF(TO 
 
 78 TU(I)=TH-UTH+UTC ; UET BULB POT TEMP - DEG C 
 C 
 
 CALL PULYR ; DETERMINES POTENTIAL (CONVECTIVE) UNSTABLE LAYERS 
 URITE (21,1) (JST(I),I=4,5),(KDATE(I),1*1,3),IHOUR 
 
 1 FORMAT (12X,“ POTENTIAL (CONVECTIVE) UNSTABLE LAYERS FOR ■ 
 
 1 ,2A2,4X, 12, 12, 12,3X, 12, "2") 
 
 URITE (21,2) 
 
 2 FORMAT ("<15><12>",3X,"P1",8X,"P2",8X,"DP",4X,"TULAPSE",6X,"DP1",7X, n DP2") 
 M=NJ+1 
 
 DO B 1=1,NJ 
 J =M-1 
 
 URITE (21,7) PPB(J),PPT(J),DELPP(J),DTUDP(J),DPB(J),DPT(J) 
 
 7 FORMAT ("<15><12>",1X,F5.0,2F10.0,F10.1,2F10.0) 
 
 8 CONTINUE 
 URITE (21,5) 
 
 5 FORMAT ("< 15><12>") ; BLANK LINE 
 
 URITE (21,77) 
 
 77 FORMAT ("<15X12>","SIGNIFICANT LEVELS", 
 
 1 /"< 15>< 12>", 4X, "P", 9X, "T", 9X, 11 TD", 8X, "TU (UET BULB POTENTIAL TEMP)") 
 
 M=JNO 
 
 DO 79 1=0,M 
 J=M-1 
 
 URITE (21,80) P(J),TS(J),TSD(J),TU(J) 
 
 80 FORMAT ("<15><12>",IX,F5.0,3F10.1) 
 
 79 CONTINUE 
 
 URITE (21,5) ; ENDING UITH BLANK LINE 
 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 OVERLAY 0V3 
 
 SUBROUTINE TPA(JEFF,EL1,RLI,RKI,RUI,IDECOM) 
 
 C OUTPUT FOR SINGLE STATION RAOB ANALYSIS FOR URKTPA 
 
 C0MM0N/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 
 - 42 - 
 
54 
 
 71 
 
 45 
 
 72 
 
 46 
 
 73 
 
 5 
 
 4 
 
 C 
 
 50 
 
 27 
 
 51 
 
 26 
 
 56 
 
 47 
 
 57 
 
 48 
 
 59 
 
 52 
 
 53 
 
 100 
 
 COMMON/G/PP(0:20),ET(20),TU(0:50),DP,EFF,KMOD,KK 
 COMMON/GG/NJ,PPB(15),PPT(15),DELPP(15),DTUDP(15),DPB(15),DPT(15), 
 
 1 PTMAX,PBMAX,TULAPSE,DMAX 
 
 COMMON/T/RLCL,RLFC,EL,B2,B2P,B2N,IALL,B1,B1P,B1N,EX 
 COMMON/CCL/PCCL,ETCCL,TS0,TSD0,L,TSCCL,TCCL,TDCCL,UAVG 
 COMMON/TT/PT(0:50),TST(0:50),TSDTC0:50) 
 
 COMMON/V/JNOM,PX 
 
 URITE (20,54) (JST(I),1-4,5),(KDATE(I),1-1,3),IHOUR 
 
 FORMAT (1H ,"RAOB ANALYSIS FOR •,2A2,4X,12,V»,I2,"/",I2,3X,12,"Z", 
 
 1 1IX,"UNITS : J/KG X 10") 
 
 IF (JEFF.GE. 100) GO TO 45 
 URITE (20,71) EFF,JEFF 
 
 FORMAT ("<15><12>",2X,"ASSUMED EFF - ",F4.0," PERCENT ENTRAINMENT 
 1 PER 500MB ASCENT, FOR Ell, EI2 & EL",12) 
 
 GO TO 46 
 
 URITE (20,72) EFF,JEFF 
 
 FORMAT ("<15X12>",2X,"ASSUMED EFF = ",F4.0," PERCENT ENTRAINMENT 
 1 PER 500MB ASCENT, FOR Ell, EI2 8. EL", 13) 
 
 URITE (20,73) 
 
 FORMAT ("<15X12>",2X, "ASSUMED EFF = 0. PERCENT ENTRAINMENT 
 
 1 PER 500MB ASCENT, FOR EL") 
 
 URITE (20,5) 
 
 FORMAT ("<15X12>") ; PUTTING IN BLANK LINE 
 
 URITE (20,4) P(0),P(JNO),PT(0),PX 
 
 FORMAT ("<15X12>","P0 = ",F5.0,4X,"PTOP * ",F5.0,4X,"PMAX (MAX INSTABILITY) 
 1 F5.0,4X,"PX = ",F5.0) 
 
 IF (IDECOM.EQ.0) GO TO 27 
 URITE (20,50) EL,EL1,RLCL,RLFC 
 
 FORMAT ("<15X12>“,"EL = ",F5.0," MB (",F4.0," HND FT) LCL = ", 
 
 1 F5.0,4X,"LFC = ",F5.0/"<15><12>","BASED ON PARCEL MVG FM LVL -PMAX-") 
 
 GO TO 26 
 
 URITE (20,51) EL,EL 1,RLCL,RLFC 
 
 FORMAT ("<15X12>","EL = ",F5.0," MB (",F4.0,"E HND FT) LCL - ", 
 
 1 F5.0,4X,"LFC = ",F5.0/"<15><12>","BASED ON PARCEL MVG FM LVL -PMAX-") 
 
 CONTINUE 
 URITE (20,5) 
 
 IF (JEFF.GE. 100) GO TO 47 
 URITE (20,56) B2,JEFF,B1,B2P,B1P,B2N,BIN 
 FORMAT ("<15X12>","EI2 = ",F7.0,2X,"ENERGY PMAX TO EL 
 
 1 "ENERGY PMAX TO PX"/ 
 
 2 "<15X12>","EI2P = ",F7.0,2X,"POSITIVE PART",9X,"El IP = 
 
 3 "<15X12>","EI2N - ",F7.0,2X,"NEGATIVE PART",9X,"EI IN = 
 
 GO TO 43 
 
 URITE (20,57) B2,JEFF,B1,B2P,B1P,B2N,BIN 
 FORMAT ("<15X12>","EI2 = ",F7.0,2X,"ENERGY PMAX TO EL 
 
 1 "ENERGY PMAX TO PX"/ 
 
 2 "<15X12>","EI2P = ",F7.0,2X,"POSITIVE PART",9X,"EI IP = 
 
 3 "< 15X 12>","EI2N = ",F7.0,2X,"NEGATIVE PART",9X,"EI IN = 
 
 URITE (20,5) 
 
 URITE (20,59) 
 
 FORMAT ("<15X12>", "PI",9X, "P2",9X, "ENERGY GAINED (LOST) IN LAYER") 
 
 KK1=KK-1 
 DO 53 1=1,KK1 
 J = I-1 
 
 URITE (20,52) PP(J),PP(I),ET(I) 
 
 FORMAT ("<15X12>",F5.0,5X,F5.0,5X,F7.0) 
 
 CONTINUE 
 
 URITE (20,100) EX 
 FORMAT ("< 15X 12>", "EX - ", 
 
 ", 12,3X,"Ell » ",F7.0,2X, 
 
 ",F7.0,2X,"POSITIVE PART"/ 
 ",F7.0,2X,"NEGATIVE PART") 
 
 ",I3,2X,"Ell = ",F7.0,2X, 
 
 ",F7.0,2X,"POSITIVE PART"/ 
 ",F7.0,2X,"NEGATIVE PART") 
 
 F7.0) 
 
 - 43 - 
 
URITE (20,5) 
 
 URITE (20,81) RLI,RKI,RUI 
 
 81 FORMAT ("<15><12>","LI * \F4.0,4X,"KI - ",F4.0,4X,"SUI - ",F4.0) 
 
 URITE (20,5) 
 
 TSCCLF 3 1.8*TSCCL+32. ; CONV TEMP IN DEG F 
 
 URITE (20,93) PCCL,ETCCL,TSCCL,TSCCLF,UAVG 
 93 FORMAT ("<15X12>","CCL = ",F5.0,2X,"ETCCL = fl ,F6.0,2X,"CONV TEMP ® n 
 
 1 ,F5.1, " (",F5.1,"F ) UAVG = ",F5.2," G/KG") 
 
 URITE (20,5) 
 
 IF (DMAX.GT.0.) GO TO 9 
 URITE (20,10) 
 
 10 FORMAT ("<15><12>","DEEPEST POT. UNSTABLE LYR : NONE") 
 
 GO TO 11 
 
 9 URITE (20,12) PBMAX,PTMAX,TULAPSE 
 
 12 FORMAT ("<15><12>","DEEPEST POT. UNSTABLE LYR : ",F5.0," - ",F5.0, 
 
 1 "MB, TULAPSE = ",F5.1," SEE URKTPB") 
 
 11 URITE (20,5) ; ENDING UITH A BLANK LINE 
 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 SUBROUTINE PULYR 
 
 C COMPUTATION OF POTENTIAL (CONVECTIVE) UNSTABLE LAYERS, UITH LAPSE RATE 
 
 C OF UET BULB POTENTIAL TEMPERATURE AND AMOUNT OF LIFT REQUIRED FOR SATURATION 
 
 C0MM0N/S/JST(5),KDATE(3),IHOUR,JNO,JJNO,P(0:50),TS(0:50),TSD(0:50) 
 COMMON/G/PP(0:20),ET(20),TU(0:50),DP,EFF,KMOD,KK 
 COMMON/GG/NJ,PPB(15),PPT(15),DELPP(15),DTUDP(15),DPB(15),DPT(15), 
 
 1 PTMAX,PBMAX,TULAPSE,DMAX 
 DMAX=0 
 NJ=0 
 IT®-1 
 MK=0 
 
 JNNO=JNO-1 
 DO 1 I=0,JNNO 
 
 IF ((TU(I)-TU(I+1)).LE.0.) GO TO 2 ; GOES TO 2, IF STABLE 
 
 GO TO 4 
 
 2 IF (MK.EQ.0) GO TO 1 ; MK=0 INITIALLY, OR IF PREVIOUS LYR STABLE 
 
 GO TO 3 ; GOES TO 3, UHEN TOP OF UNSTABLE LYRS IS REACHED 
 
 C DETERMINING INDICES OF UNSTABLE LYR, IT = TOP, IB = BOTTOM 
 
 4 IF (I.GT.IT) IB = I 
 IT®1+1 
 
 MK = 1 
 GO TO 1 
 
 3 NJ=NJ+1 
 
 PPT(NJ)=P(IT) 
 
 PPB(NJ)=P(IB) 
 
 DELPP(NJ)=P(IB)-P(IT) 
 
 DTUDP(NJ)=(TU(IB)-TU(IT))/DELPP(NJ)*100. 
 
 IF(DELPP(NJ).LE.DMAX) GO TO 5 
 DMAX=DELPP(NJ) 
 
 TULAPSE=DTUDP(NJ) 
 
 PTMAX=PPT(NJ) 
 
 PBMAX=PPB(NJ) 
 
 5 TC=TCONOF (TS(IB),TSD(IB)) ; CONDENSATION TEMPERATURE 
 
 PC=P(IB)*((TC+273.16)/(TS(IB)+273.16))**(1./.2857142) ; COND PRESSURE 
 DPB(NJ)=P(IB)-PC ; AMT OF LIFT REQUIRED FOR BOTTOM SATURATION 
 TC=TCONOF (TS(IT),TSD(IT)) 
 
 PC=P(IT)*( (TC+273. 16)/(TS( IT)+273.16) )**( 12857142) 
 
 - 44 - 
 
n n 
 
 AMT OF LIFT REQUIRED FOR TOP SATURATION 
 
 DPT(NJ)*PCIT)-PC ; 
 
 MK=0 
 
 1 CONTINUE 
 
 RETURN 
 END 
 
 # 
 
 * 
 
 OVERLAY OV0 
 PARAMETER MRAOB-50 
 
 'NRAOB' MUST AGREE UITH SAME PARAMETER IN RANP AND GPT!!! 
 
 THIS SUBROUTINE FINDS X AND Y COORDINATES FOR PLOTTING ON MAP 
 C BACKGROUND 2 BY SEARCHING STATION DIRECTORY FILE. 
 
 C THREE LETTER STATION IDENTIFIER (PACKED) MUST BE SUPPLIED IN ARRAY '1ST'. 
 SUBROUTINE STLOC (N,IXX,IYY,1ST) 
 
 DIMENSION IXX(NRAOB),IYY(NRAOB),IST(NRAOB,2),JST(3),IB(3),IAD(2), 
 
 1 IC1(14), IC2C14), IC3C14) 
 
 IFLDP=1 
 IFLD=6 
 I AD(1)=0 
 IAD(2)=0 
 
 JST(3)=20040K ; DOUBLE SPACE 
 
 CALL GCHN (ICHN,IER) 
 
 CALL OPENR (ICHN,"STDIR.MS",0.IER) 
 
 IF (IER.NE.l) TYPE "ERROR IN OPENING 'STDIR.MS' - STLOC, IER = ",IER 
 CALL RDS (ICHN, IB,6, IER) ; READ FIRST 3 UORDS FROM FILE 
 
 IF (IER.NE.l) TYPE "READ ERROR IN 'STDIR.MS' - STLOC, IER = ",IER 
 DO 4 I-1,N 
 JST(1)=IST(I,1) 
 
 JST(2)=IST(I,2) ; STN IDENTIFIER, USED TO SEARCH 'STDIR.MS' 
 
 CALL BNSCH(ICHN, IB(1), IB(2),IB(3),IFLDP,IFLD,JST,IAD,IC1,IC2,IC3,IC) 
 IF (IC.EQ.0) GO TO 5 
 GO TO (1,2,3), IC 
 
 1 IXX(I)=2*IC1(8) 
 
 IYY(I)=2*IC1(9) 
 
 GO TO 4 
 
 2 IXX(I)=2*IC2(8) 
 
 IYY( I) =2>«IC2(9) 
 
 GO TO 4 
 
 3 IXX(I)=2*IC3(8) 
 
 IYY(I)=2*IC3(9) 
 
 GO TO 4 
 
 5 IXX(I)=0 
 
 IYY(I)=0 ; X 8. Y COORDINATES ZERO, IF STATION NOT FOUND 
 
 URITE (10,6) (JST(J),J-1,3) 
 
 6 FORMAT (1H ,3A2,"N0T FOUND IN 'STDIR.MS' FILE") 
 
 4 CONTINUE 
 
 CALL KLOSE (ICHN,IER) 
 
 IF (IER.NE.l) TYPE "CHANNEL NOT CLOSED - STLOC, IER = MER 
 
 RETURN 
 
 END 
 
 * 
 
 >k 
 
 OVERLAY OV1 
 PARAMETER NRAOB=50 
 
 C PARAMETER -NRAOB- MUST AGREE UITH SIMILAR PARAMETER IN RANP 
 SUBROUTINE GPT(N,IXX,IYY,JB,JEL,1ST,IHOUR,KDATE,JEFF) 
 
 - 45 - 
 
1 
 
 2 
 
 1 
 
 CONVERT 
 PLOTTING 
 5,IVOF) 
 
 B1 TO ASCII 
 
 C THIS VERSION FOR USE ON MAP BACKGROUND 2 
 C THIS SUBROUTINE PLOTS A GRAPHIC (EL/BI) 
 
 C INSERTS ENTRAINMENT RATE INTO HEADING OF GRAPHIC 
 
 DIMENSION IXXCNRAOB), IVY(NRAOB),JB(NRAOB),JEL(NRAOB),IST(NRA0B,2) 
 ,KDATE(3) 
 
 DIMENSION ISC(5),JS(3),ITC15) 
 
 COMMON/TITLE/JT(12) 
 
 DATA JT/ n EL/EIl EFF ; FIRST LINE OF TITLE 
 
 MAP =2 
 
 DO 10 1=1,N 
 IX=IXXCI) 
 
 IY-IYYCI) 
 
 JDAT=JB( I) 
 
 IF (JDAT.EQ.999) GO TO 1 
 CALL ISCRCISC,JDAT,-1) ; 
 
 IYOF = 12 ; Y OFFSET FOR 
 
 CALL TEXT CISC,IX,IY,1,2, 
 
 JDAT=JEL(I) 
 
 CALL ISCRCISC,JDAT,+1) ; CONVERT 
 
 CALL TEXT (ISC, IX, IY, 1,2,-40,IYOF) ; 
 
 ISC(2)=14 ; STATION SYMBOL, CLEAR 
 
 GO TO 2 
 ISC(2)=5 
 ISCC1)=22K 
 ISC(3)=2 IK 
 ISC(4)=0 
 ISC(5)=0 
 
 IF (JB(I).GT.0.AND.JBCI).NE.999) 
 
 CALL TEXT (ISC,IX,IY,1,1,0,0) 
 
 JSC1)-ISTCI,1) 
 
 JS(2)=ISTC1,2) 
 
 JS(3)=0 
 
 CALL TEXT (JS, IX,IY,1,1,-7,-10) 
 
 10 CONTINUE 
 
 CALL MTITL(IHOUR,KDATE, IT) 
 
 C PRINT TITLE IN LOWER RIGHT CORNER OF 
 
 ELI 
 
 PLOT B1 
 
 TO ASCII 
 PLOT ELI 
 
 MISSING DATA 
 
 START SPECIAL SYMBOLS 
 
 END SPECIAL SYMBOLS 
 
 ISC(2)=3 ; STATION SYMBOL, OVERCAST 
 
 PLOT STATION SYMBOL 
 
 PLOT STATION ID 
 
 MAKE DATE/TIME 
 GRAPHIC 
 
 GRP TITLE 
 
 CALL ISCRC ISC,JEFF,-1) ; 
 
 DO 3 1=3, 12 
 JTCI)=ISC(1-7) 
 
 CALL TEXT (JT,2600,550,3,1,0,0) 
 CALL TEXT (IT,2600,450,3,1,0,0) ; 
 CALL UTF("NMCGPHEIS","HMSGPH.01") 
 RETURN 
 END 
 
 * 
 
 CONVERT ENTRAINMENT RATE TO ASCII 
 
 ; FIRST LINE OF TITLE 
 DATE/TIME LINE OF TITLE 
 
 * 
 
 SUBROUTINE ISCR CISC,JDAT,KSHIFT) 
 
 C CONVERTS JDAT TO ASCII 
 
 C SET KSHIFT = -1 FOR SHIFT LEFT, +1 FOR SHIFT RIGHT 
 DIMENSION ISC(5) 
 
 ISC C1)=32 ; SPACE 
 
 IF CJDAT.LT.0) ISCC1)=45 ; NEGATIVE SIGN 
 
 JDAT=IABS(JDAT) ; USE ABSOLUTE VALUE OF JDAT 
 IF CJDAT.LT.1000) GO TO 2 ; NORMAL 
 
 JDAT=888 ; 388 DENOTES: NUMBER TOO LARGE 
 
 2 ISC(2)=JDAT/100 ; HUNDREDS DIGIT 
 
 IS=JDAT-ISC(2)*100 
 ISC(3)=IS/10 ; TENS DIGIT 
 
 - 46 - 
 
O CD 
 
 ISC C4)* IS-10*ISC(3) 
 
 IF (ISC(2) .NE.0) GO TO 3 
 IF CISCC3).NE.0) GO TO 6 
 IF (KSHIFT.EQ.1) GO TO 1 
 
 C CONVERT 1 DIGIT NUMBER TO ASCII AND SHIFT LEFT 
 ISC (2) * ISC (4) +48 
 ISC(3)=32 ; SPACE 
 
 ISC(4)=32 ; SPACE 
 
 GO TO 5 
 
 C CONVERT 1 DIGIT NUMBER TO ASCII AND SHIFT RIGHT 
 1 ISC(4)=ISC C4)+48 
 
 ISC(3)=ISC(1) ; SHIFT SIGN 
 
 ISC(1)=32 ; SPACE 
 
 ISC(2)=32 ; SPACE 
 
 GO TO 5 
 
 IF (KSHIFT.EQ.1) GO TO 7 
 CONVERT 2 DIGIT NUMBER TO ASCII AND SHIFT LEFT 
 ISC (2) =ISC(3)+48 
 ISC (3) = ISC (4) +48 
 ISC(4)=32 ; SPACE 
 
 GO TO 5 
 
 C CONVERT 2 DIGIT NUMBER TO ASCII AND SHIFT RIGHT 
 7 ISC(4)=ISC(4)+48 
 
 ISC(3)=ISC(3)+48 
 ISC(2)= ISC(1) 
 
 ISC C1)=32 
 GO TO 5 
 
 C CONVERT 3 DIGIT NUMBER TO ASCII 
 3 ISC (2) = ISC (2) +48 
 
 ISC (3) = ISC (3) +48 
 ISC(4)=ISC(4)+48 
 5 CONTINUE 
 
 ISC(5)=0 ; 
 
 RETURN 
 END 
 
 * 
 
 UNITS DIGIT 
 
 ; FINISHED, 3 DIGIT NUMBER IS PLOTTED 
 ; 2 DIGIT NUMBER IS PLOTTED 
 
 SHIFT SIGN 
 SPACE 
 
 SET TO ZERO FOR TEXT SUBROUTINE 
 
 SUBROUTINE JSCR 
 C CONVERTS POSITIVE 2 
 
 C IF NEGATIVE INTEGER 
 
 C THIS SUBROUTINE FOR 
 
 DIMENSION KS(2) 
 
 IF (KN.GE.0) GO TO 1 
 KS Cl)=57 ; 9 
 
 KS(2)=57 ; 9 
 
 URITE (10,2) KN 
 2 FORMAT (1H 
 
 1 MISTAKE IN 
 
 RETURN 
 
 1 CONTINUE 
 
 KS1=KN/10 
 KS(1)=KS1+48 
 KS(2)=KN-10*KS1+48 
 IF (KS(1).EQ.48) KS(1) 
 RETURN 
 END 
 
 * 
 
 (KN,KS) 
 
 DIGIT INTEGER TO ASCII 
 IS ENTERED, 99 IS RETURNED 
 
 GETTING ASCII DATE/TIME NUMBERS FOR PLOTTING 
 
 NORMAL 
 
 ,"NEGATIVE NUMBER, KN = ", 14," 
 DATE/TIME GROUP OF GRAPHIC") 
 
 IN SUBROUTINE JSCR. 
 
 >32 
 
 TENS DIGIT 
 
 TENS DIGIT CONVERTED TO ASCII 
 UNITS DIGIT CONVERTED TO ASCII 
 ; SUBSTITUTE SPACE FOR ASCII 
 
 ZERO 
 
 * 
 
 - 47 - 
 
c 
 
 c 
 
 13 
 
 c 
 
 c 
 
 c 
 
 c 
 
 c 
 
 1 
 
 2 
 
 3 
 
 4 
 
 5 
 
 6 
 
 7 
 
 8 
 
 * 
 
 SUBROUTINE MTITL (IHOUR,KDATE,IT) 
 
 THIS SUBROUTINE RETURNS DATE/TIME GROUP "IT" FOR GRAPHIC TITLE 
 DIMENSION KDATEC3),IT(15),KS(2) 
 
 GET ASCII TIME 
 
 ITC1)=48 ; 0 
 
 IT(2)=48 ; 0 
 
 IF (IHOUR.EQ.0) GO TO 13 
 ITU)-49 ; 1 
 
 1T(2)=50 ; 2 
 
 ITC3)=90 ; Z 
 
 IT(4)«32 ; SPACE 
 
 IT(5)-32 ; SPACE 
 
 GET ASCII DATE 
 
 CALL JSCR CKDATEC2),KS) 
 
 IT(6)=KS(1) 
 
 IT(7)=KS(2) 
 
 ITC8)=32 ; SPACE 
 
 IT(12)=32 ; SPACE 
 
 GET ASCII YEAR 
 
 CALL JSCR (KDATEC3),KS) 
 
 IT(13)-KS(1) 
 
 ITC14)=KS(2) 
 
 ITC15)=0 ; MUST BE ZERO FOR TEXT SUBROUTINE 
 
 GET 3 LETTER MONTH ABBREVIATION 
 
 KGO=KDATE(1) 
 
 GO TO (1,2,3,4,5,6,7,8,9, 10, 11, 12) KGO 
 
 IT(9)=74 
 ITC10)=65 
 ITC11)=78 
 GO TO 14 
 ITC9)=70 
 ITC10)=69 
 ITC11)=66 
 GO TO 14 
 IT(9)=77 
 ITC10)=65 
 ITC11)=82 
 GO TO 14 
 ITC9)=65 
 ITC10)=30 
 ITC11)=82 
 GO TO 14 
 IT(9)=77 
 ITC10)=65 
 ITC11)=89 
 GO TO 14 
 ITC9)=74 
 ITC10)=85 
 ITC11)=78 
 GO TO 14 
 ITC9)=74 
 ITC10)=85 
 ITC11)=76 
 GO TO 14 
 IT(9)=65 
 ITC10)=85 
 
 JAN 
 
 FEB 
 
 MAR 
 
 APR 
 
 MAY 
 
 JUN 
 
 JUL 
 
 AUG 
 
 - 48 - 
 
ITC11W1 
 GO TO 14 
 
 9 IT(9)-83 ; SEP 
 
 IT(10)*69 
 ITC1D-80 
 
 GO TO 14 
 
 10 ITC9W9 ; OCT 
 
 IT(10)*67 
 ITC1D-84 
 
 GO TO 14 
 
 11 ITC9W8 ; NOV 
 
 ITC10)=79 
 
 ITC11)=86 
 GO TO 14 
 
 12 IT(9)=68 ; DEC 
 
 ITC10)=69 
 
 ITC11)=67 
 14 CONTINUE 
 
 RETURN 
 END 
 
 * 
 
 * 
 
 FUNCTION ITCVTCIBGN,N,Q) 
 
 C 
 
 C THIS FUNCTION IS USED UITH SUBROUTINE AFREAD. ASCII 
 C CHARACTERS IN THE CURRENT LINE ARE SCANNED AND INTERPRETED 
 
 C AS INTEGERS. THE SCAN BEGINS UITH CHARACTER IBGN AND N 
 
 C CHARACTERS ARE SCANNED. ABNORMAL RETURN TO STATEMENT -Q-. 
 C THIS IS A MODIFICATION OF FUNCTION INTCVT IN AFREAD.LB 
 C 
 
 COMMON/QARDQ/IOUTUC80) 
 
 INTEGER Q 
 LOGICAL NEG 
 ITCVT=0 
 NEG=.FALSE. 
 
 IEND=IBGN+N-1 
 
 100 IF CIOUTUCIEND).NE.32) GO TO 200 
 IF CIEND.EQ. IBGN) RETURN 
 IEND= IEND-1 ' 
 
 GO TO 100 
 
 200 DO 250 I=IBGN,IEND 
 
 IF CIOUTUCI).NE.32) GO TO 300 
 
 250 CONTINUE 
 
 RETURN 
 
 300 IF CIOUTUCI).EQ.43) GO TO 400 
 
 IF CIOUTUCI).NE.45) GO TO 500 
 
 NEG=.TRUE. 
 
 400 1=1+1 
 
 500 J=I 
 
 DO 600 I=J, IEND 
 
 IF CIOUTUCI).EQ.32) IOUTUCI)=48 
 IF CIOUTUCI).LT.48.OR.IOUTUCI).GT.57) GO TO 800 
 ITCVT=ITCVT*10+1OUTU CI)-48 
 600 CONTINUE 
 
 IF CNEG) ITCVT=-ITCVT 
 RETURN 
 
 800 RETURN Q 
 
 END 
 
 - 49 - 
 
FUNCTION FTCVTCIBGN,N,Q) 
 
 C 
 
 c 
 
 c 
 
 c 
 
 c 
 
 c 
 
 c 
 
 c 
 
 c 
 
 100 
 
 200 
 
 250 
 
 300 
 
 400 
 
 500 
 
 600 
 
 700 
 
 750 
 
 800 
 
 THIS FUNCTION IS USED UITH SUBROUTINE AFREAD. ASCII 
 CHARACTERS IN THE CURRENT LINE ARE SCANNED AND INTERPRETED 
 AS REAL NUMBERS. IF NO DECIMAL POINT IS DETECTED, IT IS ASSUMED 
 TO FOLLOU THE LAST NUMERAL IN THE FIELD. THE SCAN BEGINS 
 UITH CHARACTER IBGN. N CHARACTERS ARE SCANNED. 
 
 ABNORMAL RETURN TO STATEMENT -Q-. 
 
 THIS IS A MODIFICATION OF FUNCTION FLTCVT IN AFREAD.LB 
 
 COMMON/QARDQ/IOUTU(80) 
 INTEGER Q 
 LOGICAL NEG 
 FTCVT=0. 
 
 NEG=.FALSE. 
 
 IEND=IBGN+N-1 
 
 IF (IOUTU(IEND).NE.32) GO TO 200 
 IF (IEND.EQ.IBGN) RETURN 
 IEND = IEND-1 
 GO TO 100 
 
 DO 250 I=IBGN,IEND 
 
 IF (IOUTU(I).NE.32) GO TO 300 
 
 CONTINUE 
 
 RETURN 
 
 IF (IOUTU(I).EQ.43) GO TO 400 
 IF (IOUTU(I).NE.45) GO TO 500 
 NEG=.TRUE. 
 
 1 = 1 + 1 
 
 J = I 
 
 DO 600 I=J,IEND 
 
 IF (IOUTU(I).EQ.32) IOUTU(I)=48 
 
 IF (IOUTU(I).LT.48.0R.IOUTU(I).GT.57) GO TO 700 
 
 FTCVT=FTCVT*10+IOUTU(I)-48 
 
 CONTINUE 
 
 IF (NEG) FTCVT=-FTCVT 
 RETURN 
 
 IF (IOUTU(I).NE.46) GO TO 800 
 
 J=I + 1 
 
 DIV=10. 
 
 DO 750 I=J,IEND 
 
 IF (IOUTU(I).EQ.32) I0UTU(I)=48 
 
 IF (IOUTU(I).LT.48.OR.IOUTU(I).GT.57) GO TO 800 
 
 FTCVT=FTCVT+(IOUTU(I)-48)/DIV 
 
 DIV=DIV*10. 
 
 CONTINUE 
 
 IF (NEG) FTCVT=-FTCVT 
 
 RETURN 
 
 RETURN Q 
 
 END 
 
 >k 
 
 * 
 
 FUNCTION UOBF(T) 
 
 COMPUTE BY DOUBLE ASYMPTOTIC APPROXIMATION 
 CONSIDER SEPARATELY IF .GT. OR .LE. 20 DEG. 
 
CENT. FOR ALL TEMPS...THETU-THETA-UOBF(THETA)-HJOBF (TEMPCON) 
 
 CENT. FOR ALL TEMPS...THETM»THETA-UOBF(THETA)+UOBF(TEMP) 
 
 X-T-20.0 
 IF(X) 10,10,20 
 10 CONTINUE 
 
 CURVE FIG FOR COOL TEMPERATURE RANGE 
 
 POL-1.000+X*(-8.8416605E-3+X*(1.4714143E-4+X*(-9.6719890E-7 
 1 +X*(-3.2607217E-8+X*(-3.8598073E-10))))) 
 
 POL=POL*POL 
 
 UOBF=15. 130/(POL*POL) 
 
 RETURN 
 
 20 CONTINUE 
 
 CURVE FIT FOR UARMER TEMPERATURES 
 
 POL-1.000+X*(3.6182989E-3+X*(-l.3603273E-5+X*(4.9618922E-7 
 
 1 +X*(-6.1059365E-9+X*(3.940155 IE-11+X*(-1.2588129E-13 
 
 2 +X*(1.6688280E-16))))))) 
 
 POL=POL*POL 
 
 UOBF =29.930/(POL*POL) +0.9600*X-14.800 
 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 FUNCTION SATLFT (THM,P) 
 
 COMPUTES TEMPERATURE (DEG C) UHERE THETA MOIST (DEG C) CROSSES P (MB) 
 CONSIDER THE EXPONENTIAL FOR POTENTIAL TEMPERATURE AS ROCP 
 ROCP=0.28571428 
 
 IF(ABS(P-1000.0)-0.0010) 100, 100.200 
 100 SATLFT=THM 
 
 RETURN 
 
 200 PURP®(P/1000.0)**ROCP 
 
 COMPUTE TEMPERATURE OF DRY ADIABATIC LIFT FOR FIRST GUESS 
 TONE® (THM+273. 16) *PURP-273.16 
 CONSIDER PSEUDO-AD IABAT, EU1, THROUGH TONE AT P. 
 
 COMPUTE EONE=EUl-THM 
 
 EONE =UOBF(TONE)-UOBF(THM) 
 
 RATE®1.0 
 GO TO 330 
 300 CONTINUE 
 
 CONTRIBUTION TO ITERATION IS CHANGE IN T 
 CORRESPONDING TO CHANGE IN E 
 
 RATE =(TTUO-TONE)/(ETUO-EONE) 
 
 TONE=TTUO 
 EONE-ETUO 
 330 CONTINUE 
 
 COMPUTE ESTIMATED SATLIFT, TTUO 
 TTUO =TONE-EONE*RATE 
 
 CONSIDER PSEUDO-AD IABAT, EU2, THROUGH TTUO AT P. 
 
 COMPUTE ETU0=EU2-THM 
 
 ETUO =(TTUO+273.16)/PURP-273.16 
 ETUO=ETUO+UOBF(TTUO)-UOBF(ETUO)-THM 
 CORRECTION TO TTUO IS EOR 
 EOR=ETUO*RATE 
 
 IF(ABS(EOR)-0.1000) 400,400,300 
 400 SATLFT=TTUO-EOR 
 
 RETURN 
 END 
 
 * 
 
 - 51 - 
 
* 
 
 FUNCTION TCONOF(TEMP,DEUPT) 
 
 COMPUTES CONDENSATION TEMPERATURE (DEGREES CENT) BY LIFTING 
 S-TEMP-DEUPT 
 
 CONSIDER TEMP AND DEUPT TO BE LIKE UNITS (C OR K) 
 
 T=TEMP 
 
 IF(100.-TEMP) 4,5,5 
 
 4 T-TEMP-273.16 
 
 COMPUTE CURVE FIT IN MOST EFFICIENT MANNER 
 
 5 DLT=S*(1.2185+0.001278*T+S*(-0.002190+11.73E-6*S-5.20E-6*T)) 
 TCONOF=T-DLT 
 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 FUNCTION UMROF(P,TD) 
 
 COMPUTE MIXING RATIO (G/KG)...DEUPOINT (DEGREES C OR K)...PRESSURE (MB) 
 T=TD 
 
 IF (100.-T) 3,4,4 
 
 3 T=T-273.16 
 
 CURVE FIT CORRECTION FOR NON-IDEAL GAS 
 
 4 X=0.0200*(T-12.5+7500.0/P) 
 
 UFU=1.+0.0000045*P+0.00140*X*X 
 
 COMPUTE ACCORDING TO STANDARD FORMULA 
 FUESU=UFU*VAPFU(T) 
 
 UMROF =621.97*(FUESU/(P-FUESU)) 
 
 RETURN 
 
 END 
 
 * 
 
 * 
 
 FUNCTION DPTOF(EU) 
 
 COMPUTE DEUPOINT, DPT, IN DEGREES C GIVEN UATER VAPOR PRESSURE (MB) 
 
 CREATE TOLERANCE TO DEGREE DESIRED 
 TOL=0.00010 
 
 IF (EU-0.21382876E-09) 20,20,30 
 20 DPTOF=-10000. 
 
 RETURN 
 
 30 IF (1013.0-EU) 20,100,100 
 
 CREATE GUESS BY INVERTING TETEN-S FORMULA 
 100 X=AL0G(EU/6.1078) 
 
 BOT =17.269388-X 
 DPTOF=(237.3*X)/B0T 
 BOT=BOT*EU 
 DELTM=0. 
 
 200 EDP=VAPFU(DPTOF) 
 
 CORRECT GUESS BY DERIVATIVE OF TEMPERATURE UITH RESPECT TO VAPOR PRES. 
 CALCULATED FROM INVERSE OF TETEN-S FORMULA 
 DTDE=(DPTOF+237.3)/BOT 
 DELT=DTDE*(EU-EDP) 
 
 DPTOF=DPTOF+DELT 
 
 CHECK THAT ITERATION IS NOT IN AN ENDLESS CYCLE, A RARE SITUATION 
 C IF NEEDED, CHANGE -TOL- AND EXIT 
 DM=DELT-DELTM 
 
 IF(ABS(DM).GE.1.E-7) GO TO 10 ; IF DM VERY SMALL, ITERATION IS ENDLESS 
 TOL=ABS(DELT) 
 
 - 52 - 
 
TYPE "TOLERANCE CTOL) IN DPTOF CHANGED TO ",TOL," (NORMAL TOL - 
 10 DELTM—DELT 
 
 CHECK TO SEE IF ANSUER CLOSE ENOUGH, IF NOT ITERATE OVER CORRECTION 
 IF (ABS(DELT)-TOL) 300,300,200 
 CHANGE SO DEUPOINT IS ALUAYS LESS THAN THE TEMP. 
 
 COMPATIBILITY UITH TOL IS FORCED 
 300 DPTOF-DPTOF-TOL 
 
 RETURN 
 END 
 
 * 
 
 * 
 
 FUNCTION VAPFU(T) 
 
 COMPUTE SATURATION VAPOR PRESSURE OVER UATER, VAPFU, IN MBS. 
 CONSIDER T(TEMPERATURE) IN DEGREES C OR DEGREES K. 
 
 X“T 
 
 IF (100.0-X) 3,4,4 
 3 X“X-273.16 
 
 CURVE FIT FOR RANGE -50 < T < 100 DEGREES C. 
 
 POL = 0.99999683 E-00 + 
 
 1 X *(0.78736169 E-04 + 
 
 2 X *(0.43884187 E-08 + 
 
 3 X *(0.21874425 E-12 + 
 
 4 X *(0.11112018 E-16 + 
 
 POL=POL*POL 
 POL“POL*POL 
 
 VAPFU=6.107800/(POL*POL) 
 
 RETURN 
 
 END 
 
 * 
 
 X *(-0.90826951 
 X *(-0.61117958 
 X *(-0.29883885 
 X *(—0.17892321 
 X *(-0.30994571 
 
 E-02 + 
 
 E-06 + 
 
 E-10 + 
 
 E-14 + 
 
 E-19))))))))) 
 
 * 
 
 SUBROUTINE BNSCH(ICHN,NREC,LREC,ISTAR,IFLDP,IFLD,ITEST, 
 
 1 IAD,IC1,IC2, IC3, IC) 
 
 C BINARY SEARCH ROUTINE: 
 
 C 
 
 C PROGRAMMER - RICH THOMAS SXB,ISL,SDO 11/79 
 C 
 
 C ICHN=CHANNEL UHICH FILE HAS BEEN OPENNED TO 
 C NREC=NUMBER OF RECORDS 
 
 C LREC=LENGTH OF EACH RECORD (BYTES) 
 
 C ISTAR=BYTE OF FIRST RECORD (©“BEGINNING) 
 
 C IFLDP“UORD POINTER TO FIELD IN RECORD 
 C IFLD“LENGTH OF FIELD IN BYTES 
 
 C ITEST=ARRAY CONTAINING TEST FIELD 
 
 C IAD=RETURNED TUO UORD ARRAY CONTAINING ADDRESS ITEST RECORD 
 C SHOULD BEGIN AT- 
 
 C IC“ 1,2,3 IN SECOND UORD INDICATING RECORD UAS FOUND AND 
 
 C IS IN ARRAY IC1,IC2, OR IC3 
 
 C THOSE THREE ARRAYS SHOULD BE DIMENSIONED LREC/2 UORDS 
 DIMENSION ITEST(1),IC1(1),IC2(1),IC3(1),IAD(2) 
 
 DIMENSION IAD 1(2),IAD2(2),IAD3(2) 
 
 DIMENSION D1(2),D2(2) 
 
 INTEGER D1,D2 
 IC=0 
 
 IADl(l)-0 
 
 IAD 1(2)“ISTAR 
 
 CALL SPOSdCHN, IAD1, IER) 
 
 . 00010 )" 
 
 - 53 - 
 
CALL ERROR(IER,'II') 
 
 CALL RDSCICHN,IC1,LREC,IER) 
 
 CALL ERROR(IER,'RDS - IC1') 
 
 D2(1) a 0 
 D2(2) a LREC 
 
 CALL DSUB(D2,D2, IAD1) 
 
 CALL DMPYCDl,NREC,LREC) 
 
 CALL DSUB(IAD2,D1,D2) 
 
 CALL SPOSCICHN,IAD2,IER) 
 
 CALL ERROR(IER,' 12') 
 
 CALL RDS(ICHN,IC2,LREC,IER) 
 
 CALL ERROR(IER.'RDS-IC2') 
 
 CALL BCOMP(IC1CIFLDP),ITEST,IFLD,IER1) 
 IFCIER1.GT.l)GO TO 100 
 CALL BCOMP(IC2CIFLDP),ITEST,IFLD,IER2) 
 IF(IER2.NE.2)GO TO 125 
 5 CALL DSUB CD 1,IAD2, IAD1) 
 
 CALL DDVD(INC,IR,D1,LREC) 
 
 IF(INC.GE.32767)GO TO 900 
 IFCINC.LT.l)GO TO 150 
 INC-CINC-D/2+1 
 CALL DMPYCDl,INC,LREC) 
 
 CALL DADDCIAD3,IAD1,D1) 
 
 CALL SPOSCICHN,IAD3,IER) 
 
 CALL ERRORCIER,'15') 
 
 CALL RDSCICHN,IC3,LREC,IER) 
 
 CALL ERROR(IER,'16') 
 
 CALL BCOMPCIC3CIFLDP),ITEST,IFLD,IER3) 
 IF(IER3.EQ.l)GO TO 50 
 IFCIER3.EQ.2)G0 TO 60 
 IF(IER3.NE.3)GO TO 900 
 IAD(1)=IAD3( 1) 
 
 IAD C 2)=IAD3(2) 
 
 IC=3 
 
 RETURN 
 
 50 IAD1(1)-IAD3(1) 
 
 IAD 1C 2)=IAD3(2) 
 
 GO TO 5 
 
 60 IAD2 C1) = IAD3(1) 
 
 IAD2(2)=IAD3(2) 
 
 IFCINC.EQ.1)GO TO 150 
 GO TO 5 
 
 100 I AD(1)=IAD 1(1) 
 
 I AD(2)=IAD 1(2) 
 
 IF(IER1.NE.3)G0 TO 101 
 IC-1 
 
 IAD(1) = IAD 1(1) 
 
 IAD(2)=IAD1(2) 
 
 101 RETURN 
 
 125 D1(1)=0 
 
 D1(2)=LREC 
 
 CALL DADD(IAD,D1,IAD2) 
 
 IF(IER2.NE.3)GO TO 126 
 IAD(1)=IAD2(1) 
 
 IAD(2)=IAD2(2) 
 
 IC=2 
 
 126 RETURN 
 
 150 IAD(1)=IAD3(1) 
 
 IADC2)-IAD3C2) 
 
 RETURN 
 
 - 54 - 
 
900 CALL ERROR(IER3,'IER3') 
 
 IER-2 
 
 CALL ERROR(IER,'TOO MANY RECORDS IN FILE') 
 
 STOP 
 
 END 
 
 INDEX OF SUBROUTINES 
 
 SUBROUTINE 
 
 PAGE 
 
 BNDX 
 
 33 
 
 BNSCH 
 
 53 
 
 CCLI 
 
 29 
 
 DECOM 
 
 35 
 
 DECOS 
 
 21 
 
 DPTOF 
 
 52 
 
 FTC V 
 
 41 
 
 FTCVT 
 
 50 
 
 GPT 
 
 45 
 
 HEIGHT 
 
 40 
 
 INDX1 
 
 32 
 
 ISCR 
 
 46 
 
 ITCVT 
 
 49 
 
 IVCK 
 
 39 
 
 JREAL 
 
 40 
 
 JSCR 
 
 47 
 
 MODRB 
 
 31 
 
 MTITL 
 
 48 
 
 PULYR 
 
 44 
 
 RANN2 
 
 23 
 
 RANP 
 
 16 
 
 SATLFT 
 
 51 
 
 STLOC 
 
 45 
 
 TCONOF 
 
 52 
 
 TEMPI 
 
 23 
 
 TPA 
 
 42 
 
 TPB 
 
 42 
 
 VAPFW 
 
 53 
 
 WMROF 
 
 52 
 
 WND 
 
 40 
 
 WOBF 
 
 50 
 
 - 55 - 
 

 
 
 
 ' 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
NOAA SCIENTIFIC AND TECHNICAL PUBLICATIONS 
 
 The National Oceanic and Atmospheric Administration was established as part of the Department of 
 Commerce on October 3, 1970. The mission responsibilities of NOAA are to assess the socioeconomic impact 
 of natural and technological changes in the environment and to monitor and predict the state of the solid Earth, 
 the oceans and their living resources, the atmosphere, and the space environment of the Earth. 
 
 The major components of NOAA regularly produce various types of scientific and technical informa¬ 
 tion in the following kinds of publications: 
 
 PROFESSIONAL PAPERS — Important definitive 
 research results, major techniques, and special inves¬ 
 tigations. 
 
 CONTRACT AND GRANT REPORTS — Reports 
 prepared by contractors or grantees under NOAA 
 sponsorship. 
 
 ATLAS — Presentation of analyzed data generally 
 in the form of maps showing distribution of rainfall, 
 chemical and physical conditions of oceans and at¬ 
 mosphere, distribution of fishes and marine mam¬ 
 mals, ionospheric conditions, etc. 
 
 TECHNICAL SERVICE PUBLICATIONS — Re¬ 
 ports containing data, observations, instructions, etc. 
 A partial listing includes data serials; prediction and 
 outlook periodicals; technical manuals, training pa¬ 
 pers, planning reports, and information, serials; and 
 miscellaneous technical publications. 
 
 TECHNICAL REPORTS — Journal quality with 
 extensive details, mathematical developments, or data 
 listings. 
 
 TECHNICAL MEMORANDUMS — Reports of 
 preliminary, partial, or negative research or technol¬ 
 ogy results, interim instructions, and the like. 
 
 Information on availability of NOAA publication* can bo obtainod from: 
 
 ENVIRONMENTAL SCIENCE INFORMATION CENTER (D822) 
 ENVIRONMENTAL DATA AND INFORMATION SERVICE 
 NATIONAL OCEANIC AND ATMOSPHERIC ADMINISTRATION 
 U.S. DEPARTMENT OF COMMERCE 
 
 6009 Executive Boulevard 
 Rockville, MD 20852 
 

 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
EASTERN REGION CP NO. 16 
 
 RANP 
 
 STABILITY ANALYSIS PLOT PROGRAM 
 
 PART B: PROGRAM EXECUTION AND ERROR CONDITION (RANP) 
 
 PROGRAM NAME: RANP 
 
 PROGRAM EXECUTION 
 
 1. To run program for a single station, at ADM type: 
 
 RUN:RANP/S CCCSGLXXX 
 
 2. To check the database prior to running program for raobs in 
 file STNS1, at ADM type: 
 
 RUN:RANP/C 
 
 3. To run program for list of raobs in file STNS1, at ADM type: 
 
 RUN:RANP 
 
 A local switch "/E" is available for changing the entrainment rate 
 from its basic value of 60 percent; it may be added to the end of 
 the RUN line in options 1 and 3 above. However, use of E switch is 
 not recommended. 
 
 ERROR CONDITIONS 
 
 Error condition messages, if any, are output to the dasher or ADM 
 and the alert light is turned on at the ADM. 
 
 B-l 
 

 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
AFOS Products: 
 
 ID 
 
 ACTION 
 
 COMMENTS 
 
 CCCSGLXXX 
 
 Input 
 
 List from file STNS1 or specified 
 in RUN line. 
 
 CCCMANXXX 
 
 Input 
 
 Not necessary, but used, if avail¬ 
 able, to get tropopause and to 
 convert EL units from pressure to 
 feet. 
 
 WRKTPA 
 
 Output 
 
 Complete stability analysis for a 
 single station. 
 
 WRKTPB 
 
 Output 
 
 Listing of significant levels and 
 convectively unstable layers for 
 a single station. 
 
 WRKTPC 
 
 Output 
 
 Tabular listing of energy indices 
 for list specified in file STNS1. 
 
 WRKTPD 
 
 Output 
 
 Listing of missing or unuseable 
 
 SGL raob reports. ("C" switch) 
 
 NMCGPHEIS 
 
 Output 
 
 Graphic with plotted values of 
 
 Ell and EL. 
 
 LOAD LINE: 
 
 RLDR/P RANP DECOS TEMPI RANN2 CCL1 MODRB INDX1 BNDX UOBF SATLFT TCONOF 
 UMROF DPTOF VAPFU DECOM IVCK UND HEIGHT JREAL FTCV 
 CTPB PULYR, TPA, STLOC BNSCH, GPT ISCR JSCR MTITLH 
 OUT AFREAD.LB ITCVT FTCVT TOP.LB AG.LB UTIL.LB FORT.LB 
 
 PROGRAM INSTALLATION: 
 
 1. Add CCCWRKTPA, B, C, & Dto database. 
 
 Add NMCGPHEIS to database and assign map background 2. 
 
 2. RANP.SV, RANP.OL, and STNS1 should be on DP0 or DP0F with 
 link to DP0. 
 
EASTERN REGION CP No. 16 
 
 RANP 
 
 STABILITY ANALYSIS PLOT PROGRAM 
 
 rvfRsrrv 0F illinois-urbana 
 
 3 0112113036062 
 
 PART A: PROGRAM INFORMATION AND INSTALLATION PROCEDURE (RANP) 
 
 PROGRAM NAME: RANP AAL ID: 
 
 REVISION NO. 1.00 
 
 PURPOSE: Uses significant level raob data to compute the 
 
 energy indices Ell and EI2 and equilibrium level 
 EL along with several other thermodynamic parameters. 
 
 PROGRAM INFORMATION: 
 
 NY 
 
 Development Programmer: 
 
 Hugh M. Stone 
 Location: ERH Garden City, 
 
 Phone: (FTS) 649-5443 
 Language: FORTRAN IV 
 Date: 2/84 
 
 Running Time: 
 
 Single station, 40 to 60 seconds 
 
 Maintenance Programmer: 
 Same 
 
 Type: Standard 
 Revision Date: NA 
 
 32 stations. 
 
 Disk Space: 
 
 about 8 minutes 
 
 Program Files 
 
 
 122 
 
 RDOS blocks 
 
 
 Overlay Files 
 
 - 
 
 28 
 
 RDOS blocks 
 
 
 Data Files 
 
 - 
 
 3 
 
 RDOS blocks 
 
 a RAM REQUIREMENTS: 
 
 Program Files: RANP.SV and 
 
 RANP.OL 
 
 
 
 Data Files: 
 
 Name 
 
 DP Location 
 
 R/W 
 
 
 Comments 
 
 STNS1 
 
 DP0 
 
 Read 
 
 
 List of raob stations 
 
 INDEXX 
 
 DP0 
 
 Wri te 
 
 
 (not to exceed 50) 
 Temporary 
 
 INDEXY 
 
 DP0 
 
 Write 
 
 
 Temporary 
 
 HMSGPH.01 
 
 DP0 
 
 Write 
 
 
 Temporary