* Program ALPHATEST (FORTRAN 77)
in [General Programming]
|
Prev: Python 1 , Lisp 0
Next: icanhaz.cnt 1-2-1 baby!
From: Terence on 11 Oct 2009 04:29 On Oct 11, 1:45 am, nos...(a)see.signature (Richard Maine) wrote: > Terence <tbwri...(a)cantv.net> wrote: > > [code elided] > > > You don't say why you are posting this. > > I'm puzzled by that one also that either. > > > It is not F77 code but F90 code (e.g. the use of KIND and > > status='unknown' and varibe names longer than 6 characters and > > comments defiened as an asterisk in column 1 instead of "C"). > > I see no usage of kind here. The real*8 syntax is not a kind parameter. > It is neither Fortran 77 nor Fortran 90, but instead is a common > nonstandard feature. Although the feature is common in both f77 and f90 > compilers, it is a feature associated more with f66 and f77 than with > f90 as it predates kind parameters. > > Status='unknown' and comments using an asterisk in column 1 are both > perfectly standard f77. If anything, the asterisk comment style is more > an f77 one than an f90 one, insomuch as it applies only to fixed source > form, which is even obsolescent as of f95. > > Variable names longer than 6 characters are indeed a feature new to the > standard as of f90, but they are one of the most common extensions out > there in f77 compilers. If one is going to be quite that strict about > the matter, one might also note the use of lower case as being a > similarly nonstandard feature in f77, along with the use of the @ > character, which isn't in the f77 character set. > > If I were going to get real picky about "legalisms", I'd probably note > that the "in Perpetuity" part of "All Rights Reserved in Perpetuity" > doesn't follow standards either, but that's a very different set of > standards from the Fortran ones. :-) > > > And no compiler I have used recently will accept a negative integer as > > a unit number > > There are several things here that no compiler of any vintage would > accept. I suppose it is vaguely possible that the consequent compilation > errors are supposed to be the question. Most of them are easy to miss in > a quick skim. I don't know whether this was posted here before throwing > it at a compiler or perhaps this was manually transcribed here or done > with OCR. For example, I see a missing parens in the statement before > 3500. And the format in 3500 just looks garbled in a wy I can't figure > out. I suspect the -7 unit number to be some kind of simillar > transcription error or typo, as positive 7 seems to be used later. > > -- > Richard Maine | Good judgment comes from experience; > email: last name at domain . net | experience comes from bad judgment. > domain: summertriangle | -- Mark Twain I have three F77 compilers (Burroughs, IBM and Microsoft). Fisrt problem was the cut-and paste operation via notepad inserted newline symbols in position 73. When these were cleared up the program still failed for what I also identified as did Richard, the incomplete copying, possible by OCR, from the origin of the source posted. Then there was the use of @ as a continuation symbol, (and in the wrong column) problems with zero indices to start a matrix and so on, mis-matched apostophy types, missing index brackets and more. I missed rhe valid asterisk use, as they all got translated to a windows-coded special symbol and not the hex 2A ascii symbol during the cut-and-paste and subsequent editing, and I was ignoring these errors, and globally fixed them, but noting yet another "error" type. Still, there were other problems that were just plain rejected. But by that point it was clear the code was no way near being of F77 origin. There may well be extended versions by some compiler vendors that allow some non-standard features to get by, but I doubt any accepts all of the usage claimed to be F77 code, even after removing the obvious errors. I admit I missed the zero index clincher because the error message assumed some other problem ("upper bound lower that lower bound"); and I didn't go back to read the original.
From: http://alexslemonade.org on 11 Oct 2009 10:00 * http://meami.org .compile0s0 * On Oct 11, 12:57 am, "robin" <robi...(a)bigpond.com> wrote: * > "Terence" <tbwri...(a)cantv.net> wrote in message * > * > news:5070296e-cce1-463d-a367- bbd717f73ddb(a)v15g2000prn.googlegroups.com... * > * > >You don't say why you are posting this. * > >It is not F77 code but F90 code (e.g. the use of KIND and * > >status='unknown' and varibe names longer than 6 characters and * > >comments defiened as an asterisk in column 1 instead of "C"). * > * > Looks like F77 to me. * > * was common in F77. * > * > >And no compiler I have used recently will accept a negative integer as * > >a unit number (perhaps this is permitted in some compilers of this * > >century). It may very well be be a compiler-specific trick to pass a * > >parameter to the open statement. I see the same positive unit numbers * > >are used later. * > * > Looks like a typo. * * It is not a typo. * * It was a morphism from a ctl+c ctl+v paste when posting. * * * I cleaned up and stripped the code. I hope this helps you make more sense of what it is it is * * * * designed to do. * M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie * Program ALPHATEST (FORTRAN 77) This program calculates values of the vapor fraction, given equilibrium ratios, Ki, and feed mole fractions, * zi. It can be used to reproduce experimental results of equilibrium flashes. ALPHATEST calls ALPHACOEFF, BUDAN, ALPHAPLOT, and * ALPHAROOT ALPHACOEFF calls subroutine SYMFUNCTION SYMFUNCTION calls subroutine DETERM and function FACTOR VARIABLES: alpha = calculated system vapor fraction beta = experimental system liquid fraction coefficient = coefficient of alpha polynomial Ki = equilibrium ratio for component i molefrac = feed mole fraction of component i Ncomp = number of components in feed * Npress = number of data sets to be evaluated Pi = system pressure, psia Ti = system temperature. F xalpha = experimental system vapor fraction It is formatted to input zi, temperature, pressure, liquid * mole fraction, and Ki IMPLICIT REAL*8(a-h,o-z) REAL*8 Ki(500,100),molefrac(0:100) PARAMETER(Npress= 16,Ncomp=l 10) DIMENSION alpha(500), beta(500), coefficient(0:100), @ Pi(500), Ti(500), tarray(2), xalpha(500) Data Input * The number of components (Ncomp) and the number of data sets to be run (Npress) are specified as PARAMETERs' * Open and Rewind Input and Output Files * OPEN(unit=1 ,file='indata',status= 'old') * OPEN(uniit=7,file='table',status:='unknown') * OPEN(unit=8,file= 'plot',status=-'unknown') * REWINlD(unit=1) * REWTND~unit=7) * REWIND(unit=8) * read(l,*) (znolefrac(i), i = 1, Ncornp) * do 1000 j = 1, Npress * read(1,*) (KiU,i), i = 1, Ncomp) * xalphaoj) = lIdO - betaoj) * 1000 continue * Choose between single or multiple runs * wrt(,)Taut n aast ne * write(6,*) 'Evaluate one data set? enter 1' * read(5,*) numsets * if(numsets EQ. 1) then * wnite(6,*) 'Enter number of data set for this run' * read(5,*) j * go to 2 100 * end if * do 2000 j = 1, Npress * 2100 write(7,*) * write(7,*) * write(7,*) 'RUN ' * write(6,*) 7J=- j * write(7,2500) Pioj),Tioj),betaoj) * 2500 formatCPressure = ',f6.1,' psia Temperature = ,f6.1,' F * @Liquid Mole Fraction = ',f6.4) * Call subroutines * Calculate coefficients of polynomial * call ALPHACOEFF(NcompNpressjmolefrac,Ki,coefficient) * Predict the number of roots on [0,11 by Fourier-Budan theorem * call BUDAN(jNcomp,coefficientnumroot) * Solve for the roots by Newton-Raphson method * call ALPHAROOT(j,Ncomp,coefficientxalphanumroot,alpha) * Generate various plots (EDIT the file to remove comments for specific * options) * call ALPHAPLOT(Ncompjjnolefac,alpha,coefficient, i) * ALPHAROOT has internal output section to compile a table * listing statistics on the determination of alpha * 2000 continue * Produce this format to plot data points as dots: * (PLOTFAT=20) * 2 * x(l) y(l) * x(I) y(l) * 2 * x(2) y(2) * x(2) y(2) * etc. * do 3000 j = 1, Npress * write(8,3500) alphao),xalpha(j),alpha(j),xalpha(j) * 3500 formnat('2 j,e 16.9,10x,el 6.9j,e 16.9,10x,e 16.9) * 3000 continue * CLOSE(unit=l) * CLOSE(unit=7) * CLOSE(unit=8) * stop * end M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie * SUBROUTINE ALPHACOEFF * This subroutine calculates the coefficient for each term in * the general polynomial for the vapor fraction, alpha: * P(alpha) = cO + cl*alpha + c2*alpha**2 + ... + * c(Ncomp- 1)*alpha**(Ncomp- 1) * Equation 4.29 in the thesis. * SUBROUTINE ALPHACOEFF(NcompNpressdjmolefrac,Ki,coefficient) * IMPLICIT REAL* 8(a-h,o-z) * REAL*8 Ki(500,100), molefrac(0:100) * INTEGER p * DIMENSION coefficient(0:100), c(100) * OPEN(unit= 14,f'de='coeff',status='unknown) * OPEN(unit= 15,file='coeff.plot',status='unknown') * if(Ncomp .LT. 2) then * write(6,*)You cannot flash this system' * stop * end if * Calculate Ci = Ki - 1 * do 0500 k = 1, Ncomp * c(k) = Ki(jjk) - 1.d00 * 0500 continue * p-loop increments the power of alpha * C write(15,*)Ncomp * do 1000 p = 1, Ncomp * temporary = 0.d00 * do 2000 j = 1, p * Zero-order elementary symmetric function, aO[l/Ci], defined as I * if(p-j EQ. 0) then * apj = 1.dO0 * go to 2500 * end if * Call subroutine to calculate the elementary symmetric * function, apj * call SYMFUNCTION(Ncompj,p,c,apj) * 2500 ratio = 0.dOO * do 3000 i = 1, Ncomp * ratio = ratio + molefrac(i)/(c(i)**(j-l)) * 3000 continue * temporary = temporary + ((-1.d0)**(j+l))*apj*ratio * 2000 continue * coefficient(Ncomp-p) = temporary * C write(14,*)'Coefficient(',Ncomp-p,') = ',coefficient(Ncomp-p) * C write( 15,*)Ncomp-p,coefficient(Ncomp-p) * 1000 continue * return * end M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie * SUBROUTINE SYMFUNCTION * This subroutine calculates the elementary symmetric function * a(p-j)( I/Ci) ***************************************i i*************************** * SUBROUTINE SYMFUNCTION(Ncompj,pc,apj) * IMPLICIT REAL*8(a-ho--z) * REAL*8 mmatrix(100,100) * INTEGER factor,p * DIMENSION c(100), s(100) * Compute the power-sum series: s = sigma[ (1/Ci)**lambda ] * n=p -j * do 100 lambda = 1, n * sum = O.dOO * do 2000 i = 1, Ncomp * sum = sum + (1.dO/c(i))**lambda * 2000 continue * s(lambda) = sum * 1000 continue * Build the matrix MMATRIX * do 3000 k = 1, n * do 4000 1 = 1, n * if(1 .LE. k) mmatrix(kj) = s(k-1+1) * if(1 .EQ. k+l) mmatrix(kl) = DFLOAT(k) * if(l .GT. k+l) mmatrix(k,l) = O.d00 * 4000 continue * 3000 continue * Since al(1/Ci) forms a [lxl] matrix, its determinant is the * element itself * if(p-j .EQ. 1) then * det = mmatrix(l,l) * go to 5000 * end if * Compute the determinant of MMATRIX * call DETERM(mmatrix,n,det) * Compute the elementary symmetric function * 5000 apj = det/factor(n) * return * end * Function to compute the factorial *********************************** * FUNCTION factor(n) * INTEGER factor,i,n * factor = 1 * if(n .GT. 0) then * do 6000 i - 2.n * factor - factor*i * 6000 continue * end if * end M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie * SUBROUTINE DETERM * This program calculates the determinant of an NxN matrix. * First, partial pivoting is performed on a nonsingular matrix by * Gaussian elimination. This produces a triangular matrix whose * determinant can be calculated by computing the product of all * the diagonal entries. * The augmented matrix does not contain the normal last column represents the right-hand side of a * system of linear * equations; AUG is the same as the original matrix. * VARIABLES: * N = dimension of matrix * AUG = augmented matrix * IJ,K = indices * MULT = multiplier used to eliminate an unknown * PIVOT = used to find nonzero diagonal entry * SUBROUTINE DETERM(aug,n,det) * IMPLICIT REAL*8(a-h,o-z) * REAL*8 mult * INTEGER pivot * DIMENSION aug(100,100) * Gaussian elimination * l n Ii|I * do 7000 i = 1, n * Locate nonzero entry * if(aug(i,i) .EQ. 0) then * pivot = 0 * j=i+ 1 * 3000 if((pivot .EQ. 0) .AND. (j .LE. n)) then * if(aug(j,i) .NE. 0) pivot = j * j=j+ 1 * go to 3000 * end if * if(pivot .EQ. 0) then * print *,'Matrix is singular' * stop * else * Interchange rows I and PIVOT * do 4000 j = i, n * temp = aug(ij) * aug(ij) = aug(pivotj) * aug(pivotj) = temp * 4000 continue * end if * end if * Eliminate l-th unknown from equations I+, .... N * do 6000 j = i+l1, n * mult = -aug(ji) / aug(i,i) * do 5000 k = i, n * aug(j,k) - aug(j,k) + mult * aug(ik) * 5000 continue * 6000 continue * 7000 continue * Calculate the determinant of matrix AUG by computing the * product of the diagonal elements * prod = EdO * do 8000 i = 1, n * 95 * do 9000 j = 1, n * if(i .EQ. j) prod = prod * aug(i,j) * 9000 continue * 8000 continue * det = prod * return * end M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie SUBROUTINE ALPHAROOT Subroutine uses an interval-halving technique to find * the best root value to initialize the Newton-Raphson (N-R) iterative calculaions which determine the real root of the alpha polynomial on the interval [0,11. PARAMETERS: delta = alpha increment epsilon = alpha convergence criterion VARIABLES: alower = lower bound of alpha increment aupper = upper bound of alpha increment falpha = the alpha polynomial fprime = first derivative of alpha polynomial guess = iterative variable for alpha guessO = initial estimate for N-R intcount = # of intervals until sign change iter = # of iterations until N-R converged isign,isign2 = flags for function sign change isign.isign2 = flags for function sign change numroot = flag for # of zeros (from BUDAN) * SUBROUTINE ALPHAROOT(j'NcomnpcoefficienLxalphanumroot, * @ alpha) * IMPLICIT REAL*8(a-h,o-z) * INTEGER p * DIMENSION alpha(500), coefficient(0:100), xalpha(500) * PARAMETER(delta = 0.01idO, epsilon = l.d--06) * Write table heading * write(7,*)Ihe Fourier-Budan Theorem yields ",numroot,' roots on * @this interval' * write(7,3500) * 3500 format('Intervals',4x, 'Initial Guess',4x,'Iterations', 4x,'Calc. * @Alpha',4x,Exp. Alpha') * Check flag NUMROOT provided by subroutine BUDAN to determine * root-search scheme * if(numroot EQ. 0) then * write(6,*) "No root on the interval [0,1] for data set "j * intcount = 0 * write(7,3900) intcount,xalpha(j) * 3900 format(i4,61 x,f5.3) * write(7,*)'No root on the interval [0,1]' * return * end if * if(nummot .EQ. 1) then * ilower = 0 * iupper = 0 * end if * if(numroot .GE. 2) then * ilower = 0 * iupper = 1 * end if * Use incremental search to determine initial guess * Interval Endpoint DO-Loop * do 0400 jroot = ilower, iupper * intcount = 0 * Test the polynomial at endpoint for initial sign value * ifjroot. EQ. lower) then * guess - DFLOAT(ilower) * alower = guess * aupper = alower + delta * end if * if(jroot. EQ. iupper) then * guess = DFLOAT(iupper) * aupper = guess * alower = aupper - delta * end if * ichange = 0 * 0600 falpha = O.dO * do 1500 p = 1, Ncomp * term = coefficient(Ncomp-p)*guess**(Ncomp-p) * if( (Ncomp-p) .EQ. 0 ) term = coefficient(0) * falpha = falpha + term * 1500 continue * Initialize ISIGN2 on first pass with endpoint * if(ichange .EQ. 0) then * if(falpha .GE. 0.) then * isign2 = 1 * else * isign2 = 0 * end if * end if * Note the sign of the function * if(falpha .GE. 0.) then * isign = I * else * isign = 0 * end if * Test function for sign change and increment or decrement the * search variable as appropriate * if(isign2 .EQ. isign) then * if(jroot .EQ. lower) then * alower = aupper * aupper = aupper + delta * guess = aupper * else ifjroot .EQ. iupper) then * aupper = alower * alower = aupper - delta * guess = alower * end if * end if * Exit subroutine if no sign change is detected on interval [0,1] * if( (guess .GT. 1.) .OR. (guess .LT. 0.) ) then * write(6,*) 'No root on the interval [0,1]" * write(7,3800) intcount,xalpha(j) * 3800 format(i4,61x,f5.3) * write(7,*)No root on the interval [0,1]' * return * end if * If NO sign change but still within interval, repeat the sequence * if(isign .EQ. isign2) then * isign2 = isign * intcount = intcount + 1 * ichange = I * go to 0600 * else * If there IS a sign change: * Halve the interval where the function crosses the x axis * guessO = (alower + aupper) / 2.dO * end if * Provide this guess to Newton-Raphson to begin calculations * guess = guessO * N-R is limited to 1000 iterations for convergence * iter = 0 * do 1000 iterlimit = 1, 1000 * iter = iter + I * falpha = O.d00 * fprime = 0.d00 * do 2000 p = 1, Ncomp * fapha = falpha + coefficient(Ncomp-p) * @ *guess**(Ncomp-p) * fprime = fprime + (Ncomp--p)*coefficient(Ncomp-p) * @ *guess**(Ncomp-p- 1) * 2000 continue * calc = guess - falpha/fprime * error = DABS((calc - guess)/calc) * guess =calc * if(erncr .LE. epsilon) go to 3000 * 1000 continue * print *,'N-R method failed to converge after 1000 iterations' * Output results to file "TABLE" * * 3000 write(7,3600) intcount,guess0,iter,guess,xalpha(j) * 3600 forrnat(i4,13x,f5.3,10x,i4,13xf9.6,7x,f5.3) * alpha(j) = guess * Begin search for root from opposite end of interval * 0400 continue * return * end M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie * SUBROUTINE ALPHAPLOT * * This subroutine is used for several purposes: * 1. Plotting F(alpha) vs alpha [Rachford-Rice obj function] * 2. Plotting F(alpha) vs alpha (polynomial] * 3. Plotting Fprime vs alpha [polynomial] * SUBROUTINE ALPHAPLOT(Ncompj,molefrac,alphacoefficient,Ki) * IMPLICIT REAL*8 (a-h,o-z) * REAL*8 Ki(500,100),molefrac(100) * DIMENSION alpha(500),coefficient(0:100) * INTEGER p * PARAMETER(start = 0.OdO, end = 2.OdO, stepsize = 0.0005d0) * OPEN(unit= 11 ,file=f'"a. plot ',status= 'unknown ) * OPEN(unit= 12,f ie= 'fprime .plot',status= 'unknown') * Number of data points for plotting * number = IDINT((end - start + stepsize)/stepsize) * F(alpha) vs alpha [polynomial] * F(alpha) vs alpha [polynomial] * Adjust Ncomp.Npress in PARAMETR * write(I1.*) number * do 1000 phase = start,end,stepsize * falpha = 0.dOO * fprime = 0.dOO * do 2000 p = I,Ncomp * falpha = faipha + coefficient(Ncomp-p)* * @ phase* *(Ncomp-p) * C fprine = fprime + (Ncomp-p)*coefficienINcomp-p)* * C @phase**(Ncomp-p-1) * 2000 continue * write(I 1,3600) phase ,falpha * C write(11,3600) phase/prime * 3600 fbrmat(f 7.3,2x,f25.12) * 1000 continue * C* Rachford-Rice objective function * C * C do 4500 k = I ,Npress * C k =6 * C write(11,*) number * C do 3000 phase = start,endstepsize * C falpha = 0400 * C do 4000 i = I Ncomp * C faipha = faipha + (molefrac(i)*(Ki(kJi) - 140))I * C @(1400O + phase*(Ki(k,i) - .d0)) * C* End of i loop * C 4000 continue * C * C write(]1,3500) phase/alpha * C 3500 formattl 7.25.12) * C* -End of phase loop * C 3000 continue * C* ~ End qofk loop * C 4500 continue * CLOSE(unit=11) * CLOSE(unit=12) * return * end M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie * SUBROUTINE BUDAN * Subroutine uses the Fourier-Budan Theorem to determipe * the number of roots that the alpha polynomial has on tn, * interval [u,v]. * , * PARAMETERS: iu = lower bound of alpha interval * iv = uppper bound of alpha interval * VARIABLES: coefficient = coefficient of alpha polynomial * dcoeff = coefficient of polynomial derivatives * deriv = derivatives of alpha polynomial * fvapor = the alpha polynomial * ia,ib = # of sign changes for derivative series * ivapor = alpha = vapor fraction * jsign,ksign = flags for derivative sign change * numroot = number of zeros on the interval * SUBROUTINE BUDAN(J,Ncomp,coefficientnwnroot) * IMPLICIT REAL*8(a--ho-z) * INTEGER p * DIMENSION dcoeff(0:100,0:100), coefficient(0:100), deriv(0:100) * PARAMETER(iu = 0, iv = 1) * C DATA (coefficient(l), I = ONcomp-l) /-j.,I.,-2.,3.,-4.,5. / * OPEN(unit=2,file="test",status= unknown) * REWIND(Unit=2) * ia = 0 * ib = 0 * do 0500 ivapor = iu, iv, 1 * Evaluate the polynomial function at the endpoints iu and iv * fvapor = OdO * do 0600 p = 1, Ncomp * fvapor = fvapor + coefficient(Ncomp-p)*ivapor**(Ncomp-p) * 0600 continue * write(2,*) fvapor = ",fvapor * write(2,*) - - * Calculate coefficients of first derivative * do 1000 n = Ncomp-1, 0, -1 * dcoeff(0,n) = coefficient(n) * write (2,*) "dcoeff(0,',n,') = ",dcoeff(0,n) * 1000 continue * write(2,*) " " * Calculate coefficients of 2nd- and higher-order derivatives * as multiples of those of the first derivative * do 1500 m = 1, Ncomp-I * do 2000 n = Ncomp-m, 1, -1 * dcoeff(mn-1) = n*dcoeff(m-l,n) * write (2,*) "dcoeff(',m,',n-1,) = ", * @dcoeff(m,n-1) * 2000 continue * write(2,*) " " * 1500 continue * Evaluate the derivative series at the endpoints iu and iv * do 3000 n = 1, Ncomp-1 * deriv(m) = 0.dO * do 4000 n = Ncomp-m, 1, -1 * term = dcoeff(m,n-1)*ivapor**(n-1) * if( (n-I) .EQ. 0 ) term = dcoeff(mn-1) * deriv(m) = deriv(m) + term * write(2,*) 'inter deriv(°,m, ") = ",deriv(m) * 4000 continue * write(2,*) 'total deriv(',m,) = ",deriv(m) * write(2,*) " " * 3000 continue * Count the sign changes between the terms of the series * if(fvapor. LT. 0.) then * ksign = 0 * else * ksign = 1 * end if * write(2,*) 1csign = ',ksign,' for fvapor' * do 5000 i = 1, Ncomp-l * if(deriv(i) .LT. 0.) then * jsign = 0 * else * jsign = 1 * end if * write(2,*) 'jsign = ',jsign,' for deriv(',i,T' * Increment A or B, depending upon the endpoint under evaluation * ifivapor EQ. iu) then * if(ksign .NE. jsign) then * ia = ia + I * write(2,*) 'ia = ',ia,' for deriv(',,' * end if * end if * ifivapor .EQ. iv) then * if(ksign .NE. jsign) then * ib = ib + I * write(2,*) -ib = -,ib,' for derivC',i,')' * end if * end if * ksign = jsign * write(2,*) lcsign = ',ksign,' after deriv(',i,2Y * write(2,*) * 5000 continue * 0500 continue * Pass a flag to calling program to indicate root conditions * write(2,*) 'ia =',ia,' and ib = 'ib * numroot = ia -ib * write(2,*) 'numroot = ',numroot * write(2,6000) Ncomp-I, numroot, iu, iv, J * 6* 000 formnat(This polynomial of order 'j3,' has 'i3,' zeros on the in * @terval [',i2,',ij2,'J for J = 'i3) * CLOSE(unit=2) * return * endAC_PROG_F77(fl32 f77 fort77 xlf g77 f90 xlf90) * #ifdef F77_DUMMY_MAIN * # ifdef __cplusplus * extern "C" * # endif * int F77_DUMMY_MAIN() { return 1; } * #endif * subroutine foobar(x,y) * double precision x, y * y = 3.14159 * x * return * end * #define FOOBAR_F77 F77_FUNC(foobar,FOOBAR) * #ifdef __cplusplus * extern "C" /* prevent C++ name mangling */ * #endif * void FOOBAR_F77(double *x, double *y); * * { * double x = 2.7183, y; * FOOBAR_F77(&x, &y); * } * * ===FORTRAN 77=== * After the release of the FORTRAN 66 standard, compiler vendors introduced a number of extensions * * * to "Standard Fortran", prompting ANSI in 1969 to begin work on revising the 1966 standard. * * * Final * * drafts of this revised standard circulated in 1977, leading to formal approval of the * * new * * * * FORTRAN * * standard in April 1978. The new standard, known as ''FORTRAN 77'', added * a number of * * * * * * significant * * features to address many of the shortcomings of FORTRAN 66: * * Block <code>IF</code> and <code>END IF</code> statements, with optional <code>ELSE</code> and * * * <code>ELSE IF</code> clauses, to provide improved language support for [[structured programming]] * DO loop extensions, including parameter expressions, negative increments, and zero trip counts * <code>OPEN</code>, <code>CLOSE</code>, and <code>INQUIRE</code> statements for improved I/O * * * * capability * Direct-access file I/O * <code>IMPLICIT</code> statement * <code>CHARACTER</code> data type, with vastly expanded facilities for character input and output * * and processing of character-based data * <code>PARAMETER</code> statement for specifying constants * <code>SAVE</code> statement for persistent local variables * Generic names for intrinsic functions * A set of intrinsics (<CODE>LGE, LGT, LLE, LLT</CODE>) for <U>lexical</U> comparison of strings, * * based upon the [[ASCII]] collating sequence. * : ''(ASCII functions were demanded by the U. S. [[United States Department of Defense|Department * * of * Defense]], in their conditional approval vote.) '' * * In this revision of the standard, a number of features were removed or altered in a manner that * * * might invalidate previously standard- conforming programs. ''(Removal was the only allowable alternative to X3J3 at that time, since the concept * * * * * * * * of "deprecation" was not yet available for ANSI standards.)'' * While most of the 24 items in the conflict list (see Appendix A2 of X3.9-1978) addressed loopholes * * or pathological cases permitted by the previous standard but rarely used, a small number of * * * * specific * capabilities were deliberately removed, such as: * [[Hollerith constant]]s and [[Herman Hollerith|Hollerith]] data, such as: * :: <TT> GREET = 12HHELLO THERE! </TT> * Reading into a H edit (Hollerith field) descriptor in a FORMAT specification. * Overindexing of array bounds by subscripts. * :: <CODE>DIMENSION A(10,5)</CODE> * :: <CODE>Y= A(11,1)</CODE> * Transfer of control into the range of a DO loop (also known as "Extended Range"). * * A * PROGRAM DBASE1 * INTEGER STOCK, NERR * REAL PRICE * CHARACTER NAME*10 * *Assume record length in storage units holding 4 chars each. * OPEN(UNIT=1, FILE='STOCKS', STATUS='OLD', * $ ACCESS='DIRECT', RECL=5) * 100 CONTINUE * *Ask user or part number which will be used as record number. * WRITTE(UNIT=*,FMT=*)'Enter part number (or zero to quit): * READ(UNIT=*,FMT=*) NPART * IF(NPART .LE. 0) STOP * READ(UNIT=1, REC=NPART, IOSTAT=NERR) NAME, STOCK, PRICE * IF(NERR .NE. 0) THEN * WRITE(UNIT=*, FMT=*)'Unknown part number, re-enter' * GO TO 100 * END IF * WRITE(*,115)STOCK, NAME, PRICE * 115 FORMAT(1X,'Stock is', I4, 1X, A,' at=@ ', F8.2, ' each') * GOT TO 100 * END * Stock is 144 widgets @ $555.55 []= http://meami.org * n important practical extension to FORTRAN 77 was the release of MIL- STD-1753 in 1978. This * * * * * specification, developed by the U. S. [[United States Department of Defense|Department of * * * * * Defense]], * standardized a number of features implemented by most FORTRAN 77 compilers but not* * * included in the * * ANSI FORTRAN 77 standard. These features would eventually be incorporated * * into * the Fortran 90 * * * * standard. * * <code>DO WHILE</code> and <code>END DO</code> statements * <code>INCLUDE</code> statement * <code>IMPLICIT NONE</code> variant of the <code>IMPLICIT</code> statement * [[Bit manipulation]] intrinsic functions, based on similar functions included in [[Industrial Real-* Time Fortran|Industrial Real-Time Fortran (ANSI/ISA S61.1 (1976))]] * * The [[Institute of Electrical and Electronics Engineers|IEEE]] 1003.9 [[POSIX]] Standard, released * * in 1991, provided a simple means for Fortran-77 programmers to issue POSIX system calls. Over * * 100 * * calls were defined in the document allowing access to POSIX-compatible process control, * * signal * * * handling, file system control, device control, procedure pointing, and stream I/O in * a * portable * * * manner. * * The development of a revised standard to succeed FORTRAN 77 would be repeatedly delayed as the * * * * standardization process struggled to keep up with rapid changes in computing and programming * * * * * practice. In the meantime, as the "Standard FORTRAN" for nearly fifteen years, FORTRAN 77 * * * would * * * become the historically most important dialect. * * [[Control Data Corporation]] computers had another version of FORTRAN 77, called Minnesota * * * * * FORTRAN, * * with variations in output constructs, special uses of COMMONs and DATA statements, * * * optimizations * * * code levels for compiling, and detailed error listings, extensive warning * * * * messages, and * * * * * * * debugs.<ref>* [http://www.chilton-* * * * * * * * * * * * * * * * * * * computing.org.uk/acd/literature/reports/p008.htm Chilton * * * * * Computing * with FORTRAN]* * * * </ref> * M. MICHAEL MUSATOV Computer Engineering Section Data Mining Engineering Department * College of Earth The State University * Universal City. Caliornia M.S. thesis Copywrite=(C) 2009. Copyright. All Rights Reserved. http://meami.org 'Search for the People!' Advisor. Dr. Walter C. Christie Support a cure for childhood cancer http://AlexsLemonade.org
From: Ron Shepard on 11 Oct 2009 14:54 In article <sdgAm.46778$ze1.16540(a)news-server.bigpond.net.au>, "robin" <robin_v(a)bigpond.com> wrote: > >And no compiler I have used recently will accept a negative integer as > >a unit number (perhaps this is permitted in some compilers of this > >century). I have used several f77 compilers that preconnected specific negative unit numbers to stdin, stdout, and stderr. This was fairly common starting in the 1980's. I don't think you could use negative unit numbers in general (e.g. in open statements), but these preconnected units were treated differently. Also, it was not very portable, one compiler might use 0, -1, and -2 while another might use -1, -2, and -3. I'm assuming here that the 1980's was last century. If by the last century you mean before 1909, then that is a different matter. :-) > It may very well be be a compiler-specific trick to pass a > >parameter to the open statement. I see the same positive unit numbers > >are used later. > > Looks like a typo. In this case that is probably right, a typo or an OCR error. $.02 -Ron Shepard
From: robin on 12 Oct 2009 10:28 "Ron Shepard" <ron-shepard(a)NOSPAM.comcast.net> wrote in message news:ron-shepard-11D286.13540211102009(a)forte.easynews.com... | In article <sdgAm.46778$ze1.16540(a)news-server.bigpond.net.au>, | "robin" <robin_v(a)bigpond.com> wrote: "Terence" <tbwright(a)cantv.net> wrote in message news:5070296e-cce1-463d-a367-bbd717f73ddb(a)v15g2000prn.googlegroups.com... | > >And no compiler I have used recently will accept a negative integer as | > >a unit number (perhaps this is permitted in some compilers of this | > >century). | | I have used several f77 compilers that preconnected specific | negative unit numbers to stdin, stdout, and stderr. This was fairly | common starting in the 1980's. I don't think you could use negative | unit numbers in general (e.g. in open statements), but these | preconnected units were treated differently. Also, it was not very | portable, one compiler might use 0, -1, and -2 while another might | use -1, -2, and -3. The common numbers were 1, 2, and 3 and 5, and 6. | I'm assuming here that the 1980's was last century. If by the last | century you mean before 1909, then that is a different matter. :-) In omitting the poster, you have confused who sent what. I did not say that; it was Terence (whose POST ID I have restored). | > It may very well be be a compiler-specific trick to pass a | > >parameter to the open statement. I see the same positive unit numbers | > >are used later. | > | > Looks like a typo. | | In this case that is probably right, a typo or an OCR error.
From: Terence on 12 Oct 2009 20:26
No, Terence was not the poster of the sourcecode ([LINK] == http://www.meami.org), but comenting on: first the original posting, then on the comments about Terence's (my) comments, then we comments on the above comments. Are you still with me? Sorry, but I am stuck with Google access and the quirks of waht happens if you cut anything, or answer before a opposed to after the original positied lines. Hey-ho. Anyway, to me, the "last century" is 1900 plus any two digits between 00 and 99. If you need my rememberances of pre 1900, I doh't recall many (>=0). |