- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
call diagnos ('Can only have ONE forest', 'w', *100)
This comes from some code developed by a good programmer -- but I have never seen *100 before, I do not even know where in the documentation to look for it.
help
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
"Alternate returns", see https://software.intel.com/content/www/us/en/develop/documentation/fortran-compiler-developer-guide-and-reference/top/language-reference/program-units-and-procedures/argument-association-in-procedures/alternate-return-arguments.html , and please forget that they existed.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I was looking for a bit of background on some parts of this old Fortran program when I ran across this statement
When Fourier submitted a later competition essay in 1811, the committee (which included Lagrange, Laplace, Malus and Legendre, among others) concluded: ...the manner in which the author arrives at these equations is not exempt of difficulties and...his analysis to integrate them still leaves something to be desired on the score of generality and even rigour.
Even Fourier was criticized.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Also discussed in Doctor Fortran in “Lest Old Acquaintance Be Forgot” (among other obscure features from days gone by)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
FORTRAN 77 Version 1.30g
I found this note in the code -- any idea where it comes from?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Alternate returns were a vendor-dependent extension before F77, so I remember them only as something which had to be fixed before a program could work.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Are you saying I have to fix them, there are _________ hundreds of them.
As I go through the code -- it appears to be written for Unix - mainframe at a UNI.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
No, most Fortran compilers (Ifort, certainly) accept and process alternate returns. The presence of alternate returns may become an issue if you attempt to make substantial modifications to the code.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Nichols, John wrote:Are you saying I have to fix them, there are _________ hundreds of them.
As I go through the code -- it appears to be written for Unix - mainframe at a UNI.
See this thread in a post at comp.lang.fortran, the other forum that may be worth a consideration for @Nichols, John for general Fortran-related posts.
On alternate returns, as I state there in the context of the Fortran standard, it is "part of the current standard even as the standard marks it an obsolescent feature."
So one doesn't need to necessarily "fix" the code simply on account of the presence of this feature. Any change to the code will be better driven by a plan and design at refactoring the code with a goal toward modernization.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you -- I am not trying to make changes to the code, I am just trying to see it running so I can look at the algorithms.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
mwindham wrote:https://software.intel.com/content/www/us/en/develop/blogs/doctor-fortra...
Please make note of the new "office" for Doctor Fortran: https://stevelionel.com/drfortran
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
! !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++72 ! subroutine sclmld(n,s,v,z) implicit double precision (a-h,o-z) dimension v(n),z(n) do 100 i=1,n z(i)=s*v(i) 100 continue return end
Ok so do I laugh or fix it.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
! !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++72 ! double precision function d1mach(i) !***begin prologue d1mach !***date written 750101 (yymmdd) !***revision date 831014 (yymmdd) !***category no. r1 !***keywords machine constants !***author fox, p. a., (bell labs) ! hall, a. d., (bell labs) ! schryer, n. l., (bell labs) !***purpose returns double precision machine dependent constants !!!!description ! from the book, "numerical methods and software" by ! d. kahaner, c. moler, s. nash ! prentice hall, 1988 ! ! ! d1mach can be used to obtain machine-dependent parameters ! for the local machine environment. it is a function ! subprogram with one (input) argument, and can be called ! as follows, for example ! ! d = d1mach(i) ! ! where i=1,...,5. the (output) value of d above is ! determined by the (input) value of i. the results for ! various values of i are discussed below. ! ! double-precision machine constants ! d1mach( 1) = b!!(emin-1), the smallest positive magnitude. ! d1mach( 2) = b**emax*(1 - b**(-t)), the largest magnitude. ! d1mach( 3) = b**(-t), the smallest relative spacing. ! d1mach( 4) = b**(1-t), the largest relative spacing. ! d1mach( 5) = log10(b) !***references fox p.a., hall a.d., schryer n.l.,*framework for a ! portable library*, acm transactions on mathematical ! software, vol. 4, no. 2, june 1978, pp. 177-188. !***routines called xerror !***end prologue d1mach ! integer small(4) integer large(4) integer right(4) integer diver(4) integer log10(4) ! double precision dmach(5) ! equivalence (dmach(1),small(1)) equivalence (dmach(2),large(1)) equivalence (dmach(3),right(1)) equivalence (dmach(4),diver(1)) equivalence (dmach(5),log10(1)) ! save ! ! ! machine constants for the cdc cyber 170 series (ftn5). ! ! data small(1) / o"00604000000000000000" / ! data small(2) / o"00000000000000000000" / ! ! data large(1) / o"37767777777777777777" / ! data large(2) / o"37167777777777777777" / ! ! data right(1) / o"15604000000000000000" / ! data right(2) / o"15000000000000000000" / ! ! data diver(1) / o"15614000000000000000" / ! data diver(2) / o"15010000000000000000" / ! ! data log10(1) / o"17164642023241175717" / ! data log10(2) / o"16367571421742254654" / ! ! machine constants for the cdc cyber 200 series ! ! data small(1) / x'9000400000000000' / ! data small(2) / x'8fd1000000000000' / ! ! data large(1) / x'6fff7fffffffffff' / ! data large(2) / x'6fd07fffffffffff' / ! ! data right(1) / x'ff74400000000000' / ! data right(2) / x'ff45000000000000' / ! ! data diver(1) / x'ff75400000000000' / ! data diver(2) / x'ff46000000000000' / ! ! data log10(1) / x'ffd04d104d427de7' / ! data log10(2) / x'ffa17de623e2566a' / ! ! ! machine constants for the cdc 6000/7000 series. ! ! data small(1) / 00564000000000000000b / ! data small(2) / 00000000000000000000b / ! ! data large(1) / 37757777777777777777b / ! data large(2) / 37157777777777777777b / ! ! data right(1) / 15624000000000000000b / ! data right(2) / 00000000000000000000b / ! ! data diver(1) / 15634000000000000000b / ! data diver(2) / 00000000000000000000b / ! ! data log10(1) / 17164642023241175717b / ! data log10(2) / 16367571421742254654b / ! ! machine constants for the cray 1 ! ! data small(1) / 201354000000000000000b / ! data small(2) / 000000000000000000000b / ! ! data large(1) / 577767777777777777777b / ! data large(2) / 000007777777777777774b / ! ! data right(1) / 376434000000000000000b / ! data right(2) / 000000000000000000000b / ! ! data diver(1) / 376444000000000000000b / ! data diver(2) / 000000000000000000000b / ! ! data log10(1) / 377774642023241175717b / ! data log10(2) / 000007571421742254654b / ! ! ! machine constants for the ibm 360/370 series, ! the xerox sigma 5/7/9, the sel systems 85/86, and ! the perkin elmer (interdata) 7/32. ! ! data small(1),small(2) / z00100000, z00000000 / ! data large(1),large(2) / z7fffffff, zffffffff / ! data right(1),right(2) / z33100000, z00000000 / ! data diver(1),diver(2) / z34100000, z00000000 / ! data log10(1),log10(2) / z41134413, z509f79ff / ! ! machine constatns for the ibm pc family (d. kahaner nbs) ! !ibm data dmach/2.23d-308,1.79d+308,1.11d-16,2.22d-16, !ibm ! 0.301029995663981195d0/ ! ! For Macintosh 68000 series chip ! data dmach/1.0d-300,1.0d+300,1.0d-16,2.0d-16, 0.301029995663981195d0/ ! ! machine constants for the pdp-10 (ka processor). ! ! data small(1),small(2) / "033400000000, "000000000000 / ! data large(1),large(2) / "377777777777, "344777777777 / ! data right(1),right(2) / "113400000000, "000000000000 / ! data diver(1),diver(2) / "114400000000, "000000000000 / ! data log10(1),log10(2) / "177464202324, "144117571776 / ! ! machine constants for the pdp-10 (ki processor). ! ! data small(1),small(2) / "000400000000, "000000000000 / ! data large(1),large(2) / "377777777777, "377777777777 / ! data right(1),right(2) / "103400000000, "000000000000 / ! data diver(1),diver(2) / "104400000000, "000000000000 / ! data log10(1),log10(2) / "177464202324, "476747767461 / ! ! ! machine constants for the sun-3 (includes those with 68881 chip, ! or with fpa board. also includes sun-2 with sky board. may also ! work with software floating point on either system.) ! ! data small(1),small(2) / x'00100000', x'00000000' / ! data large(1),large(2) / x'7fefffff', x'ffffffff' / ! data right(1),right(2) / x'3ca00000', x'00000000' / ! data diver(1),diver(2) / x'3cb00000', x'00000000' / ! data log10(1),log10(2) / x'3fd34413', x'509f79ff' / ! ! ! machine constants for vax 11/780 ! (expressed in integer and hexadecimal) ! !!! the integer format should be ok for unix systems*** ! ! data small(1), small(2) / 128, 0 / ! data large(1), large(2) / -32769, -1 / ! data right(1), right(2) / 9344, 0 / ! data diver(1), diver(2) / 9472, 0 / ! data log10(1), log10(2) / 546979738, -805796613 / ! ! !**the hex format below may not be suitable for unix sysyems*** ! data small(1), small(2) / z00000080, z00000000 / ! data large(1), large(2) / zffff7fff, zffffffff / ! data right(1), right(2) / z00002480, z00000000 / ! data diver(1), diver(2) / z00002500, z00000000 / ! data log10(1), log10(2) / z209a3f9a, zcff884fb / ! ! machine constants for vax 11/780 (g-floating) ! (expressed in integer and hexadecimal) ! !** the integer format should be ok for unix systems*** ! ! data small(1), small(2) / 16, 0 / ! data large(1), large(2) / -32769, -1 / ! data right(1), right(2) / 15552, 0 / ! data diver(1), diver(2) / 15568, 0 / ! data log10(1), log10(2) / 1142112243, 2046775455 / ! ! !!*the hex format below may not be suitable for unix sysyems*** ! data small(1), small(2) / z00000010, z00000000 / ! data large(1), large(2) / zffff7fff, zffffffff / ! data right(1), right(2) / z00003cc0, z00000000 / ! data diver(1), diver(2) / z00003cd0, z00000000 / ! data log10(1), log10(2) / z44133ff3, z79ff509f / ! ! !***first executable statement d1mach if (i .lt. 1 .or. i .gt. 5) 1 call diagnos('d1mach --&i out of bounds','f',*901) ! d1mach = dmach(i) 901 return * end c c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++72 c subroutine xerror(messg,nmessg,nerr,level) ****begin prologue xerror ****date written 790801 (yymmdd) ****revision date 870930 (yymmdd) ****category no. r3c ****keywords error,xerror package ****author jones, r. e., (snla) ****purpose processes an error (diagnostic) message. ****description * from the book "numerical methods and software" * by d. kahaner, c. moler, s. nash * prentice hall 1988 * abstract * xerror processes a diagnostic message. it is a stub routine * written for the book above. actually, xerror is a sophisticated * error handling package with many options, and is described * in the reference below. our version has the same calling sequence * but only prints an error message and either returns (if the * input value of abs(level) is less than 2) or stops (if the * input value of abs(level) equals 2). * * description of parameters * --input-- * messg - the hollerith message to be processed. * nmessg- the actual number of characters in messg. * (this is ignored in this stub routine) * nerr - the error number associated with this message. * nerr must not be zero. * (this is ignored in this stub routine) * level - error category. * =2 means this is an unconditionally fatal error. * =1 means this is a recoverable error. (i.e., it is * non-fatal if xsetf has been appropriately called.) * =0 means this is a warning message only. * =-1 means this is a warning message which is to be * printed at most once, regardless of how many * times this call is executed. * (in this stub routine * level=2 causes a message to be printed and then a * stop. * level<2 causes a message to be printed and then a * return. * * examples * call xerror('smooth -- num was zero.',23,1,2) * call xerror('integ -- less than full accuracy achieved.', * 43,2,1) * call xerror('rooter -- actual zero of f found before interval f * 1ully collapsed.',65,3,0) * call xerror('exp -- underflows being set to zero.',39,1,-1) * ****references jones r.e., kahaner d.k., "xerror, the slatec error- * handling package", sand82-0800, sandia laboratories, * 1982. ****routines called xerrwv ****end prologue xerror character*(*) messg ****first executable statement xerror call xerrwv(messg,nmessg,nerr,level,0,0,0,0,0.,0.) return end c c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++72 c subroutine xerrwv(messg,nmessg,nerr,level,ni,i1,i2,nr,r1,r2) ****begin prologue xerrwv ****date written 800319 (yymmdd) ****revision date 870930 (yymmdd) ****category no. r3c ****keywords error,xerror package ****author jones, r. e., (snla) ****purpose processes error message allowing 2 integer and two real * values to be included in the message. ****description * from the book "numerical methods and software" * by d. kahaner, c. moler, s. nash * prentice hall 1988 * abstract * xerrwv prints a diagnostic error message. * in addition, up to two integer values and two real * values may be printed along with the message. * a stub routine for the book above. the actual xerrwv is described * in the reference below and contains many other options. * * description of parameters * --input-- * messg - the hollerith message to be processed. * nmessg- the actual number of characters in messg. * (ignored in this stub) * nerr - the error number associated with this message. * nerr must not be zero. * (ignored in this stub) * level - error category. * =2 means this is an unconditionally fatal error. * =1 means this is a recoverable error. (i.e., it is * non-fatal if xsetf has been appropriately called.) * =0 means this is a warning message only. * =-1 means this is a warning message which is to be * printed at most once, regardless of how many * times this call is executed. * (in this stub level=2 causes an error message to be * printed followed by a stop, * level<2 causes an error message to be * printed followed by a return.) * ni - number of integer values to be printed. (0 to 2) * i1 - first integer value. * i2 - second integer value. * nr - number of real values to be printed. (0 to 2) * r1 - first real value. * r2 - second real value. * * examples * call xerrwv('smooth -- num (=i1) was zero.',29,1,2, * 1 1,num,0,0,0.,0.) * call xerrwv('quadxy -- requested error (r1) less than minimum ( * 1r2).,54,77,1,0,0,0,2,errreq,errmin) * ****references jones r.e., kahaner d.k., "xerror, the slatec error- * handling package", sand82-0800, sandia laboratories, * 1982. ****routines called (none) ****end prologue xerrwv character*(*) messg ****first executable statement xerrwv write(*,*) messg if(ni.eq.2)then write(*,*) i1,i2 elseif(ni.eq.1) then write(*,*) i1 endif if(nr.eq.2) then write(*,*) r1,r2 elseif(nr.eq.1) then write(*,*) r1 endif if(abs(level).lt.2)return stop end
This is a new one on me -- how do I fix it for Intel Fortran?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The only problem I see is that line 147 (DATA) is longer than 72 characters. It needs proper continuation.
Are you getting some other error?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You can write versions of d1mach, r1mach and i1mach that use the newer intrinsics in F90 and later.
function i1mach(i) result(s) implicit none integer*4 :: i,s,im(10) data im/5,6,7,6,32,4,2,31,2147483647,2/ if(i.lt.1.or.i.gt.10)stop 'I1MACH(arg < 1 or arg > 10)' s=im(i) return end function i1mach function r1mach(i) result(s) implicit none integer i real s,rm(5) logical :: beg = .true. save rm if(i.lt.1.or.i.gt.5)stop 'R1MACH(arg < 1 or arg > 5)' if(beg)then beg=.false. rm(1) = tiny(0.0) rm(2) = huge(0.0) rm(3) = epsilon(0.0)/2 rm(4) = epsilon(0.0) rm(5) = log10(2.0) end if s = rm(i) return end function r1mach function d1mach(i) result(s) implicit none integer i double precision s,dm(5) logical :: beg = .true. save dm if(i.lt.1.or.i.gt.5)stop 'D1MACH(arg < 1 or arg > 5)' if(beg)then beg=.false. dm(1) = tiny(0.0d0) dm(2) = huge(0.0d0) dm(3) = epsilon(0.0d0)/2 dm(4) = epsilon(0.0d0) dm(5) = log10(2.0d0) end if s = dm(i) return end function d1mach
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks. The program is written as a DF and Powerstation Windows program using Winmain.
I just want the bare bones algorithms, so unwinding the stuff that is really not needed is not fun.
I have tried Winmain programming and do not like it -- I just do analysis not pretty windows.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
string = '"'//optfile(1:nchars(optfile))//'" is not an options file'
I have not seen nchars before, it throws an error so I assume it is an old len??
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
mecej4 (Blackbelt) wrote:You can write versions of d1mach, r1mach and i1mach that use the newer intrinsics in F90 and later. ..
Considering the calendar with nearly 30 years post Fortran 90 standard revision, should anyone be rewriting any old code they should consider current Fortran standard and look into using named constant facility and intrinsics as much as possible:
module machine_constants_m integer, parameter :: SP = kind(1.0) integer, parameter :: DP = kind(1D0) real(SP), parameter :: SP2 = 2.0_sp real(DP), parameter :: DP2 = 2.0_dp integer, parameter :: i1mach(*) = [ 5, 6, 7, 6, 32, 4, 2, 31, 2147483647, 2 ] real(SP), parameter :: r1mach(*) = [ tiny(SP2), huge(SP2), epsilon(SP2)/SP2, epsilon(SP2), log10(SP2) ] real(DP), parameter :: d1mach(*) = [ tiny(DP2), huge(DP2), epsilon(DP2)/DP2, epsilon(DP2), log10(DP2) ] end module
Most end-users won't care or notice the difference whether they consume the "values" as constants or as function invocations, but the former should be preferable as compile-time constants:
C:\temp>type p.f90 module machine_constants_m integer, parameter :: SP = kind(1.0) integer, parameter :: DP = kind(1D0) real(SP), parameter :: SP2 = 2.0_sp real(DP), parameter :: DP2 = 2.0_dp integer, parameter :: i1mach(*) = [ 5, 6, 7, 6, 32, 4, 2, 31, 2147483647, 2 ] real(SP), parameter :: r1mach(*) = [ tiny(SP2), huge(SP2), epsilon(SP2)/SP2, epsilon(SP2), log10(SP2) ] real(DP), parameter :: d1mach(*) = [ tiny(DP2), huge(DP2), epsilon(DP2)/DP2, epsilon(DP2), log10(DP2) ] end module module machine_functions_m implicit none contains function i1mach(i) result(s) integer*4 :: i,s,im(10) data im/5,6,7,6,32,4,2,31,2147483647,2/ if(i.lt.1.or.i.gt.10)stop 'I1MACH(arg < 1 or arg > 10)' s=im(i) return end function i1mach function r1mach(i) result(s) integer i real s,rm(5) logical :: beg = .true. save rm if(i.lt.1.or.i.gt.5)stop 'R1MACH(arg < 1 or arg > 5)' if(beg)then beg=.false. rm(1) = tiny(0.0) rm(2) = huge(0.0) rm(3) = epsilon(0.0)/2 rm(4) = epsilon(0.0) rm(5) = log10(2.0) end if s = rm(i) return end function r1mach function d1mach(i) result(s) integer i double precision s,dm(5) logical :: beg = .true. save dm if(i.lt.1.or.i.gt.5)stop 'D1MACH(arg < 1 or arg > 5)' if(beg)then beg=.false. dm(1) = tiny(0.0d0) dm(2) = huge(0.0d0) dm(3) = epsilon(0.0d0)/2 dm(4) = epsilon(0.0d0) dm(5) = log10(2.0d0) end if s = dm(i) return end function d1mach end module blk1: block use machine_constants_m, only : i1mach, r1mach, d1mach print *, "Block 1: With named constants:" print *, "i1mach(9) = ", i1mach(9) print *, "r1mach(3) = ", r1mach(3) print *, "d1mach(3) = ", d1mach(3) end block blk1 print * blk2: block use machine_functions_m, only : i1mach, r1mach, d1mach print *, "Block 2: With run-time functions:" print *, "i1mach(9) = ", i1mach(9) print *, "r1mach(3) = ", r1mach(3) print *, "d1mach(3) = ", d1mach(3) end block blk2 end C:\temp>ifort /standard-semantics /warn:all /stand:f18 p.f90 -o p.exe Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.1.216 Build 20200306 Copyright (C) 1985-2020 Intel Corporation. All rights reserved. p.f90(22): warning #6916: Fortran 2018 does not allow this length specification. [4] integer*4 :: i,s,im(10) --------------^ Microsoft (R) Incremental Linker Version 14.25.28612.0 Copyright (C) Microsoft Corporation. All rights reserved. -out:p.exe -subsystem:console p.obj C:\temp>p.exe Block 1: With named constants: i1mach(9) = 2147483647 r1mach(3) = 5.9604645E-08 d1mach(3) = 1.110223024625157E-016 Block 2: With run-time functions: i1mach(9) = 2147483647 r1mach(3) = 5.9604645E-08 d1mach(3) = 1.110223024625157E-016 C:\temp>
And some user(s) will appreciate when they try to access a value outside the supported range and the compile-time check with named constants approach helps resolve the issue sooner rather than getting into a run-time error.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I agree with you -- this has been interesting -- my minor interest in the COVID data has grown with a large interest in Australia - it is a challenge keeping up with their questions and requests for more analysis.
One of the academic publications included an interesting graph, so I asked the academic a question about the graph. I was kindly sent a matlab file, on running the file it is clearly obvious that MATLAB's rand function is not rand but has patterns, you can see the patterns, you have trouble accepting the results for MC analysis if the rand func is not random.
The only random number generator that works nicely is the BASICA generator, no idea why but it is good.
![](/skins/images/C4F7392A5C68ACA60290C9576F107044/responsive_peak/images/icon_anonymous_message.png)
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page