/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:59 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "sranr.h" #include /* PARAMETER translations */ #define M 97 #define MTWO (-2.0e0) /* end of PARAMETER translations */ /* COMMON translations */ struct t_rancs2 { float snums[M]; } rancs2; struct t_rancs1 { long int sptr; LOGICAL32 sgflag; } rancs1; /* end of COMMON translations */ float /*FUNCTION*/ sranr( float alpha) { float sranr_v; static LOGICAL32 first = TRUE; /* OFFSET Vectors w/subscript range: 1 to dimension */ float *const Snums = &rancs2.snums[0] - 1; /* end of OFFSET VECTORS */ /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1994-10-20 SRANR Krogh Changes to use M77CON *>> 1994-06-24 SRANR CLL Changed common to use RANC[D/S]1 & RANC[D/S]2. *>> 1992-03-16 CLL *>> 1991-11-26 CLL Reorganized common. Using RANCM[A/D/S]. *>> 1991-11-22 CLL Added call to RAN0, and SGFLAG in common. *>> 1991-01-15 CLL Reordered common contents for efficiency. *>> 1990-01-23 CLL Making names in common same in all subprogams. *>> 1987-04-22 SRANR Lawson Initial code. * Returns one pseudorandom number from the Rayleigh distribution * with parameter, ALPHA, which should be positive. * If U is random, uniform on [0, 1], the Rayleigh variable is given * by SRANR = ALPHA * sqrt(-2.0 * log(U)) * This variable has mean = ALPHA * sqrt(Pi/2) * and variance = (2 - Pi/2) * ALPHA**2 * Code based on subprogram written for JPL by Stephen L. Ritchie, * Heliodyne Corp. and Wiley R. Bunton, JPL, 1969. * Adapted to Fortran 77 for the JPL MATH77 library by C. L. Lawson & * S. Y. Chiu, JPL, Apr 1987. * ------------------------------------------------------------------ *--S replaces "?": ?RANR, ?RANUA, RANC?1, RANC?2, ?PTR, ?NUMS, ?GFLAG * RANCS1 and RANCS2 are common blocks. * Calls RAN0 to initialize SPTR and SGFLAG. * ------------------------------------------------------------------ */ /* ------------------------------------------------------------------ */ if (first) { first = FALSE; ran0(); } rancs1.sptr -= 1; if (rancs1.sptr == 0) { sranua( rancs2.snums, M ); rancs1.sptr = M; } sranr_v = alpha*sqrtf( MTWO*logf( Snums[rancs1.sptr] ) ); return( sranr_v ); } /* end of function */