Test post

Here is some sample code

  subroutine rand_gauss_mu_sigmaD(mu, sigma, randX)
  use iso_fortran_env, only : real64
  implicit none
  real(real64), intent(in)  :: mu
  real(real64), intent(in)  :: sigma
  real(real64), intent(out) :: randX
  real(real64) :: z
    call rand_gauss(z)
    randX = mu + sigma * z
  end subroutine rand_gauss_mu_sigmaD

And here is a link to a dropbox image, which contains some Fortran embedded in a PSCAD script:

https://www.dropbox.com/scl/fi/cxm0922oojuqne7kdxvuw/image.jpg?rlkey=wzvq5x28qc8rxbu071t17po2u&st=sy6ca51f&dl=0

External URL does appear to work!

This ftn95forums.runasp.net page can’t be found No webpage was found for the web address: http://ftn95forums.runasp.net/Forum/Topic/url

You need to either just have the url: https://www.dropbox.com/scl/fi/cxm0922oojuqne7kdxvuw/image.jpg?rlkey=wzvq5x28qc8rxbu071t17po2u&st=sy6ca51f&dl=0

or

Use the syntax

Which in the later case is:

[Use the syntax](the full url)

Thanks, so just pasting the link works - no need to actually use the "Link" button!

https://www.dropbox.com/scl/fi/cxm0922oojuqne7kdxvuw/image.jpg?rlkey=wzvq5x28qc8rxbu071t17po2u&st=sy6ca51f&dl=0

The first code sample is fixed format and did not require any code mark up.

This sample is free format and runs into problems:

function acotZ(z) result(theta) ! ACOTC: double-precision complex inverse cotangent, theta = atan(1/z), z /= 0 use iso_fortran_env, only : real64 complex(real64), intent(in) :: z complex(real64) :: theta theta = atan(1.0_real64 / z) end function acotZ

Mark up below:

https://www.dropbox.com/scl/fi/u7amd7dpp5qugvqxg10sq/Screenshot-2025-12-31-155026.jpg?rlkey=metiy6cuxmu3suv47xjvj4045&st=i13omlq0&dl=0

Tried this a number of times today, and it's defeated me.

Either indent with four spaces (the code button will do that):

function acotZ(z) result(theta)
! ACOTC: double-precision complex inverse cotangent, theta = atan(1/z), z /= 0
use iso_fortran_env, only : real64
complex(real64), intent(in) :: z
complex(real64) :: theta
theta = atan(1.0_real64 / z)
end function acotZ

or use three backticks (top left key above tab) on the line before and after

