integer nv3inimsat_(integer *ifunc, integer *iparms) { /* System generated locals */ integer ret_val; char ch__1[4]; /* Builtin functions */ integer i_indx(char *, char *, ftnlen, ftnlen); /* Local variables */ extern integer lit_(char *, ftnlen); extern /* Character */ VOID clit_(char *, ftnlen, integer *); extern /* Subroutine */ int movw_(integer *, integer *, integer *); extern real flalo_(integer *); /* Parameter adjustments */ --iparms; /* Function Body */ if (*ifunc == 1) { if (iparms[1] != lit_("MSAT", (ftnlen)4)) { ret_val = -1; return ret_val; } movw_(&c__3, &iparms[4], polyxxmsatnv3_1.ioff); metxxxmsatnv3_1.h__ = 35785.845000000001f; metxxxmsatnv3_1.re = 6378.155f; metxxxmsatnv3_1.a = .0033670033670033669f; metxxxmsatnv3_1.rp = metxxxmsatnv3_1.re / (metxxxmsatnv3_1.a + 1.f); metxxxmsatnv3_1.pi = 3.141592653f; metxxxmsatnv3_1.cdr = metxxxmsatnv3_1.pi / 180.f; metxxxmsatnv3_1.crd = 180.f / metxxxmsatnv3_1.pi; metxxxmsatnv3_1.lpsi2 = 1; metxxxmsatnv3_1.deltax = .0071999999999999998f; metxxxmsatnv3_1.deltay = .0071999999999999998f; metxxxmsatnv3_1.rflon = 0.f; polyxxmsatnv3_1.sublon = flalo_(&iparms[7]); } else if (*ifunc == 2) { clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) { metxxxmsatnv3_1.ic = 1; } clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) { metxxxmsatnv3_1.ic = 2; } } ret_val = 0; return ret_val; } /* nv3inimsat_ */
integer nv2inimsgt_(integer *ifunc, integer *iparms) { /* System generated locals */ integer ret_val; char ch__1[4]; /* Builtin functions */ integer i_indx(char *, char *, ftnlen, ftnlen); /* Local variables */ extern integer lit_(char *, ftnlen); extern /* Character */ VOID clit_(char *, ftnlen, integer *); /* Parameter adjustments */ --iparms; /* Function Body */ msgmsgtnv2_1.itype = 0; ret_val = 0; if (*ifunc == 1) { if (iparms[1] != lit_("MSGT", (ftnlen)4)) { ret_val = -1; return ret_val; } nvparammsgtnv2_1.loff = iparms[2]; nvparammsgtnv2_1.coff = iparms[3]; nvparammsgtnv2_1.lfac = iparms[4]; nvparammsgtnv2_1.cfac = iparms[5]; } else if (*ifunc == 2) { clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) { msgmsgtnv2_1.itype = 1; } clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) { msgmsgtnv2_1.itype = 2; } } return ret_val; } /* nv2inimsgt_ */
integer kb1optmsg_(char *cfunc, integer *iin, integer *iout, ftnlen cfunc_len) { /* System generated locals */ integer ret_val; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ extern integer lit_(char *, ftnlen); extern /* Subroutine */ int movw_(integer *, integer *, integer *); /* external functions */ /* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */ /* Refer to "McIDAS Software Acquisition and Distribution Policies" */ /* in the file mcidas/data/license.txt */ /* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */ /* area subsystem parameters */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */ /* MCIDAS.H !! */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* MAXGRIDPT maximum number of grid points */ /* MAX_BANDS maximum number of bands within an area */ /* MAXDFELEMENTS maximum number of elements that DF can handle */ /* in an area line */ /* MAXOPENAREAS maximum number of areas that the library can */ /* have open (formerly called `NA') */ /* NUMAREAOPTIONS number of options settable through ARAOPT() */ /* It is presently 5 because there are five options */ /* that ARAOPT() knows about: */ /* 'PREC','SPAC','UNIT','SCAL','CALB' */ /* (formerly called `NB') */ /* --- Size (number of words) in an area directory */ /* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */ /* used to recieve AUX blocks during an */ /* ADDE transaction */ /* ----- MAX_AREA_NUMBER Maximum area number allowed on system */ /* ----- MAXAREARQSTLEN - max length of area request string */ /* Parameter adjustments */ --iout; --iin; /* Function Body */ ret_val = 0; if (s_cmp(cfunc, "KEYS", (ftnlen)4, (ftnlen)4) == 0) { if (iin[4] <= 3 || iin[4] == 12) { iout[1] = 4; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("RAD ", (ftnlen)4); iout[4] = lit_("REFL", (ftnlen)4); iout[5] = lit_("BRIT", (ftnlen)4); } else { iout[1] = 4; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("RAD ", (ftnlen)4); iout[4] = lit_("TEMP", (ftnlen)4); iout[5] = lit_("BRIT", (ftnlen)4); } } else if (s_cmp(cfunc, "INFO", (ftnlen)4, (ftnlen)4) == 0) { if (iin[1] <= 3 || iin[1] == 12) { iout[1] = 4; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("RAD ", (ftnlen)4); iout[4] = lit_("REFL", (ftnlen)4); iout[5] = lit_("BRIT", (ftnlen)4); iout[6] = lit_(" ", (ftnlen)4); iout[7] = lit_("MW**", (ftnlen)4); iout[8] = lit_("% ", (ftnlen)4); iout[9] = lit_(" ", (ftnlen)4); iout[10] = 1; iout[11] = 100; iout[12] = 100; iout[13] = 1; } else { iout[1] = 4; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("RAD ", (ftnlen)4); iout[4] = lit_("TEMP", (ftnlen)4); iout[5] = lit_("BRIT", (ftnlen)4); iout[6] = lit_(" ", (ftnlen)4); iout[7] = lit_("MW**", (ftnlen)4); iout[8] = lit_("K ", (ftnlen)4); iout[9] = lit_(" ", (ftnlen)4); iout[10] = 1; iout[11] = 100; iout[12] = 100; iout[13] = 1; } } else if (s_cmp(cfunc, "CALB", (ftnlen)4, (ftnlen)4) == 0) { msgcommsgkb1_1.calflg = 1; movw_(&c__313, &iin[1], msgcommsgkb1_1.calarr); } else { ret_val = -1; } return ret_val; } /* kb1optmsg_ */
logical walk_() { /* System generated locals */ logical ret_val; ret_val = TRUE_; /* !ASSUME WINS. */ if (play_1.winner != aindex_1.player || lit_(play_1.here) || prob_(25, 25)) { goto L500; } if (! findxt_(prsvec_1.prso, play_1.here)) { goto L450; } /* !INVALID EXIT? GRUE */ /* ! */ switch (curxt_1.xtype) { case 1: goto L400; case 2: goto L200; case 3: goto L100; case 4: goto L300; } /* !DECODE EXIT TYPE. */ bug_(9, curxt_1.xtype); L100: if (cxappl_(curxt_1.xactio) != 0) { goto L400; } /* !CEXIT... RETURNED ROOM? */ if (flags[*xflag - 1]) { goto L400; } /* !NO, FLAG ON? */ L200: jigsup_(523); /* !BAD EXIT, GRUE */ /* ! */ return ret_val; L300: if (cxappl_(curxt_1.xactio) != 0) { goto L400; } /* !DOOR... RETURNED ROOM? */ if ((objcts_1.oflag2[curxt_1.xobj - 1] & OPENBT) != 0) { goto L400; } /* !NO, DOOR OPEN? */ jigsup_(523); /* !BAD EXIT, GRUE */ /* ! */ return ret_val; L400: if (lit_(curxt_1.xroom1)) { goto L900; } /* !VALID ROOM, IS IT LIT? */ L450: jigsup_(522); /* !NO, GRUE */ /* ! */ return ret_val; /* ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE). */ L500: if (findxt_(prsvec_1.prso, play_1.here)) { goto L550; } /* !EXIT EXIST? */ L525: curxt_1.xstrng = 678; /* !ASSUME WALL. */ if (prsvec_1.prso == xsrch_1.xup) { curxt_1.xstrng = 679; } /* !IF UP, CANT. */ if (prsvec_1.prso == xsrch_1.xdown) { curxt_1.xstrng = 680; } /* !IF DOWN, CANT. */ if ((rooms_1.rflag[play_1.here - 1] & RNWALL) != 0) { curxt_1.xstrng = 524; } rspeak_(curxt_1.xstrng); prsvec_1.prscon = 1; /* !STOP CMD STREAM. */ return ret_val; L550: switch (curxt_1.xtype) { case 1: goto L900; case 2: goto L600; case 3: goto L700; case 4: goto L800; } /* !BRANCH ON EXIT TYPE. */ bug_(9, curxt_1.xtype); L700: if (cxappl_(curxt_1.xactio) != 0) { goto L900; } /* !CEXIT... RETURNED ROOM? */ if (flags[*xflag - 1]) { goto L900; } /* !NO, FLAG ON? */ L600: if (curxt_1.xstrng == 0) { goto L525; } /* !IF NO REASON, USE STD. */ rspeak_(curxt_1.xstrng); /* !DENY EXIT. */ prsvec_1.prscon = 1; /* !STOP CMD STREAM. */ return ret_val; L800: if (cxappl_(curxt_1.xactio) != 0) { goto L900; } /* !DOOR... RETURNED ROOM? */ if ((objcts_1.oflag2[curxt_1.xobj - 1] & OPENBT) != 0) { goto L900; } /* !NO, DOOR OPEN? */ if (curxt_1.xstrng == 0) { curxt_1.xstrng = 525; } /* !IF NO REASON, USE STD. */ rspsub_(curxt_1.xstrng, objcts_1.odesc2[curxt_1.xobj - 1]); prsvec_1.prscon = 1; /* !STOP CMD STREAM. */ return ret_val; L900: ret_val = moveto_(curxt_1.xroom1, play_1.winner); /* !MOVE TO ROOM. */ if (ret_val) { ret_val = rmdesc_(0); } /* !DESCRIBE ROOM. */ return ret_val; } /* walk_ */
integer rdcalgmskb3_(integer *calb, integer *idir, integer *iband, integer * itab) { /* Initialized data */ static real wnfctr[3] = { .7903f,.7874f,.8676f }; /* System generated locals */ address a__1[2]; integer ret_val, i__1, i__2, i__3[2]; real r__1; char ch__1[55], ch__2[73], ch__3[42]; /* Builtin functions */ double r_sign(real *, real *), pow_ri(real *, integer *); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); double r_mod(real *, real *); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ static real c__, g; static integer i__, j, k; static real r__, v, c0, v0; static integer v1, v2, ig[3], iv, ic0[3], iv0[3], ida, dir[512], ihr, imn, imo, iok, jok; extern integer lit_(char *, ftnlen), lwix_(char *, integer *, integer *, integer *, ftnlen); static integer iss; static real riv; static integer iyr, ixv, ifac; static real beta[21] /* was [7][3] */; static integer ltab, ioff; extern real gmtradgmskb3_(real *, integer *); static integer kend; extern /* Subroutine */ int gmpfcogmskb3_(char *, integer *, ftnlen); static integer nlen; extern /* Subroutine */ int movb_(); static real rrem; static integer kbyt; extern integer ksys_(integer *); static integer idcal; static char calbl[1*7168]; static integer iarea; static char cfile[12], cname[4]; static integer ibeta[21] /* was [7][3] */, idate[2], ifact[3], idsen; extern /* Subroutine */ int edestX_(char *, integer *, ftnlen); static integer ntabs, istat; extern /* Subroutine */ int sysin_(integer *, integer *); static integer icalbl[1792]; extern /* Subroutine */ int swbyt4_(integer *, integer *), araget_( integer *, integer *, integer *, integer *); static integer ispare[3], lbstart, nbstart; /* All variables must be declared */ /* from each line header for IBUF dat */ /* Input array of calibration constants */ /* for GMS, since the area calibratio */ /* block must be accessed locally) */ /* Area directory buffer (this is mandat */ /* Band number of data in area */ /* absolute radiation temperature */ /* Lookup table containing albedo or */ /* (defines NUMAREAOPTIONS) */ /* Global declarations for McIDAS areas */ /* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */ /* Refer to "McIDAS Software Acquisition and Distribution Policies" */ /* in the file mcidas/data/license.txt */ /* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */ /* area subsystem parameters */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */ /* MCIDAS.H !! */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* MAXGRIDPT maximum number of grid points */ /* MAX_BANDS maximum number of bands within an area */ /* MAXDFELEMENTS maximum number of elements that DF can handle */ /* in an area line */ /* MAXOPENAREAS maximum number of areas that the library can */ /* have open (formerly called `NA') */ /* NUMAREAOPTIONS number of options settable through ARAOPT() */ /* It is presently 5 because there are five options */ /* that ARAOPT() knows about: */ /* 'PREC','SPAC','UNIT','SCAL','CALB' */ /* (formerly called `NB') */ /* --- Size (number of words) in an area directory */ /* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */ /* used to recieve AUX blocks during an */ /* ADDE transaction */ /* ----- MAX_AREA_NUMBER Maximum area number allowed on system */ /* ----- MAXAREARQSTLEN - max length of area request string */ /* Flag identifying conversion code */ /* Source pixel size in bytes */ /* Destination pixel size in bytes */ /* Flag specifying how to construct ITAB */ /* Calibration parameters for conve */ /* Radiance table for GMS-5 */ /* We use only IVAL to pass back */ /* the calibration option used */ /* and rename ITAB because its */ /* address is passed as an arg */ /* platform or compiler depend */ /* too, and might be susceptab */ /* ID number of calibration table */ /* byte offset into GMSCAL file(s) */ /* Logical .AND. function */ /* Acquire SYSVAL value */ /* LW file read */ /* Converts CHAR*4 to INTEGER */ /* Real MOD function */ /* Converts GMS-5 TEMP to RAD */ /* index variable */ /* index variable */ /* index variable */ /* Length of arbitrary block in byt */ /* End word count of a block */ /* Input block starting byte count */ /* Output block starting byte count */ /* Input index value */ /* Interpolated data output index v */ /* First table value */ /* Second table value */ /* area number from IDIR array */ /* spacecraft/sensor ID from IDIR a */ /* LWI status returned */ /* Year */ /* Month */ /* Day of month */ /* Hour of day (GMT) */ /* Minute of hour */ /* (from first word in file) */ /* number of tables in the GMSCAL f */ /* Default GMSCAL table directory */ /* GMS-5 McIDAS Calibration block */ /* Calibration ID from data block */ /* (YY,YY,MM,DD,HH,mm) */ /* Six-byte date data block was gen */ /* (1=primary, 2=redundant) */ /* Sensor selector byte */ /* (significant if non-zero) */ /* bad radiance value counter */ /* (significant if non-zero) */ /* error flag for GMP_FCO function */ /* Byte address of CNAME block */ /* IR bands for converting DN to */ /* sensor output voltage (scaled */ /* Calibration constants for the th */ /* the series expansion for each */ /* Number of calibration constants */ /* G constant for each IR band */ /* V0 constant for each IR band */ /* C0 constant for each IR band */ /* Unused spare location in table */ /* the series expansion to be use */ /* Number of calibration constants */ /* Real input index value IV */ /* Remainder mod 1.0 */ /* IR bands for converting DN to */ /* sensor output voltage */ /* Calibration constants for the th */ /* (volts/watt/cm**2/sr) */ /* G constant to be used */ /* (zero level voltage) */ /* V0 constant to be used */ /* C0 constant to be used */ /* series expansion */ /* Intermediate "DN" value used in */ /* Output voltage from series expan */ /* (watts/cm**2/sr) */ /* Radiance from voltage and G cons */ /* W/cm**2/sr to W/etc/cm**-1 */ /* for the GMS-5 IR bands */ /* Wave number factor to convert fr */ /* calibration tables */ /* Input file containing default */ /* GMS-5 McIDAS Calibration block */ /* Table Name in calibration data b */ /* Parameter adjustments */ --itab; --idir; --calb; /* Function Body */ iss = idir[3]; iarea = idir[33]; ltab = 0; if (idir[3] == 12) { ltab = 1; } else if (idir[3] == 13) { ltab = 3; } else if (idir[3] == 82 && *iband == 1) { ltab = 1; } else if (idir[3] == 82 && *iband == 2) { ltab = 3; } else if (idir[3] == 82 && *iband == 8) { ltab = 3; } else if (idir[3] == 83 && *iband == 1) { ltab = 4; } else if (idir[3] == 83 && *iband == 2) { ltab = 5; } else if (idir[3] == 83 && *iband == 3) { ltab = 6; } else if (idir[3] == 83 && *iband == 4) { ltab = 7; } else if (idir[3] == 83 && *iband == 8) { ltab = 5; } else { edestX_("RD_CAL: Unrecognized data band or SS", &c__0, (ftnlen)36); ret_val = -1; goto L500; } if (gmsxxgmskb3_1.kopt <= 0 || gmsxxgmskb3_1.kopt > 15) { gmsxxgmskb3_1.kopt = ksys_(&c__151); } if (gmsxxgmskb3_1.kopt <= 0 || gmsxxgmskb3_1.kopt > 15) { gmsxxgmskb3_1.kopt = 7; if (idir[3] <= 82) { gmsxxgmskb3_1.kopt = 3; } } if (idir[3] <= 82 && gmsxxgmskb3_1.kopt > 3) { edestX_("Invalid calibration option for SS=", &idir[3], (ftnlen)34); edestX_(" ...was ", &gmsxxgmskb3_1.kopt, (ftnlen)12); gmsxxgmskb3_1.kopt = 3; edestX_(" ...reset to ", &gmsxxgmskb3_1.kopt, (ftnlen)17); edestX_("Options > 3 valid for GMS-5 and later only!", &c__0, (ftnlen) 43); } debuggmskb3_2.ival = 0; idsen = 0; if ((gmsxxgmskb3_1.kopt & 12) != 0) { araget_(&iarea, &idir[63], &c__7168, icalbl); if (icalbl[0] != lit_("GMS5", (ftnlen)4) || icalbl[1] > 90) { edestX_("Calibration block is not GMS-5 format.", &c__0, (ftnlen) 38); edestX_("It cannot be used by the GMS calibration module.", &c__0, (ftnlen)48); edestX_("Will attempt to use GMSCAL file tables instead.", &c__0, ( ftnlen)47); goto L200; } nlen = icalbl[1]; if (icalbl[2] == lit_("COEF", (ftnlen)4)) { movb_(&c__256, icalbl, calbl, &c__0, (ftnlen)1); for (i__ = 1; i__ <= 60; i__ += 3) { i__1 = i__ + 2; for (j = i__; j <= i__1; ++j) { for (k = -3; k <= 0; ++k) { if (*(unsigned char *)&calbl[(j << 2) + k - 1] < 32 || *(unsigned char *)&calbl[(j << 2) + k - 1] > 126) { *(unsigned char *)&calbl[(j << 2) + k - 1] = '*'; } } } } movb_(&c__256, &icalbl[icalbl[3] / 4], calbl, &c__0, (ftnlen)1); movb_(&c__4, calbl, &idcal, &c__0); movb_(&c__6, calbl + 4, idate, &c__0, (ftnlen)1); iyr = idate[0] / 65536; imo = (idate[0] - (iyr << 16)) / 256; ida = idate[0] - (iyr << 16) - (imo << 8); ihr = idate[1] / 65536 / 256; imn = idate[1] / 65536 - (ihr << 8); movb_(&c__1, calbl + 10, &idsen, &c__0, (ftnlen)1); idsen /= 16777216; /* shift right 3 bytes */ ifact[0] = *(unsigned char *)&calbl[11]; movb_(&c__4, calbl + 12, ibeta, &c__0, (ftnlen)1); movb_(&c__4, calbl + 16, &ibeta[1], &c__0, (ftnlen)1); movb_(&c__4, calbl + 20, &ibeta[2], &c__0, (ftnlen)1); movb_(&c__4, calbl + 24, &ibeta[3], &c__0, (ftnlen)1); movb_(&c__4, calbl + 28, &ibeta[4], &c__0, (ftnlen)1); movb_(&c__4, calbl + 32, &ibeta[5], &c__0, (ftnlen)1); movb_(&c__4, calbl + 36, &ibeta[6], &c__0, (ftnlen)1); movb_(&c__4, calbl + 40, ig, &c__0, (ftnlen)1); movb_(&c__4, calbl + 44, iv0, &c__0, (ftnlen)1); movb_(&c__4, calbl + 48, ic0, &c__0, (ftnlen)1); movb_(&c__4, calbl + 52, ispare, &c__0, (ftnlen)1); ifact[1] = *(unsigned char *)&calbl[56]; movb_(&c__4, calbl + 57, &ibeta[7], &c__0, (ftnlen)1); movb_(&c__4, calbl + 61, &ibeta[8], &c__0, (ftnlen)1); movb_(&c__4, calbl + 65, &ibeta[9], &c__0, (ftnlen)1); movb_(&c__4, calbl + 69, &ibeta[10], &c__0, (ftnlen)1); movb_(&c__4, calbl + 73, &ibeta[11], &c__0, (ftnlen)1); movb_(&c__4, calbl + 77, &ibeta[12], &c__0, (ftnlen)1); movb_(&c__4, calbl + 81, &ibeta[13], &c__0, (ftnlen)1); movb_(&c__4, calbl + 85, &ig[1], &c__0, (ftnlen)1); movb_(&c__4, calbl + 89, &iv0[1], &c__0, (ftnlen)1); movb_(&c__4, calbl + 93, &ic0[1], &c__0, (ftnlen)1); movb_(&c__4, calbl + 97, &ispare[1], &c__0, (ftnlen)1); ifact[2] = *(unsigned char *)&calbl[101]; movb_(&c__4, calbl + 102, &ibeta[14], &c__0, (ftnlen)1); movb_(&c__4, calbl + 106, &ibeta[15], &c__0, (ftnlen)1); movb_(&c__4, calbl + 110, &ibeta[16], &c__0, (ftnlen)1); movb_(&c__4, calbl + 114, &ibeta[17], &c__0, (ftnlen)1); movb_(&c__4, calbl + 118, &ibeta[18], &c__0, (ftnlen)1); movb_(&c__4, calbl + 122, &ibeta[19], &c__0, (ftnlen)1); movb_(&c__4, calbl + 126, &ibeta[20], &c__0, (ftnlen)1); movb_(&c__4, calbl + 130, &ig[2], &c__0, (ftnlen)1); movb_(&c__4, calbl + 134, &iv0[2], &c__0, (ftnlen)1); movb_(&c__4, calbl + 138, &ic0[2], &c__0, (ftnlen)1); movb_(&c__4, calbl + 142, &ispare[2], &c__0, (ftnlen)1); if (*iband > 1 && *iband <= 4) { g = (ig[*iband - 2] & 2147483647) * 1e-6f; v0 = (iv0[*iband - 2] & 2147483647) * 1e-6f; c0 = (ic0[*iband - 2] & 2147483647) * 1e-6f; r__1 = (real) ig[*iband - 2]; g = r_sign(&g, &r__1); r__1 = (real) iv0[*iband - 2]; v0 = r_sign(&v0, &r__1); r__1 = (real) ic0[*iband - 2]; c0 = r_sign(&c0, &r__1); ifac = ifact[*iband - 2] + 1; if (ifac < 1 || ifac > 7) { ifac = 7; } for (i__ = 1; i__ <= 3; ++i__) { i__1 = ifac; for (j = 1; j <= i__1; ++j) { beta[j + i__ * 7 - 8] = (ibeta[j + i__ * 7 - 8] & 2147483647) * 1e-6f; r__1 = (real) ibeta[j + i__ * 7 - 8]; beta[j + i__ * 7 - 8] = r_sign(&beta[j + i__ * 7 - 8], &r__1); } } for (j = 1; j <= 255; ++j) { /* index on S-VISSR DN l */ c__ = 255.f - j + c0; /* convert to instrument */ v = 0.f; i__1 = ifac; for (k = 1; k <= i__1; ++k) { /* do the series expansi */ i__2 = k - 1; v += beta[k + (*iband - 1) * 7 - 8] * pow_ri(&c__, & i__2); } r__ = (v - v0) / g; /* convert to radiance W */ r__ = r__ * .5f / wnfctr[*iband - 2]; /* convert to mW/etc./cm */ radgmskb3_1.ktab[j - 1] = (integer) (r__ * 1e3f); /* the KTAB table as */ /* scale by 1000 and put */ } iok = 0; for (j = 2; j <= 255; ++j) { if (radgmskb3_1.ktab[j - 1] < 0 || radgmskb3_1.ktab[j - 1] > 190000) { ++iok; } } } } else { goto L100; } if (ltab <= 3) { goto L100; } if (ltab == 4) { s_copy(cname, "5VIS", (ftnlen)4, (ftnlen)4); } if (ltab == 5) { s_copy(cname, "5IR1", (ftnlen)4, (ftnlen)4); } if (ltab == 6) { s_copy(cname, "5IR2", (ftnlen)4, (ftnlen)4); } if (ltab == 7) { s_copy(cname, "5IR3", (ftnlen)4, (ftnlen)4); } if (ltab >= 8) { goto L100; } kbyt = 0; kend = nlen / 4; if (kend > 22) { edestX_("RD_CAL: Bad directory structure. KEND=", &kend, (ftnlen) 39); kend = 22; } i__1 = kend; for (j = 5; j <= i__1; ++j) { if (icalbl[j - 1] == lit_(cname, (ftnlen)4)) { kbyt = icalbl[j]; } } if (kbyt != 0) { movb_(&c__1024, &icalbl[kbyt / 4], &itab[1], &c__0); itab[1] = itab[2]; itab[256] = itab[255]; } else { edestX_("KBYT cannot be set -- no table exists", &c__0, (ftnlen)37) ; goto L100; } if (*iband != 1) { goto L80; } for (i__ = 4; i__ >= 1; --i__) { lbstart = (i__ - 1 << 6) + 1; nbstart = i__ - 1 << 8; for (ixv = 256; ixv >= 1; --ixv) { riv = (real) (ixv - 1) / 252.f * 63.f; iv = riv; v1 = itab[lbstart + iv]; v2 = itab[lbstart + iv + 1]; if (iv == 63) { v2 = 1000000; } rrem = r_mod(&riv, &c_b208); itab[nbstart + ixv] = v1 + (v2 - v1) * rrem + .5f; } } L80: debuggmskb3_2.ival = 8; if (iok > 5 && (gmsxxgmskb3_1.kopt & 15) == 8) { edestX_("Too many of the real-time power series radiances are", & c__0, (ftnlen)52); edestX_("outside expected limits and are likely to be in error.", & c__0, (ftnlen)54); goto L100; } if ((gmsxxgmskb3_1.kopt & 4) == 0) { goto L400; } } L100: if ((gmsxxgmskb3_1.kopt & 4) != 0) { if (iss == 83) { if (idsen != 2) { gmpfcogmskb3_("A", &jok, (ftnlen)1); } if (idsen == 2) { gmpfcogmskb3_("B", &jok, (ftnlen)1); } if (jok == 0) { goto L300; } for (j = 1; j <= 256; ++j) { r__1 = itab[j] * .001f; radgmskb3_1.ktab[j - 1] = gmtradgmskb3_(&r__1, iband) * 1e3f; } } else { goto L200; } debuggmskb3_2.ival = 4; goto L400; } L200: if ((gmsxxgmskb3_1.kopt & 2) != 0) { s_copy(cfile, "GMSCALU", (ftnlen)12, (ftnlen)7); istat = lwix_(cfile, &c__0, &c__512, dir, (ftnlen)12); swbyt4_(dir, &c__512); if (istat != 0 && (gmsxxgmskb3_1.kopt & 1) == 0) { /* Writing concatenation */ i__3[0] = 43, a__1[0] = "ERROR reading calibration tables from f" "ile "; i__3[1] = 12, a__1[1] = cfile; s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)55); edestX_(ch__1, &c__0, (ftnlen)55); goto L300; } ntabs = dir[0]; ioff = (ltab - 1 << 8) + 512; if (ltab > ntabs) { goto L300; } istat = lwix_(cfile, &ioff, &c__256, &itab[1], (ftnlen)12); swbyt4_(&itab[1], &c__256); for (j = 1; j <= 256; ++j) { itab[j + 256] = itab[j]; itab[j + 512] = itab[j]; itab[j + 768] = itab[j]; } if (istat != 0) { goto L300; } if (iss == 83) { if (idsen != 2) { gmpfcogmskb3_("A", &jok, (ftnlen)1); } if (idsen == 2) { gmpfcogmskb3_("B", &jok, (ftnlen)1); } if (jok == 0) { goto L300; } for (j = 1; j <= 256; ++j) { r__1 = itab[j] * .001f; radgmskb3_1.ktab[j - 1] = gmtradgmskb3_(&r__1, iband) * 1e3f; } } debuggmskb3_2.ival = 2; goto L400; } L300: if ((gmsxxgmskb3_1.kopt & 1) != 0) { s_copy(cfile, "GMSCAL", (ftnlen)12, (ftnlen)6); istat = lwix_(cfile, &c__0, &c__512, dir, (ftnlen)12); swbyt4_(dir, &c__512); if (istat != 0) { /* Writing concatenation */ i__3[0] = 43, a__1[0] = "ERROR reading calibration tables from f" "ile "; i__3[1] = 12, a__1[1] = cfile; s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)55); edestX_(ch__1, &c__0, (ftnlen)55); ret_val = -1; goto L500; } ntabs = dir[0]; ioff = (ltab - 1 << 8) + 512; if (ltab > ntabs) { edestX_("RD_CAL ERROR -- Unrecognized Table ID=", <ab, (ftnlen) 38); /* Writing concatenation */ i__3[0] = 61, a__1[0] = "The table index is greater than number " "of tables in the file "; i__3[1] = 12, a__1[1] = cfile; s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)73); edestX_(ch__2, &c__0, (ftnlen)73); edestX_("Check SS and band number for consistency with the table " "ID", &c__0, (ftnlen)58); edestX_(" SS=", &idir[3], ( ftnlen)38); edestX_(" Band=", iband, (ftnlen) 38); ret_val = -1; goto L500; } istat = lwix_(cfile, &ioff, &c__256, &itab[1], (ftnlen)12); swbyt4_(&itab[1], &c__256); for (j = 1; j <= 256; ++j) { itab[j + 256] = itab[j]; itab[j + 512] = itab[j]; itab[j + 768] = itab[j]; } if (istat != 0) { /* Writing concatenation */ i__3[0] = 30, a__1[0] = "File status error reading file"; i__3[1] = 12, a__1[1] = cfile; s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)42); edestX_(ch__3, &istat, (ftnlen)42); ret_val = -1; goto L500; } if (iss == 83) { if (idsen != 2) { gmpfcogmskb3_("A", &jok, (ftnlen)1); } if (idsen == 2) { gmpfcogmskb3_("B", &jok, (ftnlen)1); } if (jok == 0) { ret_val = -1; goto L500; } for (j = 1; j <= 256; ++j) { r__1 = itab[j] * .001f; radgmskb3_1.ktab[j - 1] = gmtradgmskb3_(&r__1, iband) * 1e3f; } } debuggmskb3_2.ival = 1; goto L400; } ret_val = -1; goto L500; L400: if (debuggmskb3_2.ival == 0) { ret_val = -1; } else { ret_val = 0; } L500: sysin_(&c__152, &debuggmskb3_2.ival); for (i__ = 1; i__ <= 1024; ++i__) { debuggmskb3_2.itabr[i__ - 1] = itab[i__]; } return ret_val; } /* rdcalgmskb3_ */
integer kb3optgms_(char *cfunc, integer *iin, integer *iout, ftnlen cfunc_len) { /* System generated locals */ address a__1[3]; integer ret_val, i__1[3]; char ch__1[34]; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ extern integer lit_(char *, ftnlen); static char cfile[8]; extern /* Subroutine */ int edestX_(char *, integer *, ftnlen); static integer itest; extern /* Subroutine */ int movwc_(integer *, char *, ftnlen); extern integer ischar_(integer *), brkset_(char *, char *, ftnlen, ftnlen) ; /* All variables must be declared */ /* Option or function descriptor */ /* Input parameters */ /* Output parameters */ /* (defines NUMAREAOPTIONS) */ /* Global declarations for McIDAS a */ /* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */ /* Refer to "McIDAS Software Acquisition and Distribution Policies" */ /* in the file mcidas/data/license.txt */ /* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */ /* area subsystem parameters */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */ /* MCIDAS.H !! */ /* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */ /* MAXGRIDPT maximum number of grid points */ /* MAX_BANDS maximum number of bands within an area */ /* MAXDFELEMENTS maximum number of elements that DF can handle */ /* in an area line */ /* MAXOPENAREAS maximum number of areas that the library can */ /* have open (formerly called `NA') */ /* NUMAREAOPTIONS number of options settable through ARAOPT() */ /* It is presently 5 because there are five options */ /* that ARAOPT() knows about: */ /* 'PREC','SPAC','UNIT','SCAL','CALB' */ /* (formerly called `NB') */ /* --- Size (number of words) in an area directory */ /* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */ /* used to recieve AUX blocks during an */ /* ADDE transaction */ /* ----- MAX_AREA_NUMBER Maximum area number allowed on system */ /* ----- MAXAREARQSTLEN - max length of area request string */ /* Flag identifying conversion code */ /* Source pixel size in bytes */ /* Destination pixel size in bytes */ /* Flag specifying how to construct */ /* Calibration parameters for conve */ /* Common block for BRKSET table type */ /* Calibration type for breakpoint */ /* Sets breakpoint table values */ /* Numeric ASCII value of character */ /* Four byte integer representing C */ /* Logical AND function */ /* (stored in frame dir words 38- */ /* Breakpoint table name for SU */ /* Validity test variable */ /* Parameter adjustments */ --iout; --iin; /* Function Body */ if (s_cmp(cfunc, "KEYS", (ftnlen)4, (ftnlen)4) == 0) { if (iin[1] == 12 || iin[1] >= 82 && iin[4] == 1) { iout[1] = 3; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("ALB ", (ftnlen)4); iout[4] = lit_("BRIT", (ftnlen)4); } else if (iin[1] == 13 || iin[1] >= 82 && iin[4] > 1) { iout[1] = 4; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("RAD ", (ftnlen)4); iout[4] = lit_("TEMP", (ftnlen)4); iout[5] = lit_("BRIT", (ftnlen)4); } else { edestX_("KBX_OPT: Cannot identify vis or IR for KEYS option.", & c__0, (ftnlen)51); } ret_val = 0; if (ischar_(&iin[38]) == 1) { movwc_(&iin[38], cfile, (ftnlen)8); if (brkset_(cfile, brkpntgmskb3_1.caltyp, (ftnlen)8, (ftnlen)4) != 0) { ret_val = -3; } } } else if (s_cmp(cfunc, "BRKP", (ftnlen)4, (ftnlen)4) == 0) { movwc_(&iin[1], cfile, (ftnlen)8); ret_val = 0; if (brkset_(cfile, brkpntgmskb3_1.caltyp, (ftnlen)8, (ftnlen)4) != 0) { ret_val = -3; } } else if (s_cmp(cfunc, "INFO", (ftnlen)4, (ftnlen)4) == 0) { if (iin[2] == 12 || iin[2] >= 82 && iin[1] == 1) { iout[1] = 3; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("ALB ", (ftnlen)4); iout[4] = lit_("BRIT", (ftnlen)4); iout[5] = lit_(" ", (ftnlen)4); iout[6] = lit_(" % ", (ftnlen)4); iout[7] = lit_(" ", (ftnlen)4); iout[8] = 1; iout[9] = 10; iout[10] = 1; } else if (iin[2] == 13 || iin[2] >= 82 && iin[1] > 1) { iout[1] = 4; iout[2] = lit_("RAW ", (ftnlen)4); iout[3] = lit_("RAD ", (ftnlen)4); iout[4] = lit_("TEMP", (ftnlen)4); iout[5] = lit_("BRIT", (ftnlen)4); iout[6] = lit_(" ", (ftnlen)4); iout[7] = lit_("MW**", (ftnlen)4); iout[8] = lit_(" K ", (ftnlen)4); iout[9] = lit_(" ", (ftnlen)4); iout[10] = 1; iout[11] = 100; iout[12] = 10; iout[13] = 1; } else { edestX_("KBX_OPT: Cannot identify vis or IR for INFO option.", & c__0, (ftnlen)51); } ret_val = 0; } else if (s_cmp(cfunc, "METH", (ftnlen)4, (ftnlen)4) == 0) { itest = iin[1] & -16; if (itest != 0) { ret_val = -4; gmsxxgmskb3_1.kopt = 0; edestX_("KB3OPTgms : Invali" "d calibration table method! ", &iin[1], (ftnlen)85); edestX_(" Must be 1-15", &c__0, (ftnlen)20); } else { ret_val = 0; gmsxxgmskb3_1.kopt = iin[1]; } } else { /* Writing concatenation */ i__1[0] = 27, a__1[0] = "Unknown KBX_OPT function-->"; i__1[1] = 4, a__1[1] = cfunc; i__1[2] = 3, a__1[2] = "<--"; s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)34); edestX_(ch__1, &c__0, (ftnlen)34); ret_val = -1; } return ret_val; } /* kb3optgms_ */
void cevapp_(integer ri) { /* Initialized data */ static const integer cndtck[10] = { 50,20,10,5,0,156,156,156,157,0 }; static const integer lmptck[12] = { 50,30,20,10,4,0,154,154,154,154,155,0 }; /* System generated locals */ integer i__1, i__2; /* Local variables */ logical f; integer i, j, bc, br; if (ri == 0) return; /* !IGNORE DISABLED. */ switch (ri) { case 1: goto L1000; case 2: goto L2000; case 3: goto L3000; case 4: goto L4000; case 5: goto L5000; case 6: goto L6000; case 7: goto L7000; case 8: goto L8000; case 9: goto L9000; case 10: goto L10000; case 11: goto L11000; case 12: goto L12000; case 13: goto L13000; case 14: goto L14000; case 15: goto L15000; case 16: goto L16000; case 17: goto L17000; case 18: goto L18000; case 19: goto L19000; case 20: goto L20000; case 21: goto L21000; case 22: goto L22000; case 23: goto L23000; case 24: goto L24000; } bug_(3, ri); /* CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER. */ L1000: /* Computing MIN */ i__1 = 0, i__2 = advs_1.astren[aindex_1.player - 1] + 1; advs_1.astren[aindex_1.player - 1] = min(i__1,i__2); /* !RECOVER. */ if (advs_1.astren[aindex_1.player - 1] >= 0) return; /* !FULLY RECOVERED? */ cevent_1.ctick[cindex_1.cevcur - 1] = 30; /* !NO, WAIT SOME MORE. */ return; /* CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL. */ L2000: if (play_1.here == rindex_1.maint) { i__1 = findex_1.rvmnt / 2 + 71; rspeak_(i__1); } /* !DESCRIBE. */ ++findex_1.rvmnt; /* !RAISE WATER LEVEL. */ if (findex_1.rvmnt <= 16) return; /* !IF NOT FULL, EXIT. */ cevent_1.ctick[cindex_1.cevmnt - 1] = 0; /* !FULL, DISABLE CLOCK. */ rooms_1.rflag[rindex_1.maint - 1] |= RMUNG; rrand[rindex_1.maint - 1] = 80; /* !SAY IT IS FULL OF WATER. */ if (play_1.here == rindex_1.maint) jigsup_(81); /* !DROWN HIM IF PRESENT. */ return; /* CEV3-- LANTERN. DESCRIBE GROWING DIMNESS. */ L3000: litint_(oindex_1.lamp, &findex_1.orlamp, cindex_1.cevlnt, lmptck, 12); /* !DO LIGHT INTERRUPT. */ return; /* CEV4-- MATCH. OUT IT GOES. */ L4000: rspeak_(153); /* !MATCH IS OUT. */ objcts_1.oflag1[oindex_1.match - 1] &= ~ ONBT; return; /* CEV5-- CANDLE. DESCRIBE GROWING DIMNESS. */ L5000: litint_(oindex_1.candl, &findex_1.orcand, cindex_1.cevcnd, cndtck, 10); /* !DO CANDLE INTERRUPT. */ return; /* CEVAPP, PAGE 3 */ /* CEV6-- BALLOON */ L6000: cevent_1.ctick[cindex_1.cevbal - 1] = 3; /* !RESCHEDULE INTERRUPT. */ f = advs_1.avehic[play_1.winner - 1] == oindex_1.ballo; /* !SEE IF IN BALLOON. */ if (state_1.bloc == rindex_1.vlbot) goto L6800; /* !AT BOTTOM? */ if (state_1.bloc == rindex_1.ledg2 || state_1.bloc == rindex_1.ledg3 || state_1.bloc == rindex_1.ledg4 || state_1.bloc == rindex_1.vlbot) goto L6700; /* !ON LEDGE? */ if ((objcts_1.oflag2[oindex_1.recep - 1] & OPENBT) != 0 && findex_1.binff != 0) goto L6500; /* BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED). */ /* FALL TO NEXT ROOM. */ if (state_1.bloc != rindex_1.vair1) goto L6300; /* !IN VAIR1? */ state_1.bloc = rindex_1.vlbot; /* !YES, NOW AT VLBOT. */ newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0); if (f) goto L6200; /* !IN BALLOON? */ if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 || play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot) rspeak_(530); /* !ON LEDGE, DESCRIBE. */ return; L6200: f = moveto_(state_1.bloc, play_1.winner); /* !MOVE HIM. */ if (findex_1.binff == 0) goto L6250; /* !IN BALLOON. INFLATED? */ rspeak_(531); /* !YES, LANDED. */ f = rmdesc_(0); /* !DESCRIBE. */ return; L6250: newsta_(oindex_1.ballo, 532, 0, 0, 0); /* !NO, BALLOON & CONTENTS DIE. */ newsta_(oindex_1.dball, 0, state_1.bloc, 0, 0); /* !INSERT DEAD BALLOON. */ advs_1.avehic[play_1.winner - 1] = 0; /* !NOT IN VEHICLE. */ cevent_1.cflag[cindex_1.cevbal - 1] = FALSE_; /* !DISABLE INTERRUPTS. */ cevent_1.cflag[cindex_1.cevbrn - 1] = FALSE_; findex_1.binff = 0; findex_1.btief = 0; return; L6300: --state_1.bloc; /* !NOT IN VAIR1, DESCEND. */ newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0); if (f) goto L6400; /* !IS HE IN BALLOON? */ if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 || play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot) rspeak_(533); /* !IF ON LEDGE, DESCRIBE. */ return; L6400: f = moveto_(state_1.bloc, play_1.winner); /* !IN BALLOON, MOVE HIM. */ rspeak_(534); /* !DESCRIBE. */ f = rmdesc_(0); return; /* BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY */ /* ! */ L6500: if (state_1.bloc != rindex_1.vair4) goto L6600; /* !AT VAIR4? */ cevent_1.ctick[cindex_1.cevbrn - 1] = 0; cevent_1.ctick[cindex_1.cevbal - 1] = 0; findex_1.binff = 0; findex_1.btief = 0; state_1.bloc = rindex_1.vlbot; /* !FALL TO BOTTOM. */ newsta_(oindex_1.ballo, 0, 0, 0, 0); /* !BALLOON & CONTENTS DIE. */ newsta_(oindex_1.dball, 0, state_1.bloc, 0, 0); /* !SUBSTITUTE DEAD BALLOON. */ if (f) goto L6550; /* !WAS HE IN IT? */ if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 || play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot) rspeak_(535); /* !IF HE CAN SEE, DESCRIBE. */ return; L6550: jigsup_(536); /* !IN BALLOON AT CRASH, DIE. */ return; L6600: ++state_1.bloc; /* !NOT AT VAIR4, GO UP. */ newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0); if (f) goto L6650; /* !IN BALLOON? */ if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 || play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot) rspeak_(537); /* !CAN HE SEE IT? */ return; L6650: f = moveto_(state_1.bloc, play_1.winner); /* !MOVE PLAYER. */ rspeak_(538); /* !DESCRIBE. */ f = rmdesc_(0); return; /* ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT. */ L6700: state_1.bloc += rindex_1.vair2 - rindex_1.ledg2; /* !MOVE TO MIDAIR. */ newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0); if (f) goto L6750; /* !IN BALLOON? */ if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 || play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot) rspeak_(539); /* !NO, STRANDED. */ cevent_1.ctick[cindex_1.cevvlg - 1] = 10; /* !MATERIALIZE GNOME. */ return; L6750: f = moveto_(state_1.bloc, play_1.winner); /* !MOVE TO NEW ROOM. */ rspeak_(540); /* !DESCRIBE. */ f = rmdesc_(0); return; /* AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED. */ L6800: if (findex_1.binff == 0 || ! ((objcts_1.oflag2[oindex_1.recep - 1] & OPENBT) != 0)) return; state_1.bloc = rindex_1.vair1; /* !INFLATED AND OPEN, */ newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0); /* !GO UP TO VAIR1. */ if (f) goto L6850; /* !IN BALLOON? */ if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 || play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot) rspeak_(541); /* !IF CAN SEE, DESCRIBE. */ return; L6850: f = moveto_(state_1.bloc, play_1.winner); /* !MOVE PLAYER. */ rspeak_(542); f = rmdesc_(0); return; /* CEVAPP, PAGE 4 */ /* CEV7-- BALLOON BURNUP */ L7000: i__1 = objcts_1.olnt; for (i = 1; i <= i__1; ++i) { /* !FIND BURNING OBJECT */ if (oindex_1.recep == objcts_1.ocan[i - 1] && (objcts_1.oflag1[i - 1] & FLAMBT) != 0) goto L7200; /* L7100: */ } bug_(4, 0); L7200: newsta_(i, 0, 0, 0, 0); /* !VANISH OBJECT. */ findex_1.binff = 0; /* !UNINFLATED. */ if (play_1.here == state_1.bloc) rspsub_(292, objcts_1.odesc2[i - 1]); /* !DESCRIBE. */ return; /* CEV8-- FUSE FUNCTION */ L8000: if (objcts_1.ocan[oindex_1.fuse - 1] != oindex_1.brick) goto L8500; /* !IGNITED BRICK? */ br = objcts_1.oroom[oindex_1.brick - 1]; /* !GET BRICK ROOM. */ bc = objcts_1.ocan[oindex_1.brick - 1]; /* !GET CONTAINER. */ if (br == 0 && bc != 0) br = objcts_1.oroom[bc - 1]; newsta_(oindex_1.fuse, 0, 0, 0, 0); /* !KILL FUSE. */ newsta_(oindex_1.brick, 0, 0, 0, 0); /* !KILL BRICK. */ if (br != 0 && br != play_1.here) goto L8100; /* !BRICK ELSEWHERE? */ rooms_1.rflag[play_1.here - 1] |= RMUNG; rrand[play_1.here - 1] = 114; /* !MUNG ROOM. */ jigsup_(150); /* !DEAD. */ return; L8100: rspeak_(151); /* !BOOM. */ state_1.mungrm = br; /* !SAVE ROOM THAT BLEW. */ cevent_1.ctick[cindex_1.cevsaf - 1] = 5; /* !SET SAFE INTERRUPT. */ if (br != rindex_1.msafe) goto L8200; /* !BLEW SAFE ROOM? */ if (bc != oindex_1.sslot) return; /* !WAS BRICK IN SAFE? */ newsta_(oindex_1.sslot, 0, 0, 0, 0); /* !KILL SLOT. */ objcts_1.oflag2[oindex_1.safe - 1] |= OPENBT; findex_1.safef = TRUE_; /* !INDICATE SAFE BLOWN. */ return; L8200: i__1 = objcts_1.olnt; for (i = 1; i <= i__1; ++i) { /* !BLEW WRONG ROOM. */ if (qhere_(i, br) && (objcts_1.oflag1[i - 1] & TAKEBT) != 0) newsta_(i, 0, 0, 0, 0); /* L8250: */ } if (br != rindex_1.lroom) return; /* !BLEW LIVING ROOM? */ i__1 = objcts_1.olnt; for (i = 1; i <= i__1; ++i) { if (objcts_1.ocan[i - 1] == oindex_1.tcase) newsta_(i, 0, 0, 0, 0); /* !KILL TROPHY CASE. */ /* L8300: */ } return; L8500: if (qhere_(oindex_1.fuse, play_1.here) || objcts_1.oadv[oindex_1.fuse - 1] == play_1.winner) rspeak_(152); newsta_(oindex_1.fuse, 0, 0, 0, 0); /* !KILL FUSE. */ return; /* CEVAPP, PAGE 5 */ /* CEV9-- LEDGE MUNGE. */ L9000: rooms_1.rflag[rindex_1.ledg4 - 1] |= RMUNG; rrand[rindex_1.ledg4 - 1] = 109; if (play_1.here == rindex_1.ledg4) goto L9100; /* !WAS HE THERE? */ rspeak_(110); /* !NO, NARROW ESCAPE. */ return; L9100: if (advs_1.avehic[play_1.winner - 1] != 0) goto L9200; /* !IN VEHICLE? */ jigsup_(111); /* !NO, DEAD. */ return; L9200: if (findex_1.btief != 0) goto L9300; /* !TIED TO LEDGE? */ rspeak_(112); /* !NO, NO PLACE TO LAND. */ return; L9300: state_1.bloc = rindex_1.vlbot; /* !YES, CRASH BALLOON. */ newsta_(oindex_1.ballo, 0, 0, 0, 0); /* !BALLOON & CONTENTS DIE. */ newsta_(oindex_1.dball, 0, state_1.bloc, 0, 0); /* !INSERT DEAD BALLOON. */ findex_1.btief = 0; findex_1.binff = 0; cevent_1.cflag[cindex_1.cevbal - 1] = FALSE_; cevent_1.cflag[cindex_1.cevbrn - 1] = FALSE_; jigsup_(113); /* !DEAD */ return; /* CEV10-- SAFE MUNG. */ L10000: rooms_1.rflag[state_1.mungrm - 1] |= RMUNG; rrand[state_1.mungrm - 1] = 114; if (play_1.here == state_1.mungrm) goto L10100; /* !IS HE PRESENT? */ rspeak_(115); /* !LET HIM KNOW. */ if (state_1.mungrm == rindex_1.msafe) cevent_1.ctick[cindex_1.cevled - 1] = 8; /* !START LEDGE CLOCK. */ return; L10100: i = 116; /* !HE'S DEAD, */ if ((rooms_1.rflag[play_1.here - 1] & RHOUSE) != 0) i = 117; jigsup_(i); /* !LET HIM KNOW. */ return; /* CEVAPP, PAGE 6 */ /* CEV11-- VOLCANO GNOME */ L11000: if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 || play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot) goto L11100; /* !IS HE ON LEDGE? */ cevent_1.ctick[cindex_1.cevvlg - 1] = 1; /* !NO, WAIT A WHILE. */ return; L11100: newsta_(oindex_1.gnome, 118, play_1.here, 0, 0); /* !YES, MATERIALIZE GNOME. */ return; /* CEV12-- VOLCANO GNOME DISAPPEARS */ L12000: newsta_(oindex_1.gnome, 149, 0, 0, 0); /* !DISAPPEAR THE GNOME. */ return; /* CEV13-- BUCKET. */ L13000: if (objcts_1.ocan[oindex_1.water - 1] == oindex_1.bucke) newsta_(oindex_1.water, 0, 0, 0, 0); return; /* CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED. */ L14000: rooms_1.rflag[rindex_1.cager - 1] |= RMUNG; rrand[rindex_1.cager - 1] = 147; jigsup_(148); /* !MUNG PLAYER. */ return; /* CEV15-- END GAME HERALD. */ L15000: findex_1.endgmf = TRUE_; /* !WE'RE IN ENDGAME. */ rspeak_(119); /* !INFORM OF ENDGAME. */ return; /* CEVAPP, PAGE 7 */ /* CEV16-- FOREST MURMURS */ L16000: cevent_1.cflag[cindex_1.cevfor - 1] = play_1.here == rindex_1.mtree || (play_1.here >= rindex_1.fore1 && play_1.here < rindex_1.clear); if (cevent_1.cflag[cindex_1.cevfor - 1] && prob_(10, 10)) rspeak_(635); return; /* CEV17-- SCOL ALARM */ L17000: if (play_1.here == rindex_1.bktwi) cevent_1.cflag[cindex_1.cevzgi - 1] = TRUE_; /* !IF IN TWI, GNOME. */ if (play_1.here == rindex_1.bkvau) jigsup_(636); /* !IF IN VAU, DEAD. */ return; /* CEV18-- ENTER GNOME OF ZURICH */ L18000: cevent_1.cflag[cindex_1.cevzgo - 1] = TRUE_; /* !EXITS, TOO. */ newsta_(oindex_1.zgnom, 0, rindex_1.bktwi, 0, 0); /* !PLACE IN TWI. */ if (play_1.here == rindex_1.bktwi) rspeak_(637); /* !ANNOUNCE. */ return; /* CEV19-- EXIT GNOME */ L19000: newsta_(oindex_1.zgnom, 0, 0, 0, 0); /* !VANISH. */ if (play_1.here == rindex_1.bktwi) rspeak_(638); /* !ANNOUNCE. */ return; /* CEVAPP, PAGE 8 */ /* CEV20-- START OF ENDGAME */ L20000: if (findex_1.spellf) goto L20200; /* !SPELL HIS WAY IN? */ if (play_1.here != rindex_1.crypt) return; /* !NO, STILL IN TOMB? */ if (! lit_(play_1.here)) goto L20100; /* !LIGHTS OFF? */ cevent_1.ctick[cindex_1.cevste - 1] = 3; /* !RESCHEDULE. */ return; L20100: rspeak_(727); /* !ANNOUNCE. */ L20200: i__1 = objcts_1.olnt; for (i = 1; i <= i__1; ++i) { /* !STRIP HIM OF OBJS. */ newsta_(i, 0, objcts_1.oroom[i - 1], objcts_1.ocan[i - 1], 0); /* L20300: */ } newsta_(oindex_1.lamp, 0, 0, 0, aindex_1.player); /* !GIVE HIM LAMP. */ newsta_(oindex_1.sword, 0, 0, 0, aindex_1.player); /* !GIVE HIM SWORD. */ objcts_1.oflag1[oindex_1.lamp - 1] = (objcts_1.oflag1[oindex_1.lamp - 1] | LITEBT) & ~ ONBT; objcts_1.oflag2[oindex_1.lamp - 1] |= TCHBT; cevent_1.cflag[cindex_1.cevlnt - 1] = FALSE_; /* !LAMP IS GOOD AS NEW. */ cevent_1.ctick[cindex_1.cevlnt - 1] = 350; findex_1.orlamp = 0; objcts_1.oflag2[oindex_1.sword - 1] |= TCHBT; hack_1.swdact = TRUE_; hack_1.swdsta = 0; hack_1.thfact = FALSE_; /* !THIEF GONE. */ findex_1.endgmf = TRUE_; /* !ENDGAME RUNNING. */ cevent_1.cflag[cindex_1.cevmat - 1] = FALSE_; /* !MATCHES GONE, */ cevent_1.cflag[cindex_1.cevcnd - 1] = FALSE_; /* !CANDLES GONE. */ scrupd_(rooms_1.rval[rindex_1.crypt - 1]); /* !SCORE CRYPT, */ rooms_1.rval[rindex_1.crypt - 1] = 0; /* !BUT ONLY ONCE. */ f = moveto_(rindex_1.tstrs, play_1.winner); /* !TO TOP OF STAIRS, */ f = rmdesc_(3); /* !AND DESCRIBE. */ return; /* !BAM */ /* ! */ /* CEV21-- MIRROR CLOSES. */ L21000: findex_1.mrpshf = FALSE_; /* !BUTTON IS OUT. */ findex_1.mropnf = FALSE_; /* !MIRROR IS CLOSED. */ if (play_1.here == rindex_1.mrant) rspeak_(728); /* !DESCRIBE BUTTON. */ if (play_1.here == rindex_1.inmir || mrhere_(play_1.here) == 1) rspeak_(729); return; /* CEVAPP, PAGE 9 */ /* CEV22-- DOOR CLOSES. */ L22000: if (findex_1.wdopnf) rspeak_(730); /* !DESCRIBE. */ findex_1.wdopnf = FALSE_; /* !CLOSED. */ return; /* CEV23-- INQUISITOR'S QUESTION */ L23000: if (advs_1.aroom[aindex_1.player - 1] != rindex_1.fdoor) return; /* !IF PLAYER LEFT, DIE. */ rspeak_(769); i__1 = findex_1.quesno + 770; rspeak_(i__1); cevent_1.ctick[cindex_1.cevinq - 1] = 2; return; /* CEV24-- MASTER FOLLOWS */ L24000: if (advs_1.aroom[aindex_1.amastr - 1] == play_1.here) return; /* !NO MOVEMENT, DONE. */ if (play_1.here != rindex_1.cell && play_1.here != rindex_1.pcell) goto L24100; if (findex_1.follwf) rspeak_(811); /* !WONT GO TO CELLS. */ findex_1.follwf = FALSE_; return; L24100: findex_1.follwf = TRUE_; /* !FOLLOWING. */ i = 812; /* !ASSUME CATCHES UP. */ i__1 = xsrch_1.xmax; i__2 = xsrch_1.xmin; for (j = xsrch_1.xmin; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) { if (findxt_(j, advs_1.aroom[aindex_1.amastr - 1]) && curxt_1.xroom1 == play_1.here) i = 813; /* L24200: */ } rspeak_(i); newsta_(oindex_1.master, 0, play_1.here, 0, 0); /* !MOVE MASTER OBJECT. */ advs_1.aroom[aindex_1.amastr - 1] = play_1.here; /* !MOVE MASTER PLAYER. */ return; } /* cevapp_ */
void game_() { /* Local variables */ logical f; integer i; /* START UP, DESCRIBE CURRENT LOCATION. */ rspeak_(1); /* !WELCOME ABOARD. */ f = rmdesc_(3); /* !START GAME. */ /* NOW LOOP, READING AND EXECUTING COMMANDS. */ L100: play_1.winner = aindex_1.player; /* !PLAYER MOVING. */ play_1.telflg = FALSE_; /* !ASSUME NOTHING TOLD. */ if (prsvec_1.prscon <= 1) { rdline_(input_1.inbuf, 1); } #ifdef ALLOW_GDT if (strcmp(input_1.inbuf + prsvec_1.prscon - 1, "GDT") == 0) { /* !CALL ON GDT? */ gdt_(); /* !YES, INVOKE. */ goto L100; /* !ONWARD. */ } #endif /* ALLOW_GDT */ ++state_1.moves; prsvec_1.prswon = parse_(input_1.inbuf, 1); if (! prsvec_1.prswon) { goto L400; } /* !PARSE LOSES? */ if (xvehic_(1)) { goto L400; } /* !VEHICLE HANDLE? */ if (prsvec_1.prsa == vindex_1.tellw) { goto L2000; } /* !TELL? */ L300: if (prsvec_1.prso == oindex_1.valua || prsvec_1.prso == oindex_1.every) { goto L900; } if (! vappli_(prsvec_1.prsa)) { goto L400; } /* !VERB OK? */ L350: if (! findex_1.echof && play_1.here == rindex_1.echor) { goto L1000; } f = rappli_(rooms_1.ractio[play_1.here - 1]); L400: xendmv_(play_1.telflg); /* !DO END OF MOVE. */ if (! lit_(play_1.here)) { prsvec_1.prscon = 1; } goto L100; L900: valuac_(oindex_1.valua); goto L350; /* GAME, PAGE 3 */ /* SPECIAL CASE-- ECHO ROOM. */ /* IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO. */ L1000: rdline_(input_1.inbuf, 0); ++state_1.moves; /* !CHARGE FOR MOVES. */ if (strcmp(input_1.inbuf, "ECHO") != 0) goto L1300; rspeak_(571); /* !KILL THE ECHO. */ findex_1.echof = TRUE_; objcts_1.oflag2[oindex_1.bar - 1] &= ~ SCRDBT; prsvec_1.prswon = TRUE_; /* !FAKE OUT PARSER. */ prsvec_1.prscon = 1; /* !FORCE NEW INPUT. */ goto L400; L1300: prsvec_1.prswon = parse_(input_1.inbuf, 0); if (! prsvec_1.prswon || prsvec_1.prsa != vindex_1.walkw) { goto L1400; } if (findxt_(prsvec_1.prso, play_1.here)) { goto L300; } /* !VALID EXIT? */ L1400: more_output(input_1.inbuf); play_1.telflg = TRUE_; /* !INDICATE OUTPUT. */ goto L1000; /* !MORE ECHO ROOM. */ /* GAME, PAGE 4 */ /* SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND */ /* NOTE THAT WE CANNOT BE IN THE ECHO ROOM. */ L2000: if ((objcts_1.oflag2[prsvec_1.prso - 1] & ACTRBT) != 0) { goto L2100; } rspeak_(602); /* !CANT DO IT. */ goto L350; /* !VAPPLI SUCCEEDS. */ L2100: play_1.winner = oactor_(prsvec_1.prso); /* !NEW PLAYER. */ play_1.here = advs_1.aroom[play_1.winner - 1]; /* !NEW LOCATION. */ if (prsvec_1.prscon <= 1) { goto L2700; } /* !ANY INPUT? */ if (parse_(input_1.inbuf, 1)) { goto L2150; } L2700: i = 341; /* !FAILS. */ if (play_1.telflg) { i = 604; } /* !GIVE RESPONSE. */ rspeak_(i); L2600: play_1.winner = aindex_1.player; /* !RESTORE STATE. */ play_1.here = advs_1.aroom[play_1.winner - 1]; goto L350; L2150: if (aappli_(advs_1.aactio[play_1.winner - 1])) { goto L2400; } /* !ACTOR HANDLE? */ if (xvehic_(1)) { goto L2400; } /* !VEHICLE HANDLE? */ if (prsvec_1.prso == oindex_1.valua || prsvec_1.prso == oindex_1.every) { goto L2900; } if (! vappli_(prsvec_1.prsa)) { goto L2400; } /* !VERB HANDLE? */ /* L2350: */ f = rappli_(rooms_1.ractio[play_1.here - 1]); L2400: xendmv_(play_1.telflg); /* !DO END OF MOVE. */ goto L2600; /* !DONE. */ L2900: valuac_(oindex_1.valua); /* !ALL OR VALUABLES. */ goto L350; } /* game_ */
integer nv2inips_(integer *ifunc, integer *iparms) { /* Initialized data */ static real rad = .01745329f; /* System generated locals */ integer ret_val, i__1; char ch__1[4]; /* Builtin functions */ double sin(doublereal), tan(doublereal); integer i_indx(char *, char *, ftnlen, ftnlen); /* Local variables */ static real r__; extern integer lit_(char *, ftnlen); static doublereal decc, drad; extern /* Character */ VOID clit_(char *, ftnlen, integer *); extern real flalo_(integer *); static integer ipole; extern /* Subroutine */ int llopt_(doublereal *, doublereal *, integer *, integer *); static real sclat1; /* Parameter adjustments */ --iparms; /* Function Body */ if (*ifunc == 1) { if (iparms[1] != lit_("PS ", (ftnlen)4)) { ret_val = -1; return ret_val; } pscompsnv2_1.itype = 1; pscompsnv2_1.xrow = (real) iparms[2]; pscompsnv2_1.xcol = (real) iparms[3]; ipole = iparms[11]; if (ipole == 0) { ipole = 900000; } pscompsnv2_1.ihem = 1; if (ipole < 0) { pscompsnv2_1.ihem = -1; } pscompsnv2_1.xpole = flalo_(&ipole); i__1 = ipole - iparms[4]; pscompsnv2_1.xlat1 = flalo_(&i__1) * rad; pscompsnv2_1.xspace = iparms[5] / 1e3f; pscompsnv2_1.xqlon = flalo_(&iparms[6]); drad = iparms[7] / 1e3; r__ = drad; decc = iparms[8] / 1e6; pscompsnv2_1.iwest = iparms[10]; if (pscompsnv2_1.iwest >= 0) { pscompsnv2_1.iwest = 1; } llopt_(&drad, &decc, &pscompsnv2_1.iwest, &iparms[9]); pscompsnv2_1.xblat = r__ * sin(pscompsnv2_1.xlat1) / ( pscompsnv2_1.xspace * tan(pscompsnv2_1.xlat1 * .5f)); sclat1 = (90.f - pscompsnv2_1.ihem * flalo_(&iparms[4])) * rad; pscompsnv2_1.fac = 1.f; } else if (*ifunc == 2) { clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) { pscompsnv2_1.itype = 1; } clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) { pscompsnv2_1.itype = 2; } } ret_val = 0; return ret_val; } /* nv2inips_ */
logical rappl1_(integer ri) { /* System generated locals */ integer i__1, i__2; logical ret_val; /* Local variables */ integer i; integer j; ret_val = TRUE_; /* !USUALLY IGNORED. */ if (ri == 0) { return ret_val; } /* !RETURN IF NAUGHT. */ /* !SET TO FALSE FOR */ /* !NEW DESC NEEDED. */ switch (ri) { case 1: goto L1000; case 2: goto L2000; case 3: goto L3000; case 4: goto L4000; case 5: goto L5000; case 6: goto L6000; case 7: goto L7000; case 8: goto L8000; case 9: goto L9000; case 10: goto L10000; case 11: goto L11000; case 12: goto L12000; case 13: goto L13000; case 14: goto L14000; case 15: goto L15000; case 16: goto L16000; case 17: goto L17000; case 18: goto L18000; case 19: goto L19000; case 20: goto L20000; case 21: goto L21000; case 22: goto L22000; case 23: goto L23000; case 24: goto L24000; case 25: goto L25000; case 26: goto L26000; case 27: goto L27000; case 28: goto L28000; case 29: goto L29000; case 30: goto L30000; case 31: goto L31000; case 32: goto L32000; case 33: goto L33000; case 34: goto L34000; case 35: goto L35000; case 36: goto L36000; case 37: goto L37000; } bug_(1, ri); /* R1-- EAST OF HOUSE. DESCRIPTION DEPENDS ON STATE OF WINDOW */ L1000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ i = 13; /* !ASSUME CLOSED. */ if ((objcts_1.oflag2[oindex_1.windo - 1] & OPENBT) != 0) { i = 12; } /* !IF OPEN, AJAR. */ rspsub_(11, i); /* !DESCRIBE. */ return ret_val; /* R2-- KITCHEN. SAME VIEW FROM INSIDE. */ L2000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ i = 13; /* !ASSUME CLOSED. */ if ((objcts_1.oflag2[oindex_1.windo - 1] & OPENBT) != 0) { i = 12; } /* !IF OPEN, AJAR. */ rspsub_(14, i); /* !DESCRIBE. */ return ret_val; /* R3-- LIVING ROOM. DESCRIPTION DEPENDS ON MAGICF (STATE OF */ /* DOOR TO CYCLOPS ROOM), RUG (MOVED OR NOT), DOOR (OPEN OR CLOSED) */ L3000: if (prsvec_1.prsa != vindex_1.lookw) { goto L3500; } /* !LOOK? */ i = 15; /* !ASSUME NO HOLE. */ if (findex_1.magicf) { i = 16; } /* !IF MAGICF, CYCLOPS HOLE. */ rspeak_(i); /* !DESCRIBE. */ i = findex_1.orrug + 17; /* !ASSUME INITIAL STATE. */ if ((objcts_1.oflag2[oindex_1.door - 1] & OPENBT) != 0) { i += 2; } /* !DOOR OPEN? */ rspeak_(i); /* !DESCRIBE. */ return ret_val; /* NOT A LOOK WORD. REEVALUATE TROPHY CASE. */ L3500: if (prsvec_1.prsa != vindex_1.takew && (prsvec_1.prsa != vindex_1.putw || prsvec_1.prsi != oindex_1.tcase)) { return ret_val; } advs_1.ascore[play_1.winner - 1] = state_1.rwscor; /* !SCORE TROPHY CASE. */ i__1 = objcts_1.olnt; for (i = 1; i <= i__1; ++i) { /* !RETAIN RAW SCORE AS WELL. */ j = i; /* !FIND OUT IF IN CASE. */ L3550: j = objcts_1.ocan[j - 1]; /* !TRACE OWNERSHIP. */ if (j == 0) { goto L3600; } if (j != oindex_1.tcase) { goto L3550; } /* !DO ALL LEVELS. */ advs_1.ascore[play_1.winner - 1] += objcts_1.otval[i - 1]; L3600: ; } scrupd_(0); /* !SEE IF ENDGAME TRIG. */ return ret_val; /* RAPPL1, PAGE 3 */ /* R4-- CELLAR. SHUT DOOR AND BAR IT IF HE JUST WALKED IN. */ L4000: if (prsvec_1.prsa != vindex_1.lookw) { goto L4500; } /* !LOOK? */ rspeak_(21); /* !DESCRIBE CELLAR. */ return ret_val; L4500: if (prsvec_1.prsa != vindex_1.walkiw) { return ret_val; } /* !WALKIN? */ if ((objcts_1.oflag2[oindex_1.door - 1] & (OPENBT + TCHBT)) != OPENBT) { return ret_val; } objcts_1.oflag2[oindex_1.door - 1] = (objcts_1.oflag2[oindex_1.door - 1] | TCHBT) & ~ OPENBT; rspeak_(22); /* !SLAM AND BOLT DOOR. */ return ret_val; /* R5-- MAZE11. DESCRIBE STATE OF GRATING. */ L5000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(23); /* !DESCRIBE. */ i = 24; /* !ASSUME LOCKED. */ if (findex_1.grunlf) { i = 26; } /* !UNLOCKED? */ if ((objcts_1.oflag2[oindex_1.grate - 1] & OPENBT) != 0) { i = 25; } /* !OPEN? */ rspeak_(i); /* !DESCRIBE GRATE. */ return ret_val; /* R6-- CLEARING. DESCRIBE CLEARING, MOVE LEAVES. */ L6000: if (prsvec_1.prsa != vindex_1.lookw) { goto L6500; } /* !LOOK? */ rspeak_(27); /* !DESCRIBE. */ if (findex_1.rvclr == 0) { return ret_val; } /* !LEAVES MOVED? */ i = 28; /* !YES, ASSUME GRATE CLOSED. */ if ((objcts_1.oflag2[oindex_1.grate - 1] & OPENBT) != 0) { i = 29; } /* !OPEN? */ rspeak_(i); /* !DESCRIBE GRATE. */ return ret_val; L6500: if (findex_1.rvclr != 0 || (qhere_(oindex_1.leave, rindex_1.clear) && (prsvec_1.prsa != vindex_1.movew)) || prsvec_1.prso != oindex_1.leave) { return ret_val; } rspeak_(30); /* !MOVE LEAVES, REVEAL GRATE. */ findex_1.rvclr = 1; /* !INDICATE LEAVES MOVED. */ return ret_val; /* RAPPL1, PAGE 4 */ /* R7-- RESERVOIR SOUTH. DESCRIPTION DEPENDS ON LOW TIDE FLAG. */ L7000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ i = 31; /* !ASSUME FULL. */ if (findex_1.lwtidf) { i = 32; } /* !IF LOW TIDE, EMPTY. */ rspeak_(i); /* !DESCRIBE. */ rspeak_(33); /* !DESCRIBE EXITS. */ return ret_val; /* R8-- RESERVOIR. STATE DEPENDS ON LOW TIDE FLAG. */ L8000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ i = 34; /* !ASSUME FULL. */ if (findex_1.lwtidf) { i = 35; } /* !IF LOW TIDE, EMTPY. */ rspeak_(i); /* !DESCRIBE. */ return ret_val; /* R9-- RESERVOIR NORTH. ALSO DEPENDS ON LOW TIDE FLAG. */ L9000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ i = 36; /* !YOU GET THE IDEA. */ if (findex_1.lwtidf) { i = 37; } rspeak_(i); rspeak_(38); return ret_val; /* R10-- GLACIER ROOM. STATE DEPENDS ON MELTED, VANISHED FLAGS. */ L10000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(39); /* !BASIC DESCRIPTION. */ i = 0; /* !ASSUME NO CHANGES. */ if (findex_1.glacmf) { i = 40; } /* !PARTIAL MELT? */ if (findex_1.glacrf) { i = 41; } /* !COMPLETE MELT? */ rspeak_(i); /* !DESCRIBE. */ return ret_val; /* R11-- FOREST ROOM */ L11000: if (prsvec_1.prsa == vindex_1.walkiw) { cevent_1.cflag[cindex_1.cevfor - 1] = TRUE_; } /* !IF WALK IN, BIRDIE. */ return ret_val; /* R12-- MIRROR ROOM. STATE DEPENDS ON MIRROR INTACT. */ L12000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(42); /* !DESCRIBE. */ if (findex_1.mirrmf) { rspeak_(43); } /* !IF BROKEN, NASTY REMARK. */ return ret_val; /* RAPPL1, PAGE 5 */ /* R13-- CAVE2 ROOM. BLOW OUT CANDLES WITH 50% PROBABILITY. */ L13000: if (prsvec_1.prsa != vindex_1.walkiw) { return ret_val; } /* !WALKIN? */ if (prob_(50, 50) || objcts_1.oadv[oindex_1.candl - 1] != play_1.winner || ! ((objcts_1.oflag1[oindex_1.candl - 1] & ONBT) != 0)) { return ret_val; } objcts_1.oflag1[oindex_1.candl - 1] &= ~ ONBT; rspeak_(47); /* !TELL OF WINDS. */ cevent_1.cflag[cindex_1.cevcnd - 1] = FALSE_; /* !HALT CANDLE COUNTDOWN. */ return ret_val; /* R14-- BOOM ROOM. BLOW HIM UP IF CARRYING FLAMING OBJECT. */ L14000: j = objcts_1.odesc2[oindex_1.candl - 1]; /* !ASSUME CANDLE. */ if (objcts_1.oadv[oindex_1.candl - 1] == play_1.winner && ( objcts_1.oflag1[oindex_1.candl - 1] & ONBT) != 0) { goto L14100; } j = objcts_1.odesc2[oindex_1.torch - 1]; /* !ASSUME TORCH. */ if (objcts_1.oadv[oindex_1.torch - 1] == play_1.winner && ( objcts_1.oflag1[oindex_1.torch - 1] & ONBT) != 0) { goto L14100; } j = objcts_1.odesc2[oindex_1.match - 1]; if (objcts_1.oadv[oindex_1.match - 1] == play_1.winner && ( objcts_1.oflag1[oindex_1.match - 1] & ONBT) != 0) { goto L14100; } return ret_val; /* !SAFE */ L14100: if (prsvec_1.prsa != vindex_1.trnonw) { goto L14200; } /* !TURN ON? */ rspsub_(294, j); /* !BOOM */ /* ! */ jigsup_(44); return ret_val; L14200: if (prsvec_1.prsa != vindex_1.walkiw) { return ret_val; } /* !WALKIN? */ rspsub_(295, j); /* !BOOM */ /* ! */ jigsup_(44); return ret_val; /* R15-- NO-OBJS. SEE IF EMPTY HANDED, SCORE LIGHT SHAFT. */ L15000: findex_1.empthf = TRUE_; /* !ASSUME TRUE. */ i__1 = objcts_1.olnt; for (i = 1; i <= i__1; ++i) { /* !SEE IF CARRYING. */ if (objcts_1.oadv[i - 1] == play_1.winner) { findex_1.empthf = FALSE_; } /* L15100: */ } if (play_1.here != rindex_1.bshaf || ! lit_(play_1.here)) { return ret_val; } scrupd_(state_1.ltshft); /* !SCORE LIGHT SHAFT. */ state_1.ltshft = 0; /* !NEVER AGAIN. */ return ret_val; /* RAPPL1, PAGE 6 */ /* R16-- MACHINE ROOM. DESCRIBE MACHINE. */ L16000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ i = 46; /* !ASSUME LID CLOSED. */ if ((objcts_1.oflag2[oindex_1.machi - 1] & OPENBT) != 0) { i = 12; } /* !IF OPEN, OPEN. */ rspsub_(45, i); /* !DESCRIBE. */ return ret_val; /* R17-- BAT ROOM. UNLESS CARRYING GARLIC, FLY AWAY WITH ME... */ L17000: if (prsvec_1.prsa != vindex_1.lookw) { goto L17500; } /* !LOOK? */ rspeak_(48); /* !DESCRIBE ROOM. */ if (objcts_1.oadv[oindex_1.garli - 1] == play_1.winner) { rspeak_(49); } /* !BAT HOLDS NOSE. */ return ret_val; L17500: if (prsvec_1.prsa != vindex_1.walkiw || objcts_1.oadv[oindex_1.garli - 1] == play_1.winner) { return ret_val; } rspeak_(50); /* !TIME TO FLY, JACK. */ moveto_(bats_1.batdrp[rnd_(9)], play_1.winner); /* !SELECT RANDOM DEST. */ ret_val = FALSE_; /* !INDICATE NEW DESC NEEDED. */ return ret_val; /* R18-- DOME ROOM. STATE DEPENDS ON WHETHER ROPE TIED TO RAILING. */ L18000: if (prsvec_1.prsa != vindex_1.lookw) { goto L18500; } /* !LOOK? */ rspeak_(51); /* !DESCRIBE. */ if (findex_1.domef) { rspeak_(52); } /* !IF ROPE, DESCRIBE. */ return ret_val; L18500: if (prsvec_1.prsa == vindex_1.leapw) { jigsup_(53); } /* !DID HE JUMP??? */ return ret_val; /* R19-- TORCH ROOM. ALSO DEPENDS ON WHETHER ROPE TIED TO RAILING. */ L19000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(54); /* !DESCRIBE. */ if (findex_1.domef) { rspeak_(55); } /* !IF ROPE, DESCRIBE. */ return ret_val; /* R20-- CAROUSEL ROOM. SPIN HIM OR KILL HIM. */ L20000: if (prsvec_1.prsa != vindex_1.lookw) { goto L20500; } /* !LOOK? */ rspeak_(56); /* !DESCRIBE. */ if (! findex_1.caroff) { rspeak_(57); } /* !IF NOT FLIPPED, SPIN. */ return ret_val; L20500: if (prsvec_1.prsa == vindex_1.walkiw && findex_1.carozf) { jigsup_(58); } /* !WALKED IN. */ return ret_val; /* RAPPL1, PAGE 7 */ /* R21-- LLD ROOM. HANDLE EXORCISE, DESCRIPTIONS. */ L21000: if (prsvec_1.prsa != vindex_1.lookw) { goto L21500; } /* !LOOK? */ rspeak_(59); /* !DESCRIBE. */ if (! findex_1.lldf) { rspeak_(60); } /* !IF NOT VANISHED, GHOSTS. */ return ret_val; L21500: if (prsvec_1.prsa != vindex_1.exorcw) { return ret_val; } /* !EXORCISE? */ if (objcts_1.oadv[oindex_1.bell - 1] == play_1.winner && objcts_1.oadv[ oindex_1.book - 1] == play_1.winner && objcts_1.oadv[ oindex_1.candl - 1] == play_1.winner && (objcts_1.oflag1[ oindex_1.candl - 1] & ONBT) != 0) { goto L21600; } rspeak_(62); /* !NOT EQUIPPED. */ return ret_val; L21600: if (qhere_(oindex_1.ghost, play_1.here)) { goto L21700; } /* !GHOST HERE? */ jigsup_(61); /* !NOPE, EXORCISE YOU. */ return ret_val; L21700: newsta_(oindex_1.ghost, 63, 0, 0, 0); /* !VANISH GHOST. */ findex_1.lldf = TRUE_; /* !OPEN GATE. */ return ret_val; /* R22-- LLD2-ROOM. IS HIS HEAD ON A POLE? */ L22000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(64); /* !DESCRIBE. */ if (findex_1.onpolf) { rspeak_(65); } /* !ON POLE? */ return ret_val; /* R23-- DAM ROOM. DESCRIBE RESERVOIR, PANEL. */ L23000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(66); /* !DESCRIBE. */ i = 67; if (findex_1.lwtidf) { i = 68; } rspeak_(i); /* !DESCRIBE RESERVOIR. */ rspeak_(69); /* !DESCRIBE PANEL. */ if (findex_1.gatef) { rspeak_(70); } /* !BUBBLE IS GLOWING. */ return ret_val; /* R24-- TREE ROOM */ L24000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(660); /* !DESCRIBE. */ i = 661; /* !SET FLAG FOR BELOW. */ i__1 = objcts_1.olnt; for (j = 1; j <= i__1; ++j) { /* !DESCRIBE OBJ IN FORE3. */ if (! qhere_(j, rindex_1.fore3) || j == oindex_1.ftree) { goto L24200; } rspeak_(i); /* !SET STAGE, */ i = 0; rspsub_(502, objcts_1.odesc2[j - 1]); /* !DESCRIBE. */ L24200: ; } return ret_val; /* RAPPL1, PAGE 8 */ /* R25-- CYCLOPS-ROOM. DEPENDS ON CYCLOPS STATE, ASLEEP FLAG, MAGIC FLAG. */ L25000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(606); /* !DESCRIBE. */ i = 607; /* !ASSUME BASIC STATE. */ if (findex_1.rvcyc > 0) { i = 608; } /* !>0? HUNGRY. */ if (findex_1.rvcyc < 0) { i = 609; } /* !<0? THIRSTY. */ if (findex_1.cyclof) { i = 610; } /* !ASLEEP? */ if (findex_1.magicf) { i = 611; } /* !GONE? */ rspeak_(i); /* !DESCRIBE. */ if (! findex_1.cyclof && findex_1.rvcyc != 0) { i__1 = abs(findex_1.rvcyc) + 193; rspeak_(i__1); } return ret_val; /* R26-- BANK BOX ROOM. */ L26000: if (prsvec_1.prsa != vindex_1.walkiw) { return ret_val; } /* !SURPRISE HIM. */ for (i = 1; i <= 8; i += 2) { /* !SCOLRM DEPENDS ON */ if (screen_1.fromdr == screen_1.scoldr[i - 1]) { screen_1.scolrm = screen_1.scoldr[i]; } /* L26100: */ } /* !ENTRY DIRECTION. */ return ret_val; /* R27-- TREASURE ROOM. */ L27000: if (prsvec_1.prsa != vindex_1.walkiw || ! hack_1.thfact) { return ret_val; } if (objcts_1.oroom[oindex_1.thief - 1] != play_1.here) { newsta_(oindex_1.thief, 82, play_1.here, 0, 0); } hack_1.thfpos = play_1.here; /* !RESET SEARCH PATTERN. */ objcts_1.oflag2[oindex_1.thief - 1] |= FITEBT; if (objcts_1.oroom[oindex_1.chali - 1] == play_1.here) { objcts_1.oflag1[oindex_1.chali - 1] &= ~ TAKEBT; } /* VANISH EVERYTHING IN ROOM */ j = 0; /* !ASSUME NOTHING TO VANISH. */ i__1 = objcts_1.olnt; for (i = 1; i <= i__1; ++i) { if (i == oindex_1.chali || i == oindex_1.thief || ! qhere_(i, play_1.here)) { goto L27200; } j = 83; /* !FLAG BYEBYE. */ objcts_1.oflag1[i - 1] &= ~ VISIBT; L27200: ; } rspeak_(j); /* !DESCRIBE. */ return ret_val; /* R28-- CLIFF FUNCTION. SEE IF CARRYING INFLATED BOAT. */ L28000: findex_1.deflaf = objcts_1.oadv[oindex_1.rboat - 1] != play_1.winner; /* !TRUE IF NOT CARRYING. */ return ret_val; /* RAPPL1, PAGE 9 */ /* R29-- RIVR4 ROOM. PLAY WITH BUOY. */ L29000: if (! findex_1.buoyf || objcts_1.oadv[oindex_1.buoy - 1] != play_1.winner) { return ret_val; } rspeak_(84); /* !GIVE HINT, */ findex_1.buoyf = FALSE_; /* !THEN DISABLE. */ return ret_val; /* R30-- OVERFALLS. DOOM. */ L30000: if (prsvec_1.prsa != vindex_1.lookw) { jigsup_(85); } /* !OVER YOU GO. */ return ret_val; /* R31-- BEACH ROOM. DIG A HOLE. */ L31000: if (prsvec_1.prsa != vindex_1.digw || prsvec_1.prso != oindex_1.shove) { return ret_val; } ++findex_1.rvsnd; /* !INCREMENT DIG STATE. */ switch (findex_1.rvsnd) { case 1: goto L31100; case 2: goto L31100; case 3: goto L31100; case 4: goto L31400; case 5: goto L31500; } /* !PROCESS STATE. */ bug_(2, findex_1.rvsnd); L31100: i__1 = findex_1.rvsnd + 85; rspeak_(i__1); /* !1-3... DISCOURAGE HIM. */ return ret_val; L31400: i = 89; /* !ASSUME DISCOVERY. */ if ((objcts_1.oflag1[oindex_1.statu - 1] & VISIBT) != 0) { i = 88; } rspeak_(i); objcts_1.oflag1[oindex_1.statu - 1] |= VISIBT; return ret_val; L31500: findex_1.rvsnd = 0; /* !5... SAND COLLAPSES */ jigsup_(90); /* !AND SO DOES HE. */ return ret_val; /* R32-- TCAVE ROOM. DIG A HOLE IN GUANO. */ L32000: if (prsvec_1.prsa != vindex_1.digw || prsvec_1.prso != oindex_1.shove) { return ret_val; } i = 91; /* !ASSUME NO GUANO. */ if (! qhere_(oindex_1.guano, play_1.here)) { goto L32100; } /* !IS IT HERE? */ /* Computing MIN */ i__1 = 4, i__2 = findex_1.rvgua + 1; findex_1.rvgua = min(i__1,i__2); /* !YES, SET NEW STATE. */ i = findex_1.rvgua + 91; /* !GET NASTY REMARK. */ L32100: rspeak_(i); /* !DESCRIBE. */ return ret_val; /* R33-- FALLS ROOM */ L33000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(96); /* !DESCRIBE. */ i = 97; /* !ASSUME NO RAINBOW. */ if (findex_1.rainbf) { i = 98; } /* !GOT ONE? */ rspeak_(i); /* !DESCRIBE. */ return ret_val; /* RAPPL1, PAGE 10 */ /* R34-- LEDGE FUNCTION. LEDGE CAN COLLAPSE. */ L34000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(100); /* !DESCRIBE. */ i = 102; /* !ASSUME SAFE ROOM OK. */ if ((rooms_1.rflag[rindex_1.msafe - 1] & RMUNG) != 0) { i = 101; } rspeak_(i); /* !DESCRIBE. */ return ret_val; /* R35-- SAFE ROOM. STATE DEPENDS ON WHETHER SAFE BLOWN. */ L35000: if (prsvec_1.prsa != vindex_1.lookw) { return ret_val; } /* !LOOK? */ rspeak_(104); /* !DESCRIBE. */ i = 105; /* !ASSUME OK. */ if (findex_1.safef) { i = 106; } /* !BLOWN? */ rspeak_(i); /* !DESCRIBE. */ return ret_val; /* R36-- MAGNET ROOM. DESCRIBE, CHECK FOR SPINDIZZY DOOM. */ L36000: if (prsvec_1.prsa != vindex_1.lookw) { goto L36500; } /* !LOOK? */ rspeak_(107); /* !DESCRIBE. */ return ret_val; L36500: if (prsvec_1.prsa != vindex_1.walkiw || ! findex_1.caroff) { return ret_val; } /* !WALKIN ON FLIPPED? */ if (findex_1.carozf) { goto L36600; } /* !ZOOM? */ rspeak_(108); /* !NO, SPIN HIS COMPASS. */ return ret_val; L36600: i = 58; /* !SPIN HIS INSIDES. */ if (play_1.winner != aindex_1.player) { i = 99; } /* !SPIN ROBOT. */ jigsup_(i); /* !DEAD. */ return ret_val; /* R37-- CAGE ROOM. IF SOLVED CAGE, MOVE TO OTHER CAGE ROOM. */ L37000: if (findex_1.cagesf) { moveto_(rindex_1.cager, play_1.winner); } /* !IF SOLVED, MOVE. */ return ret_val; } /* rappl1_ */
integer nv2inirect_(integer *ifunc, integer *iparms) { /* System generated locals */ integer ret_val; char ch__1[4]; /* Builtin functions */ double pow_ri(real *, integer *), pow_di(doublereal *, integer *); integer i_indx(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer ipowdele, ipowdlin; static real r__; extern integer lit_(char *, ftnlen); static doublereal decc, drad; extern /* Character */ VOID clit_(char *, ftnlen, integer *); extern /* Subroutine */ int llopt_(doublereal *, doublereal *, integer *, integer *); static integer ipowecc, ipowrad, ipowlat, ipowlon; /* Degrees Per Line Power */ /* Degrees Per Element Power */ /* Degrees Radian power */ /* Eccentricity Power */ /* ,ULLON */ /* Parameter adjustments */ --iparms; /* Function Body */ if (*ifunc == 1) { if (iparms[1] != lit_("RECT", (ftnlen)4)) { goto L900; } rctcomrectnv2_1.itype = 1; rctcomrectnv2_1.xrow = (real) iparms[2]; ipowlat = iparms[12]; if (ipowlat == 0) { ipowlat = 4; } /* default is 10000 (10^4) */ rctcomrectnv2_1.zslat = iparms[3] / pow_ri(&c_b4, &ipowlat); /* REAL Latitude */ rctcomrectnv2_1.xcol = (real) iparms[4]; ipowlon = iparms[13]; if (ipowlon == 0) { ipowlon = 4; } rctcomrectnv2_1.zslon = iparms[5] / pow_ri(&c_b4, &ipowlon); /* REAL Longitude */ ipowdlin = iparms[14]; if (ipowdlin == 0) { ipowdlin = 4; } rctcomrectnv2_1.zdlat = iparms[6] / pow_ri(&c_b4, &ipowdlin); /* REAL Degrees_per_line_latitude */ ipowdele = iparms[15]; if (ipowdele == 0) { ipowdele = 4; } rctcomrectnv2_1.zdlon = iparms[7] / pow_ri(&c_b4, &ipowdele); /* REAL Degrees_per_line_longitude */ ipowrad = iparms[16]; if (ipowrad == 0) { ipowrad = 3; } drad = iparms[8] / pow_di(&c_b8, &ipowrad); /* REAL Radius of the planet in mete */ r__ = drad; ipowecc = iparms[17]; if (ipowecc == 0) { ipowecc = 6; } decc = iparms[9] / pow_di(&c_b8, &ipowecc); /* REAL Eccentricity */ rctcomrectnv2_1.iwest = iparms[11]; /* West positive vs. West negative */ if (rctcomrectnv2_1.iwest >= 0) { rctcomrectnv2_1.iwest = 1; } llopt_(&drad, &decc, &rctcomrectnv2_1.iwest, &iparms[10]); /* Initialze LLCART c */ if (rctcomrectnv2_1.xcol == 1.f) { /* special case of XCOL not located at ima */ rctcomrectnv2_1.zslon -= rctcomrectnv2_1.iwest * 180.f; /* -- so assume it's the left edge(duh) */ } } else if (*ifunc == 2) { clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) { rctcomrectnv2_1.itype = 1; } clit_(ch__1, (ftnlen)4, &iparms[1]); if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) { rctcomrectnv2_1.itype = 2; } } ret_val = 0; return ret_val; L900: ret_val = -1; return ret_val; } /* nv2inirect_ */