This archive contains answers to questions sent to Unidata support through mid-2025. Note that the archive is no longer being updated. We provide the archive for reference; many of the answers presented here remain technically correct, even if somewhat outdated. For the most up-to-date information on the use of NSF Unidata software and data services, please consult the Software Documentation first.
Dave, Attached is GEMPAK's pcconv.tbl which is used to convert parameters into other known quantities. The function names represent GEMPAK's library , which is the routine that gets called with the parameters in parentheses. The SAMEPARM operator is useful for relating parameters which may have other names to known parameters. The pcmeth.f routine contains loop for determining the computable parameters (Mary's original development was 1984). Chiz On Tue, 2006-03-21 at 10:02, David Fulker wrote: > Chiz, > > I'm meeting with HAO's Peter Fox on his Virtual Solar-Terrestrial > Observatory (VSTO) project, and I found myself reminded of GEMPAK's > flexibility for adaptively deriving desired quantities from whatever > source quantities happen to be available in any given end-user > context. Can you point me to documentation on how this capacity has > been implemented, ideally including tables or graphs that depict the > associated derivation dependencies? > > With thanks, > Dave >
! This table is used to set up the conversion of meteorological ! parameters from one form to another !! ! Log: ! D. Kidwell/NCEP 5/97 Added log and VSBN ! T. Lee/GSC 8/97 Removed LTMC, LTMF, LTMK ! D. Kidwell/NCEP 10/97 Added TBSY and ICSY ! T. Lee/GSC 11/97 Added THWC ! D. Kidwell/NCEP 4/98 Added GUST and VSBY ! D. Kidwell/NCEP 5/98 Changed DARR, added DAWV ! D. Kidwell/NCEP 12/98 Added WAV2, WAV3, WAV4, WAV5 ! D. Kidwell/NCEP 1/99 Added P01I and P01M ! D. Kidwell/NCEP 2/99 Added WPHM, WVSW and SWEL ! D. Kidwell/NCEP 3/99 Added T00X, T06X, T12N, T18N, DMAX, DMIN ! D. Kidwell/NCEP 3/99 Added DPRC ! S. Jacobs/NCEP 3/99 Added TCHK ! S. Jacobs/NCEP 3/99 Added TPFR, TPAR, TPFC, TPAC ! A. Hardy/GSC 4/99 Added VSBF,PR6X,P00Z,P06Z,P12Z,P18Z,DPRN ! D. Kidwell/NCEP 7/99 Added acft hts - icing, turb, cloud, wx ! A. Hardy/GSC 7/99 Added ITSY, TTSY, TFSY ! J. Green/AWC 7/99 Added XVFR ! A. Hardy/GSC 8/99 Added SMPH ! G. Grosshans/SPC 10/99 Added BRBS (barbs in mph) ! D. Kidwell/NCEP 1/00 Added ACTP ! D. Kidwell/NCEP 3/00 Added IGRO, DIGR ! D. Kidwell/NCEP 10/00 Added CL12 ! D. Kidwell/NCEP 11/00 Added PR24 ! T. Lee/SAIC 9/01 Added WCHT ! K. Brill/HPC 10/01 Added SNRT, FZRT ! A. Hardy/SAIC 11/01 Added VSBC ! D. Kidwell/NCEP 3/02 Added DASH ! D. Kidwell/NCEP 9/02 Added BRGK,TWMO,TWSY,TCLC,TCOL,TCOM,TCOH, ! TCLL,TCLM,TCLH,TCFR,TSKC,TXVF ! K. Brill/HPC 12/02 Added T2MS, Q2MS, STMS, STMD ! D. Kidwell/NCEP 5/03 Added CMSL,MOBS,WSKC,WXVF,WCFR,TPWS,TPWN, ! TPWO,AWSY,AWNM,AWMO,VWSY,VWMO ! T. Lee/SAIC 6/03 Added FOSB ! D. Kidwell/NCEP 8/03 Added TCMS, TMOB, WCMS, WMOB ! S. Chiswell/Unidata 5/04 Added PANY, RANY, SANY ! D. Kidwell/NCEP 10/04 Added TCSL ! D. Kidwell/NCEP 4/05 Added PKWK, BRPK ! ! Temperature, moisture functions ! TMPC = SAMEPARM ( TEMP ) TMPC = SAMEPARM ( T2MS ) DWPC = SAMEPARM ( DWPT ) TEMP = SAMEPARM ( TMPC ) DWPT = SAMEPARM ( DWPC ) THTK = SAMEPARM ( THTA ) STHK = SAMEPARM ( STHA ) MIXR = SAMEPARM ( Q2MS ) TMPF = PR_TMCF ( TEMP ) DWPF = PR_TMCF ( DWPT ) TMPK = PR_TMCK ( TEMP ) DWPK = PR_TMCK ( DWPT ) TEMP = PR_TMKC ( TMPK ) DWPT = PR_TMKC ( DWPK ) TEMP = PR_TMFC ( TMPF ) DWPT = PR_TMFC ( DWPF ) TMPF = PR_TMKF ( TMPK ) DWPF = PR_TMKF ( DWPK ) TMPK = PR_TMFK ( TMPF ) DWPK = PR_TMFK ( DWPF ) DWPT = PR_DWDP ( TEMP, DPDC ) DWPK = PR_DWDP ( TMPK, DPDK ) DWPF = PR_DWDP ( TMPF, DPDF ) DWPT = PR_RHDP ( TEMP, RELH ) TMPK = PR_TMPK ( PRES, THTA ) TEMP = PR_DWPT ( MIXS, PRES ) DWPT = PR_DWPT ( MIXR, PRES ) DPDC = PR_DDEP ( TEMP, DWPT ) DPDK = PR_DDEP ( TMPK, DWPK ) SNRT = PR_QUOT ( SI12, SNIP ) FZRT = PR_QUOT ( FZ12, FZRN ) DPDF = PR_DDEP ( TMPF, DWPF ) MIXR = PR_MIXR ( DWPT, PRES ) MIXS = PR_MIXR ( TEMP, PRES ) SMXR = PR_MIXR ( DWPC, PALT ) SMXS = PR_MIXR ( TEMP, PALT ) RELH = PR_RELH ( TEMP, DWPT ) THTA = PR_THTA ( TEMP, PRES ) THTE = PR_THTE ( PRES, TEMP, DWPT ) THTS = PR_THTE ( PRES, TEMP, TEMP ) STHS = PR_THTE ( PALT, TMPC, TMPC ) TVRK = PR_TVRK ( TEMP, DWPT, PRES ) TVRK = PR_TVRK ( TEMP, DWPT, PALT ) TVRC = PR_TMKC ( TVRK ) TVRF = PR_TMCF ( TVRC ) VAPR = PR_VAPR ( DWPT ) VAPS = PR_VAPR ( TEMP ) THTV = PR_THTA ( TVRC, PRES ) THTV = PR_THTA ( TVRC, PALT ) STHA = PR_THTA ( TMPC, PALT ) STHE = PR_THTE ( PALT, TMPC, DWPC ) TLCL = PR_TLCL ( TEMP, DWPT ) PLCL = PR_PLCL ( TEMP, PRES, TLCL ) LHVP = PR_LHVP ( TEMP ) LTMP = PR_LTMP ( STHA, STHE ) LTMP = PR_LTMP ( THTA, THTE ) THTC = PR_TMKC ( THTA ) STHC = PR_TMKC ( STHA ) HEAT = PR_HEAT ( TMPF, RELH ) HMTR = PR_HMTR ( TMPF, DWPF ) WCEQ = PR_WCEQ ( TMPF, SKNT ) WCHT = PR_WCHT ( TMPF, SKNT ) THWC = PR_THWC ( PRES, TMPC, DWPC ) TMWK = PR_TMWB ( TMPK, MIXR, PRES ) TMWK = PR_TMWB ( TMPK, SMXR, PALT ) TMWC = PR_TMKC ( TMWK ) TMWF = PR_TMKF ( TMWK ) TDXF = PR_TMCF ( TDXC ) TDNF = PR_TMCF ( TDNC ) T6XF = PR_TMCF ( T6XC ) T6NF = PR_TMCF ( T6NC ) TMAX = SAMEPARM ( TDXC ) TMIN = SAMEPARM ( TDNC ) SSTF = PR_TMCF ( SSTC ) T00X = SAMEPARM ( T6XC ) T06X = SAMEPARM ( T6XC ) T12N = SAMEPARM ( T6NC ) T18N = SAMEPARM ( T6NC ) DMAX = PR_DMAX ( T00X, T06X, TDXC ) DMIN = PR_DMIN ( T12N, T18N ) ! ! Wind functions ! DRCT = PR_DRCT ( UWND, VWND ) DRCT = PR_DRCT ( UKNT, VKNT ) SPED = PR_SPED ( UWND, VWND ) SKNT = PR_SPED ( UKNT, VKNT ) STMS = PR_SPED ( USTM, VSTM ) STMD = PR_DRCT ( USTM, VSTM ) UWND = PR_UWND ( SPED, DRCT ) UKNT = PR_UWND ( SKNT, DRCT ) VWND = PR_VWND ( SPED, DRCT ) VKNT = PR_VWND ( SKNT, DRCT ) UWND = PR_KNMS ( UKNT ) UKNT = PR_MSKN ( UWND ) VWND = PR_KNMS ( VKNT ) VKNT = PR_MSKN ( VWND ) SPED = PR_KNMS ( SKNT ) SMPH = PR_KNMH ( SKNT ) SKNT = PR_MHKN ( SMPH ) GUMS = PR_KNMS ( GUST ) GUST = PR_MSKN ( GUMS ) SKNT = PR_MSKN ( SPED ) PKWK = PR_MSKN ( PKWS ) DRCT = PR_PKDD ( PSPD ) DRCT = PR_PKDD ( PKNT ) SPED = PR_PKSS ( PSPD ) SKNT = PR_PKSS ( PKNT ) PSPD = PR_PSPD ( DRCT, SPED ) PKNT = PR_PSPD ( DRCT, SKNT ) WCMP = PR_WCMP ( DRCT, SPED ) WNML = PR_WNML ( DRCT, SPED ) BARB = SAMEPARM ( BRBM ) BRBM = PR_WIND ( DRCT, SPED ) BRBK = PR_WIND ( DRCT, SKNT ) BRBS = PR_WIND ( DRCT, SMPH ) BRGK = PR_WIND ( DRCT, GUST ) BRPK = PR_WIND ( PKWD, PKWK ) ARRW = SAMEPARM ( ARRM ) ARRM = PR_WIND ( DRCT, SPED ) ARRK = PR_WIND ( DRCT, SKNT ) DARR = SAMEPARM ( DRCT ) ! ! Weather codes ! WWMO = PR_NSYM ( WNUM ) WTHR = PT_WCOD ( WNUM ) WCOD = PT_WCOD ( WNUM ) WTMO = PT_WTMO ( WWMO ) WTHR = PT_WTMO ( WWMO ) TWMO = PR_NSYM ( TWNM ) TPWN = PR_TPWN ( TWNM, VWNM, PPRB ) TPWO = PR_NSYM ( TPWN ) AWNM = PR_AWNM ( WNUM, TWNM, VWNM, PPRB ) AWMO = PR_NSYM ( AWNM ) VWMO = PR_NSYM ( VWNM ) WSYM = SAMEPARM ( WWMO ) PWTH = SAMEPARM ( PWWM ) TWSY = SAMEPARM ( TWMO ) TPWS = SAMEPARM ( TPWO ) AWSY = SAMEPARM ( AWMO ) VWSY = SAMEPARM ( VWMO ) ! ! Pressure and altimeter functions ! PRES = PR_PRES ( TEMP, THTA ) ALTM = PR_ALTM ( ALTI ) ALTI = PR_ALTI ( ALTM ) PALT = PR_PALT ( ALTM ) PMSL = PR_PMSL ( PRES, TMPC, DWPC ) RSLT = PR_AMSL ( ALTM ) RMSL = PR_AMSL ( PMSL ) RSLI = PR_SALI ( ALTI ) SALT = PT_SALT ( RSLT ) SMSL = PT_SALT ( RMSL ) SALI = PT_SALT ( RSLI ) ZMSL = PR_ZMSL ( ALTM, PMSL ) Z000 = PR_Z000 ( ALTM ) Z950 = PR_Z950 ( ALTM ) Z900 = PR_Z900 ( ALTM ) Z850 = PR_Z850 ( ALTM ) Z800 = PR_Z800 ( ALTM ) ALTI = PR_ALTP ( PRES ) PTND = SAMEPARM ( P03D ) PTSY = PR_PTSY ( P03D ) P03C = PR_P03C ( P03D ) PT03 = SAMEPARM ( P03C ) PANY = PR_PANY ( ALTM, PMSL ) RANY = PR_AMSL ( PANY ) SANY = PT_SALT ( RANY ) ! ! Height and distance functions ! HGHT = PR_HGKM ( HGTK ) HGTM = SAMEPARM ( HGHT ) HGTK = PR_HGMK ( HGHT ) HGTD = PR_HGMD ( HGHT ) HGHT = PR_HGFM ( HGFT ) HGFT = PR_HGMF ( HGHT ) HGFH = PR_D100 ( HGFT ) HGFT = PR_M100 ( HGFH ) HGFK = PR_HGMK ( HGFT ) HGFT = PR_HGKM ( HGFK ) HGML = PR_HGFS ( HGFT ) HGFT = PR_HGSF ( HGML ) VSBK = PR_HGKS ( VSBY ) RSTZ = PR_STDZ ( PRES, HGHT ) STDZ = PT_SALT ( RSTZ ) VSBN = PR_VSKN ( VSBK ) VSBY = PR_HGSK ( VSBK ) VSBF = PT_VSBF ( VSBY ) VSBC = PT_VSBC ( VSBY ) HBOT = PR_HGFM ( TBSE ) TBSE = PR_HGMF ( HBOT ) HTOT = PR_HGFM ( TTOP ) TTOP = PR_HGMF ( HTOT ) HBOI = PR_HGFM ( IBSE ) IBSE = PR_HGMF ( HBOI ) HTOI = PR_HGFM ( ITOP ) ITOP = PR_HGMF ( HTOI ) CB1M = PR_HGFM ( CBS1 ) CBS1 = PR_HGMF ( CB1M ) CT1M = PR_HGFM ( CTP1 ) CTP1 = PR_HGMF ( CT1M ) CB2M = PR_HGFM ( CBS2 ) CBS2 = PR_HGMF ( CB2M ) CT2M = PR_HGFM ( CTP2 ) CTP2 = PR_HGMF ( CT2M ) HBWX = PR_HGFM ( WBSE ) WBSE = PR_HGMF ( HBWX ) HTWX = PR_HGFM ( WTOP ) WTOP = PR_HGMF ( HTWX ) ! ! Cloud functions ! ! CLCT = PR_CTCC ( CHC1, CHC2, CHC3 ) CLCT = PR_CLCT ( CLCL, CLCM, CLCH ) TCLC = PR_CLCT ( TCLL, TCLM, TCLH ) LCLO = PR_CLOA ( CLCL ) MCLO = PR_CLOA ( CLCM ) HCLO = PR_CLOA ( CLCH ) TCLO = PR_CLOA ( CLCT ) LCLD = PT_CLDN ( CLCL ) MCLD = PT_CLDN ( CLCM ) HCLD = PT_CLDN ( CLCH ) TCLD = PT_CLDN ( CLCT ) CMBC = PR_CMBC ( CLCL, CLCM, CLCH ) CLDS = PT_CLDS ( CMBC ) COML = PR_COMX ( CLHL, CLCL ) COMM = PR_COMX ( CLHM, CLCM ) COMH = PR_COMX ( CLHH, CLCH ) COMT = PR_COMT ( COML, COMM, COMH ) CLDL = PT_CMCL ( COML ) CLDM = PT_CMCL ( COMM ) CLDH = PT_CMCL ( COMH ) CLDT = PT_CMCL ( COMT ) CHD1 = PT_CMCL ( CHC1 ) CHD2 = PT_CMCL ( CHC2 ) CHD3 = PT_CMCL ( CHC3 ) COML = PR_COML ( CHC1, CHC2, CHC3 ) COMM = PR_COMM ( CHC1, CHC2, CHC3 ) COMH = PR_COMH ( CHC1, CHC2, CHC3 ) TCOL = PR_COML ( TCH1, TCH2, TCH3 ) TCOM = PR_COMM ( TCH1, TCH2, TCH3 ) TCOH = PR_COMH ( TCH1, TCH2, TCH3 ) CLCL = PR_CLCX ( COML ) CLCM = PR_CLCX ( COMM ) CLCH = PR_CLCX ( COMH ) TCLL = PR_CLCX ( TCOL ) TCLM = PR_CLCX ( TCOM ) TCLH = PR_CLCX ( TCOH ) CLHL = PR_CLHX ( COML ) CLHM = PR_CLHX ( COMM ) CLHH = PR_CLHX ( COMH ) CLCT = PR_CFCT ( CFRT ) CFRT = PR_CTCF ( CLCT ) TCFR = PR_CTCF ( TCLC ) TCLO = PR_WCCV ( CFRT ) CLCL = PR_CFCT ( CFRL ) CFRL = PR_CTCF ( CLCL ) LCLO = PR_WCCV ( CFRL ) TCLO = PR_WCCV ( CFRT ) CFRT = PR_CTCF ( CL12 ) SKYC = SAMEPARM ( CFRT ) SKYK = PR_SKYX ( CFRT, DRCT, SKNT ) SKYM = PR_SKYX ( CFRT, DRCT, SPED ) TSKC = SAMEPARM ( TCFR ) CSYL = PR_CSYL ( CTYL ) CSYM = PR_CSYM ( CTYM ) CSYH = PR_CSYH ( CTYH ) CSYT = PR_CSYT ( CTYL, CTYM, CTYH ) XVFR = PR_XVFR ( CEIL, VSBY ) TXVF = PR_XVFR ( TCEL, TVSB ) CMSL = PR_CMSL ( CEIL ) MOBS = PR_MOBS ( CMSL, MOTV ) TCMS = PR_CMSL ( TCEL ) TMOB = PR_MOBS ( TCMS, MOTV ) WCMS = PR_WCMS ( CMSL, TCMS ) WMOB = PR_MOBS ( WCMS, MOTV ) WCFR = PR_WCFR ( XVFR, TXVF, CFRT, TCFR ) WXVF = PR_WXVF ( XVFR, TXVF ) WSKC = SAMEPARM ( WCFR ) TCSL = PR_CSYL ( TCTL ) ! ! Location functions ! LATI = PR_LATI ( RANG, AZIM ) LONI = PR_LONI ( RANG, AZIM ) ! ! Miscellaneous functions ! DDEN = PR_DDEN ( PRES, TMPC) DDEN = PR_DDEN ( PALT, TMPC) P01I = PR_MMIN ( P01M ) P03I = PR_MMIN ( P03M ) P06I = PR_MMIN ( P06M ) P09I = PR_MMIN ( P09M ) P12I = PR_MMIN ( P12M ) P18I = PR_MMIN ( P18M ) P24I = PR_MMIN ( P24M ) DPRC = PT_DPRC ( DPRN ) DPRN = PR_DPRN ( P24I, PR6X ) P01M = PR_INMM ( P01I ) P03M = PR_INMM ( P03I ) P06M = PR_INMM ( P06I ) P09M = PR_INMM ( P09I ) P12M = PR_INMM ( P12I ) P18M = PR_INMM ( P18I ) P24M = PR_INMM ( P24I ) P00Z = SAMEPARM ( P06I ) P06Z = SAMEPARM ( P06I ) P12Z = SAMEPARM ( P06I ) P18Z = SAMEPARM ( P06I ) PR6X = PR_PR6X ( P00Z, P06Z, P12Z, P18Z ) PR24 = PR_PR24 ( P00Z, P06Z, P12Z, P18Z ) WHFT = PR_HGMF ( WHGT ) TBSY = SAMEPARM ( TURB ) ICSY = SAMEPARM ( ICNG ) ITSY = PT_TICE ( TPOI ) TTSY = PT_TURB ( TPOT ) TFSY = PT_FQOT ( FQOT ) DAWV = SAMEPARM ( DOSW ) WAV2 = PR_WAV2 ( POWW, HOWW ) WAV3 = PR_WVDD ( DOSW, DOS2 ) WAV4 = PR_WAV4 ( POSW, HOSW ) WAV5 = PR_WAV5 ( POS2, HOS2 ) WPHM = PR_WPHM ( WPER, WHGT, POWW, HOWW ) WVSW = PR_WVSW ( DOSW, POSW, HOSW ) SWEL = PT_SWEL ( WVSW ) IGRO = PR_IGRO ( TMPC, SSTC, SPED ) DIGR = PT_DIGR ( IGRO ) DASH = SAMEPARM ( SHPD ) ACTP = PT_ACTP ( ATP1 ) FOSB = PR_FOSB ( TMPC, RELH, SPED ) ! TCHK = PR_DDEP ( TNTE, TDYE ) TPFR = PR_TPFR ( TNTE, TDYE, PP2E ) TPAR = PR_TPFR ( TNAE, TDAE, P2AE ) TPFR = PR_TPFR ( TNTF, TDYF, PP24 ) TPAR = PR_TPFR ( TNAF, TDAF, PP2A ) TPFC = PT_TPFC ( TPFR ) TPAC = PT_TPFC ( TPAR )
SUBROUTINE PC_METH ( index, ninpm, prmin, noutpm, prmout, + cmpflg, np, iret ) C************************************************************************ C* PC_METH * C* * C* This subroutine decides how a set of output parameters can be * C* computed from a set of input parameters. Internal tables store * C* the information needed to perform the computations. * C* * C* PC_METH ( INDEX, NINPM, PRMIN, NOUTPM, PRMOUT, CMPFLG, NP, IRET ) * C* * C* Input parameters: * C* INDEX INTEGER Table index * C* 1 = basic level parms * C* 2 = intermed. level parms * C* 3 = final level parms * C* 4 = vertical coordinate parms * C* 5 = basic stability parms * C* 6 = intermed. stability parms * C* 7 = final stability parms * C* NINPM INTEGER Number of input parameters * C* PRMIN (NINPM) CHAR*4 Input parameters * C* NOUTPM INTEGER Number of output parameters * C* PRMOUT (NOUTPM) CHAR*4 Output parameters * C* * C* Output parameters: * C* CMPFLG (NOUTPM) LOGICAL Computable parameter flag * C* NP INTEGER Number of computable parms * C* IRET INTEGER Return code * C* 0 = normal return * C* -1 = invalid # of in parms * C* -5 = invalid # of out parms * C* -30 = invalid index * C** * C* Log: * C* M. desJardins/GSFC 8/84 * C* M. desJardins/GSFC 11/87 Changed character conversion method * C* M. desJardins/GSFC 8/88 Cleaned up * C* G. Huffman/USRA 10/89 Documentation * C* S. Jacobs/EAI 3/93 Changed call to TB_PCNV * C* D. Keiser/GSC 12/95 Changed PCVTBL to 'pcconv.tbl' * C* M. Linda/GSC 10/97 Corrected the prologue format * C* J. Wu/GSC 7/00 Added checks for kans(j, index) before * C* proceeding to fnctbl * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'GMBDTA.CMN' INCLUDE 'pccmn.cmn' C* CHARACTER*(*) prmin (*), prmout (*) LOGICAL cmpflg (*) C C* These variables are used temporarily in generating tables. C* They are referred to as the computable function table. C* They represent function names, corresponding parameter names, C* and pointers to the arguments of the functions. C CHARACTER*8 fnctbl (MAXFNC) CHARACTER*4 prmtbl ( MAXFNC ) INTEGER jposno ( MAXPPF, MAXFNC ) C* LOGICAL ok, more INTEGER list ( MAXTMP ) C* CHARACTER*4 tmdw1 (4), tmdw2 (4) DATA tmdw1 / 'TEMP', 'TMPC', 'DWPT', 'DWPC' / DATA tmdw2 / 'TMPC', 'TEMP', 'DWPC', 'DWPT' / C------------------------------------------------------------------------- C Check for input errors C IF ( (ninpm .le. 0) .or. (ninpm .gt. MAXPRM) ) THEN iret = -1 ELSE IF ( (noutpm .le. 0) .or. (noutpm .gt. MAXPRM) ) THEN iret = -5 ELSE IF ( (index .lt. 1) .or. (index .gt. MAXTBL) ) THEN iret = -30 ELSE iret = 0 END IF IF ( iret .lt. 0 ) RETURN C C* Initialize permanent and temporary tables. C kinpm (index) = ninpm koutpm (index) = noutpm kfunc (index) = 0 DO i = 1, MAXFNC kfuncn ( i, index ) = ' ' fnctbl ( i ) = ' ' prmtbl ( i ) = ' ' koutfn ( i, index ) = 0 DO j = 1, MAXPPF kposno ( j, i, index ) = 0 jposno ( j, i ) = 0 END DO END DO C DO i = 1, MAXPRM kans (i, index) = 0 END DO C C* Initialize output flag array C DO i = 1, noutpm cmpflg (i) = .false. END DO C C* Initialize computable parameter variables with input parameters C* (no function name needed). C DO i = 1, ninpm prmtbl (i) = prmin (i) fnctbl (i) = ' ' END DO ntable = ninpm C C* If TEMP, TMPC, DWPT or DWPC are in dataset, add corresponding C* parameter to the computable list. The argument of SAMEPARM is C* the parameter actually in the data set (with index IPOS). C DO i = 1, 4 CALL ST_FIND ( tmdw1 (i), prmtbl, ninpm, ipos, ier ) IF ( ipos .ne. 0 ) THEN ntable = ntable + 1 prmtbl ( ntable ) = tmdw2 (i) fnctbl ( ntable ) = 'SAMEPARM' jposno ( 1, ntable ) = ipos END IF END DO C C* Set local variables: ntable = #of comp. parms, C* ntbold = #of comp. parms on the last pass; C* nfound = #of parms found C ntbold = 0 nfound = 0 C C* This loop searches for the requested parameters in the C* computable parameter table until all parameters are found or C* no more computable parameters are being added to the table. C more = .true. DO WHILE ( ( nfound .lt. noutpm ) .and. + ( ntbold .lt. ntable ) .and. ( more ) ) C num = ntable - ntbold i = 1 C C* Check each output parameter against new parms in C* computable table. C DO WHILE ( ( nfound .lt. noutpm ) .and. ( i .le. noutpm ) ) C IF ( .not. cmpflg (i) ) THEN CALL ST_FIND ( prmout(i), prmtbl(ntbold+1), num, + ipos, ier ) IF ( ipos .gt. 0 ) THEN cmpflg (i) = .true. kans ( i, index ) = ntbold + ipos nfound = nfound + 1 END IF END IF i = i + 1 END DO C C* Read in the function table if all parameters are not found, C* and it has not been read in previously. C IF ( ( nfound .lt. noutpm ) .and. (.not. tablrd ) ) THEN CALL TB_PCNV ( 'pcconv.tbl', MAXFNC, jtfunc, tparms, + tfuncs, tplist, ier ) tablrd = .true. END IF C C* Check to see if any of the parameters not already found C* can now be computed. C ntbold = ntable IF ( nfound .lt. noutpm ) THEN i = 1 more = .false. DO WHILE ( (nfound .lt. noutpm) .and. (i .le. noutpm) ) IF ( .not. cmpflg (i) ) THEN ipos = 1 DO WHILE ((ipos .ne. 0).and.(ipos .le. jtfunc)) jnum = jtfunc - ipos + 1 kpos = ipos CALL ST_FIND ( prmout (i), tparms (kpos), + jnum, ipos, ier ) C C* Parameter found inn function table; test C* whether all arguments are computable C* (storing pointers along the way). C IF ( ipos .ne. 0 ) THEN ipos = ipos + kpos - 1 ok = .true. ii = 1 DO WHILE ( (ii .le. MAXPPF) .and. + (tplist (ii,ipos) .ne. ' ')) CALL ST_FIND ( tplist (ii,ipos), + prmtbl, ntable, + jpos, ier ) jposno ( ii, ntable+1 ) = jpos IF ( jpos .eq. 0 ) ok = .false. ii = ii + 1 END DO C C* Parameter and all arguments have been C* found. Add to the table and set C* computable flag. C IF ( ok ) THEN ntable = ntable + 1 prmtbl (ntable) = tparms (ipos) fnctbl (ntable) = tfuncs (ipos) cmpflg (i) = .true. kans (i, index) = ntable nfound = nfound + 1 ipos = 0 C C* Some arguments uncomputable; reset C* flag and pointer to continue search. C ELSE more = .true. ipos = ipos + 1 END IF END IF END DO END IF i = i + 1 END DO END IF C C* Check to see if any more parameters can now be computed. C IF ( ( nfound .lt. noutpm ) .and. ( more ) ) THEN knt = 1 DO WHILE ( knt .le. jtfunc ) C C* If a parameter in the function table is not in the C* computable list check whether its arguments are now C* computable (storing pointers along the way). C CALL ST_FIND ( tparms(knt), prmtbl, ntable, ipos, + ier ) IF ( ipos .eq. 0 ) THEN ok = .true. i = 1 DO WHILE ( (i .le. MAXPPF) .and. + (tplist (i,knt) .ne. ' ') ) CALL ST_FIND ( tplist (i,knt), prmtbl, + ntable, ipos, ier ) jposno ( i, ntable+1 ) = ipos IF ( ipos .eq. 0 ) ok = .false. i = i + 1 END DO C C* All arguments computable -- a new parameter has C* been found and is added to the table. C IF ( ok ) THEN ntable = ntable + 1 prmtbl (ntable) = tparms (knt) fnctbl (ntable) = tfuncs (knt) END IF END IF knt = knt + 1 END DO END IF END DO C C* Fill in the function table in common which will be used to C* compute parameters. Input parameters and special corresponding C* temp/dewpoint parameters were already loaded above. C C* LIST flags those functions that need to be executed. First, use C* a 2 to flag functions not an input parameter which are used C* as an answer. C DO i = 1, MAXTMP list (i) = 0 END DO C max = 0 DO i = 1, noutpm k = kans (i, index) IF ( k .gt. ninpm ) THEN list (k) = 2 IF ( k .gt. max ) max = k END IF END DO C C* Now flag answers not in the input data with 2, use 1 to flag C* arguments not in the input. C DO WHILE ( max .gt. 0 ) nmax = 0 DO i = max, ninpm+1, -1 IF ( list (i) .eq. 2 ) THEN list (i) = 1 DO j = 1, maxppf kk = jposno (j,i) IF ( (kk .gt. ninpm) .and. (list(kk) .ne. 1) ) + THEN list (kk) = 2 IF ( kk .gt. max ) nmax = kk END IF END DO END IF END DO max = nmax END DO C C* Fill computable function table with computable functions used. C DO k = ninpm+1, MAXTMP IF ( list (k) .ne. 0 ) THEN if = kfunc (index) + 1 kfunc (index) = if kfuncn ( if, index ) = fnctbl (k) DO j = 1, MAXPPF kposno (j, if, index) = jposno (j, k) END DO koutfn ( if, index ) = k END IF END DO C C* Fill in table with types for output parameters. C CALL PC_CKPM ( index, noutpm, prmout, ier ) C C* Find character parameters. C IF ( index .eq. 1 ) THEN DO j = 1, noutpm qchr (j) = .false. chrfnc (j) = ' ' IF ( kans (j,index) .ne. 0 ) THEN IF ( fnctbl ( kans (j,index) ) (1:2) .eq. 'PT' ) + THEN qchr (j) = .true. chrfnc (j) = fnctbl ( kans (j,index) ) END IF END IF END DO END IF C C* set final output variables. C np = nfound kfound ( index ) = nfound tabflg (index) = .true. C* RETURN END