function acotZ(z) result(theta)
! ACOTC: double-precision complex inverse cotangent, theta = atan(1/z), z /= 0
use iso_fortran_env, only : real64
complex(real64), intent(in) :: z
complex(real64) :: theta
theta = atan(1.0_real64 / z)
end function acotZ`

Using three backticks on line before code and line after code works for me:

function acotZ(z) result(theta)
! ACOTC: double-precision complex inverse cotangent, theta = atan(1/z), z /= 0
use iso_fortran_env, only : real64
complex(real64), intent(in) :: z
complex(real64) :: theta
theta = atan(1.0_real64 / z)
end function acotZ

I still cannot get the code button to work. It does not behave the way described i.e. indenting by four spaces.

I have fixed it now. The Code button in EditPost inserted four spaces before each line. It seems backticks are better so I have made both Code buttons use backticks

Thank you Robert, that works 😃 but no smileys - which is probably a good thing.

To insert code:

Method 1
Click on code, this creates three new lines, first with three backticks, second blank, third with three backticks. Paste code into the second blank line:

function acotZ(z) result(theta)
! ACOTC: double-precision complex inverse cotangent, theta = atan(1/z), z /= 0
use iso_fortran_env, only : real64
complex(real64), intent(in) :: z
complex(real64) :: theta
theta = atan(1.0_real64 / z)
end function acotZ

Method 2
Paste code. Highlight code, click on code

function acotZ(z) result(theta)
! ACOTC: double-precision complex inverse cotangent, theta = atan(1/z), z /= 0
use iso_fortran_env, only : real64
complex(real64), intent(in) :: z
complex(real64) :: theta
theta = atan(1.0_real64 / z)
end function acotZ

Post a code sample of 100 lines and see if it gets truncated as it would do on the old forum

  ! Note:
  !   Explicit tests for plus or minus Infinity are not required. 
  !   Under IEEE  arithmetic, conversion between real kinds preserves 
  !   signed infinities automatically.

  elemental pure function realStoD(x) result(y)
  !------------------------------------------------------------------
  ! REALSTOD: convert single-precision real to double-precision real,
  ! preserving IEEE NaN and infinities.
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32, real64
  use, intrinsic :: ieee_arithmetic
  implicit none
  real(real32), intent(in) :: x
  real(real64) :: y
    if (ieee_is_nan(x)) then
      y = ieee_value(1.0_real64, ieee_quiet_nan)
    else
      y = real(x, kind=real64)
    end if
  end function realStoD

  elemental pure function realDtoS(x) result(y)
  !------------------------------------------------------------------
  ! REALDTOS: convert double-precision real to single-precision real
  ! with saturation and NaN and infinity preservation
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32, real64
  use, intrinsic :: ieee_arithmetic
  implicit none
  real(real64), intent(in) :: x
  real(real32) :: y
    if (ieee_is_nan(x)) then
      y = ieee_value(1.0_real32, ieee_quiet_nan)
    else if (x > huge(1.0_real32)) then
      y = huge(1.0_real32)
    else if (x < -huge(1.0_real32)) then
      y = -huge(1.0_real32)
    else
      y = real(x, kind=real32)
    end if
  end function realDtoS

  elemental pure function complexStoD(z) result(y)
  !------------------------------------------------------------------
  ! COMPLEXSTOD: convert single-precision complex to double-precision
  ! complex preserving NaN and Inf in each component
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32, real64
  use, intrinsic :: ieee_arithmetic
  implicit none
  complex(real32), intent(in) :: z
  complex(real64) :: y
  real(real64) :: xr, xi
    if (ieee_is_nan(real(z))) then
      xr = ieee_value(1.0_real64, ieee_quiet_nan)
    else
      xr = real(real(z,kind=real32), kind=real64)
    end if
    if (ieee_is_nan(aimag(z))) then
      xi = ieee_value(1.0_real64, ieee_quiet_nan)
    else
      xi = real(aimag(z), kind=real64)
    end if
    y = cmplx(xr, xi, kind=real64)
  end function complexStoD

  elemental pure function complexDtoS(z) result(y)
  !------------------------------------------------------------------
  ! COMPLEXDTOS: convert double-precision complex to single-precision
  ! complex with saturation and NaN preservation
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32, real64
  use, intrinsic :: ieee_arithmetic
  implicit none
  complex(real64), intent(in) :: z
  complex(real32) :: y
  real(real32) :: xr, xi
  real(real64) :: zr, zi
    zr = real(z,kind=real64)
    zi = aimag(z)
    ! Real part
    if (ieee_is_nan(zr)) then
      xr = ieee_value(1.0_real32, ieee_quiet_nan)
    else if (zr > huge(1.0_real32)) then
      xr = huge(1.0_real32)
    else if (zr < -huge(1.0_real32)) then
      xr = -huge(1.0_real32)
    else
      xr = real(zr, kind=real32)
    end if
    ! Imaginary part
    if (ieee_is_nan(zi)) then
      xi = ieee_value(1.0_real32, ieee_quiet_nan)
    else if (zi > huge(1.0_real32)) then
      xi = huge(1.0_real32)
    else if (zi < -huge(1.0_real32)) then
      xi = -huge(1.0_real32)
    else
      xi = real(zi, kind=real32)
    end if
    y = cmplx(xr, xi, kind=real32)
  end function complexDtoS

Try approximately 250 lines of code:

  subroutine rand_flat_01S(rand_val)
  !------------------------------------------------------------------
  ! RAND_FLAT_01S
  !
  ! Generate a double-precision uniformly distributed random variate
  ! in the interval (0, 1).
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32, real64
  real(real32) :: rand_val
  real(real64) :: temp
    call park_miller_uniformD(temp)
    rand_val = realDtoS(temp)
  end subroutine rand_flat_01S

  subroutine rand_flat_01D(rand_val)
  !------------------------------------------------------------------
  ! RAND_FLAT_01D
  !
  ! Generate a double-precision uniformly distributed random variate
  ! in the interval (0, 1).
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real64
  real(real64) :: rand_val
    call park_miller_uniformD(rand_val)
  end subroutine rand_flat_01D

  subroutine rand_flat_abS(A, B, randAB)
  !------------------------------------------------------------------
  ! RAND_FLAT_ABS
  !
  ! Generate a single-precision uniformly distributed random variate
  ! in the interval [A, B].
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32
  implicit none
  real(real32), intent(in)  :: A, B
  real(real32), intent(out) :: randAB
  real(real32) :: rand01
    call rand_flat_01S(rand01)
    randAB = A + (B - A) * rand01
  end subroutine rand_flat_abS

  subroutine rand_flat_abD(A, B, randAB)
  !------------------------------------------------------------------
  ! RAND_FLAT_ABD
  !
  ! Generate a double-precision uniformly distributed random variate
  ! in the interval [A, B].
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real64
  implicit none
  real(real64), intent(in)  :: A, B
  real(real64), intent(out) :: randAB
  real(real64) :: rand01
    call rand_flat_01D(rand01)
    randAB = A + (B - A) * rand01
  end subroutine rand_flat_abD

  subroutine rand_gaussS(randval)
  !------------------------------------------------------------------
  ! RAND_GAUSSS
  !
  ! Generate a single-precision standard Gaussian (mean 0, std 1)
  ! random variate using the Box-Muller transform.
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32, real64
  real(real32) :: randval
  real(real64) :: temp
    call rand_gaussD(temp)
    randval = realDtoS(temp)
  end subroutine rand_gaussS

  subroutine rand_gaussD(randval)
  !------------------------------------------------------------------
  ! RAND_GAUSSD
  !
  ! Generate a double-precision standard Gaussian (mean 0, std 1)
  ! random variate using the Box-Muller transform.
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real64
  real(real64) :: randval
  real(real64) :: u1, u2, eps, twopi
    twopi = 2.0_real64*4.0_real64*atan(1.0_real64)
    eps = epsilon(1.0_real64)
    do
      call park_miller_uniformD(u1)
      if (u1 .lt. eps ) cycle
      call park_miller_uniformD(u2)
      randval = sqrt(-2.0_real64 * log(u1)) * cos(twopi * u2)
      exit
    end do
  end subroutine rand_gaussD

  subroutine rand_gauss_mu_sigmaS(mu, sigma, randX)
  !------------------------------------------------------------------
  ! RAND_GAUSS_MU_SIGMAS
  !
  ! Generate a single-precision Gaussian (normal) random variate with
  ! mean MU and standard deviation SIGMA.
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32
  implicit none
  real(real32), intent(in)  :: mu
  real(real32), intent(in)  :: sigma
  real(real32), intent(out) :: randX
  real(real32) :: z
    call rand_gaussS(z)
    randX = mu + sigma * z
  end subroutine rand_gauss_mu_sigmaS

  subroutine rand_gauss_mu_sigmaD(mu, sigma, randX)
  !------------------------------------------------------------------
  ! RAND_GAUSS_MU_SIGMAD
  !
  ! Generate a double-precision Gaussian (normal) random variate with
  ! mean MU and standard deviation SIGMA.
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real64
  implicit none
  real(real64), intent(in)  :: mu
  real(real64), intent(in)  :: sigma
  real(real64), intent(out) :: randX
  real(real64) :: z
    call rand_gauss(z)
    randX = mu + sigma * z
  end subroutine rand_gauss_mu_sigmaD

  subroutine rand_gauss_mu_sigma_trunc_abS(mu, sigma, a, b, randX)
  !------------------------------------------------------------------
  ! RAND_GAUSS_MU_SIGMA_TRUNC_ABDS
  !
  ! Generate a single-precision Gaussian random variate with mean
  ! MU and standard deviation SIGMA, truncated to the interval [A,B].
  !
  ! Rejection sampling is used; if no accepted sample is found after
  ! MAX_ITER attempts, a uniform fallback in [A,B] is returned.
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real32
  implicit none
  real(real32), intent(in)  :: mu, sigma, a, b
  real(real32), intent(out) :: randX
  real(real32) :: x, lo, hi
  integer :: iter
  integer, parameter :: max_iter = 100000
    lo = min(a, b)
    hi = max(a, b)
    do iter = 1, max_iter
      call rand_gauss_mu_sigma(mu, sigma, x)
      if (x >= lo .and. x <= hi) then
        randX = x
        return
      end if
    end do
    ! Fallback: uniform in [a,b]
    call rand_flat_abS(lo, hi, randX)
  end subroutine rand_gauss_mu_sigma_trunc_abS

  subroutine rand_gauss_mu_sigma_trunc_abD(mu, sigma, a, b, randX)
  !------------------------------------------------------------------
  ! RAND_GAUSS_MU_SIGMA_TRUNC_ABD
  !
  ! Generate a double-precision Gaussian random variate with mean
  ! MU and standard deviation SIGMA, truncated to the interval [A,B].
  !
  ! Rejection sampling is used; if no accepted sample is found after
  ! MAX_ITER attempts, a uniform fallback in [A,B] is returned.
  !------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only : real64
  implicit none
  real(real64), intent(in)  :: mu, sigma, a, b
  real(real64), intent(out) :: randX
  real(real64) :: x, lo, hi
  integer :: iter
  integer, parameter :: max_iter = 100000
    lo = min(a, b)
    hi = max(a, b)
    do iter = 1, max_iter
      call rand_gauss_mu_sigma(mu, sigma, x)
      if (x >= lo .and. x <= hi) then
        randX = x
        return
      end if
    end do
    print*, iter
    ! Fallback: uniform in [a,b]
    call rand_flat_abD(lo, hi, randX)
  end subroutine rand_gauss_mu_sigma_trunc_abD


  subroutine park_miller_uniformD(r)
  !-----------------------------------------------------------------------
  ! Function : park_miller_uniformD
  ! Returns  : A reproducible pseudo-random number in the interval [0, 1)
  !
  ! Description:
  !   Stand-alone version of the Park-Miller "Minimal Standard" RNG
  !   with Bays-Durham shuffle. This version returns REAL(REAL64)
  !   values, with fixed internal seed and no arguments.
  !
  ! Properties:
  !   - Returns REAL(REAL64) in [0, 1)
  !   - Deterministic and platform-independent
  !   - Self-contained and reproducible
  !   - Overall cycle length before repeating is after 2.1 billion calls
  !
  ! KSS
  ! 05/07/2025
  !-----------------------------------------------------------------------
  use, intrinsic :: iso_fortran_env, only: real64, int32
  implicit none
  real(real64), intent(out) :: r
  ! integer constants (32-bit arithmetic)
  integer(int32), parameter :: ia = 16807        ! ia - 7**5 (primitive root of M_31)
  integer(int32), parameter :: im = 2147483647   ! im = 2**31 - 1 (Mersenne prime, M_31)
  integer(int32), parameter :: iq = 127773
  integer(int32), parameter :: ir = 2836
  integer(int32), parameter :: ntab = 32
  integer(int32), parameter :: ndiv = 1 + (im - 1) / ntab
  ! real constants in real64 precision
  real(real64), parameter :: am   = 1.0_real64 / real(im, real64)
  real(real64), parameter :: rnmx = 1.0_real64 - epsilon(1.0_real64)
  ! rng state
  integer(int32), save :: seed = 1
  integer(int32), save :: iv(ntab) = 0
  integer(int32), save :: iy = 0
  integer(int32) :: j, k
     ! initialization
      if (iy .eq. 0) then
         seed = max(seed, 1)
         do j = ntab+8, 1, -1
           k = seed / iq
           seed = ia * (seed - k * iq) - ir * k
           if (seed .lt. 0) seed = seed + im
           if (j .le. ntab) iv(j) = seed
         end do
         iy = iv(1)
      end if
      ! main generation logic
      k = seed / iq
      seed = ia * (seed - k * iq) - ir * k
      if (seed .lt. 0) seed = seed + im
      j = 1 + iy / ndiv
      if (j .gt. ntab) j = ntab
      iy = iv(j)
      iv(j) = seed
      r = am * real(iy, real64)
      if (r .ge. 1.0_real64) r = rnmx
    end subroutine park_miller_uniformD

All tests passed

I can see how to do everything I would do on the old forum.

Smileys 😄

Very good. I better take the 🐕‍🦺 out for a walk

Link in most recent new reply email does not point to the correct location. See:

https://www.dropbox.com/scl/fi/wzvm6wvjyky088kodjtvn/Screenshot-2026-01-02-174209.jpg?rlkey=jv8chu92iy2wrb7r69zylsy9z&st=nf9u9id0&dl=0

It is correct because the post was made on my development machine. This post is on the server so should have its address in the link.

Ok, I understand now why it changed from working one day to non-working the next.

Will private messages (PMs) from the old system be transferred to this new system?

They haven't been transferred. Do you think they are needed?