I have a fortran 90 function that is meant to parse a time stamp in the form day as %Y%m%d.%f where %f is fraction of a day /48 and return an array with year, month, day, fraction of day.
function parseTimeStamp (timeStamp)
implicit none
real, dimension(5) :: parseTimeStamp
real, intent(in) :: timeStamp
real :: date, moment
integer :: intdate, day, month, year, t
date = floor(timeStamp) ! remove the part days
parseTimeStamp(4) = timeStamp - date ! save the part days
intdate = int(date)
day = mod(intdate,100); intdate = intdate / 100
month = mod(intdate,100); intdate = intdate / 100
year = intdate
parseTimeStamp(1) = real(year)
parseTimeStamp(2) = real(month)
parseTimeStamp(3) = real(day)
end function parseTimeStamp
The issue is the output shows fraction of the day always at 0. When printing the timestamp (!print *, timeStamp) I get the date without fraction of the day 48 times before rolling over to the next day, even when I know with 100% certainty the data being read contains the proper fraction.
ex: I am getting
20220101.0 20220101.0 20220101.0 .... 20220102.0 20220102.0 ...
instead of
20220101.0 20220101.02083 20220101.04167 .... 20220102.0 20220102.02083 ...
I've tried using several different input files and have confirmed that the input files contain the part day data.
I think you would be better creating a user-defined type to hold your date and time variables than to try to return an array. Year, month and day are more naturally whole numbers (integer type). If you want higher precision use kind=real64 from iso_fortran_env (worth looking up: it has other goodies in that make codes portable).
program test
use iso_fortran_env
implicit none
integer y, m, d ! year, month, day
real(real64) f ! fraction of a day
call parseTimeStamp( "20220101.02083", y, m, d, f )
write( *, "( 3(a, ': ', i0, :, / ) )" ) "year", y, "month", m, "day", d
write( *, "( a, ': ', f7.5 )" ) "fraction", f
contains
subroutine parseTimeStamp( dateTime, year, month, day, dayfraction )
character(len=*), intent(in) :: dateTime
integer, intent(out) :: year, month, day
real(real64), intent(out) :: dayfraction
real(real64) temp
! *** TO DO *** check that timestamp is well formed before anything else
read( dateTime(1:4), * ) year
read( dateTime(5:6), * ) month
read( dateTime(7: ), * ) temp
day = temp
dayfraction = temp - day
end subroutine parseTimeStamp
end program test
year: 2022
month: 1
day: 1
fraction: 0.02083
If you want to go with a user-defined type then you can return that from a function:
module timemod
use iso_fortran_env
implicit none
type DTime
integer year
integer month
integer day
real(real64) fraction ! fraction of a day
end type DTime
contains
type(DTime) function parseTimeStamp( dateStamp ) result( res )
character(len=*), intent(in) :: dateStamp
real(real64) temp
read( dateStamp(1:4), * ) res%year
read( dateStamp(5:6), * ) res%month
read( dateStamp(7: ), * ) temp
res%day = temp
res%fraction = temp - res%day
end function parseTimeStamp
end module timemod
!=======================================================================
program test
use iso_fortran_env
use timemod
implicit none
write( *, "( 3( i0, / ), f7.5 )" ) parseTimeStamp( "20220101.02083" )
end program test
Related
I need to get wall time in single precision. MPI_WTIME however returns the value in double precision. To work around this I try:
subroutine wtime
real(kind=8) :: t_now
real :: wt
t_now = MPI_WTIME()
if ( t_now > 1e38 ) then
wt = 1e30
else if ( t_now < 1e-38 ) then
wt = 0
end if
end subroutine wtime
Is there a fortran equivalent of MPI_WTIME() that I can use instead to get wall time in single precision?
I compile my code with the flag -real-size 32 so by default real is of kind 4.
I am new to OpenMP. I want to solve a stiff ODE system for a range of parameter values using parallel do loops. I use the following code in Fortran given below. However, I do not know whether calling a stiff solver(as a subroutine) inside a parallel do loop is allowed or not? Also, I want to write the time series data into files with filenames such as "r_value_s__value.txt" in the subroutine before the return to the main program. Can anyone help. Below is the code and the error. I used gfortran with flags -fopenmp to compile.
PROGRAM OPENMP_PARALLEL_STIFF
USE omp_lib
IMPLICIT NONE
INTEGER :: I, J
INTEGER, PARAMETER :: RTOT=10, STOT=15
INTEGER :: TID
INTEGER, PARAMETER :: NUM_THREADS=8
DOUBLE PRECISION :: T_INITIAL, T_FINAL
CALL OMP_SET_NUM_THREADS(NUM_THREADS)
CALL CPU_TIME(T_INITIAL)
PRINT*, "TIME INITIAL ",T_INITIAL
!$OMP PARALLEL DO PRIVATE(I,J,TID)
DO I=1,RTOT
DO J=1,STOT
TID=OMP_GET_THREAD_NUM()
CALL STIFF_DRIVER(TID,I,J,RTOT,STOT)
END DO
END DO
!$OMP END PARALLEL DO
CALL CPU_TIME(T_FINAL)
PRINT*, "TIME FINAL ",T_FINAL
PRINT*, "TIME ELAPSED ",(T_FINAL-T_INITIAL)/NUM_THREADS
END PROGRAM OPENMP_PARALLEL_STIFF
SUBROUTINE STIFF_DRIVER(TID,II,JJ,RTOT,STOT)
USE USEFUL_PARAMETERS_N_FUNC
USE DVODE_F90_M
! Type declarations:
IMPLICIT NONE
! Number of odes for the problem:
INTEGER :: SERIAL_NUMBER, TID
INTEGER :: II, JJ, RTOT, STOT, IND
INTEGER :: J, NTOUT
INTEGER :: ITASK, ISTATE, ISTATS, I
! parameters : declaration
DOUBLE PRECISION, PARAMETER :: s0=0.450D0, dr=1.0D-4, ds=1.0D-2
DOUBLE PRECISION, DIMENSION(NEQ) :: Y, YOUT
DOUBLE PRECISION :: ATOL, RTOL, RSTATS, T, TOUT, EPS, TFINAL, DELTAT
DIMENSION :: RSTATS(22), ISTATS(31)
DOUBLE PRECISION :: bb, cc, ba, ba1, eta
CHARACTER(len=45) :: filename
TYPE (VODE_OPTS) :: OPTIONS
SERIAL_NUMBER=3011+II+(JJ-1)*RTOT
IND=TID+3011+II+(JJ-1)*RTOT
WRITE (*,12)SERIAL_NUMBER,TID
12 FORMAT ("SL. NO. ",I5," THREAD NO.",I3)
r=(II-1)*dr
s=s0+JJ*ds
EPS = 1.0D-9
! Open the output file:
WRITE (filename,93)r,s
93 FORMAT ("r_",f6.4,"_s_",f4.2,".txt")
OPEN (UNIT=IND,FILE=filename,STATUS='UNKNOWN',ACTION='WRITE')
! Parameters for the stiff ODE system
q0 = 0.60D0; v = 3.0D0
Va = 20.0D-4; Vs = 1.0D-1
e1 = 1.0D-1; e2 = 1.10D-5; e3 = 2.3D-3; e4=3.0D-4
del = 1.7D-4; mu = 5.9D-4
al = 1.70D-4; be = 8.9D-4; ga = 2.5D-1
! S and r dependent parameters
e1s = e1/s; e2s = e2/(s**2); e3s = e3/s; e4s = e4/s
dels = del*s; rs = r*s
e1v = e1/v; e2v = e2/(v**2); e3v = e3/v; e4v = e4/v
delv = del*v; rv = r*v
! SET INITIAL PARAMETERS for INTEGRATION ROUTINES
T = 0.0D0
TFINAL = 200.0D0
DELTAT = 0.10D0
NTOUT = INT(TFINAL/DELTAT)
RTOL = EPS
ATOL = EPS
ITASK = 1
ISTATE = 1
! Set the initial conditions: USING MODULE USEFUL_PARAMETERS_N_FUNC
CALL Y_INITIAL(NEQ,Y)
! Set the VODE_F90 options:
OPTIONS = SET_OPTS(DENSE_J=.TRUE.,USER_SUPPLIED_JACOBIAN=.FALSE., &
RELERR=RTOL,ABSERR=ATOL,MXSTEP=100000)
! Integration:
DO I=1,NTOUT
TOUT = (I-1)*DELTAT
CALL DVODE_F90(F_FUNC,NEQ,Y,T,TOUT,ITASK,ISTATE,OPTIONS)
! Stop the integration in case of an error
IF (ISTATE<0) THEN
WRITE (*,*)"ISTATE ", ISTATE
STOP
END IF
! WRITE DATA TO FILE
WRITE (IND,*) TOUT,T, Y(NEQ-2)
END DO
CLOSE(UNIT=IND)
RETURN
END SUBROUTINE STIFF_DRIVER
At line ** of file openmp_parallel_stiff.f90 (unit = 3013)
Fortran runtime error: File already opened in another unit
The issue is the format that you chose: f6.4 for r will overflow for r>=10. Then, the output will be six asterisks ****** (depending on the compiler) for all values of r>=10 on all threads. The same holds true for s.
I would suggest to either limit/check the range of these values or extend the format to honor more digits.
As #francescalus mentioned, another possibility is hit a combination of II and JJ where r and s are identical.
Just for the fun of it - let's do the math:
r=(II-1)*dr
s=s0+JJ*ds
From r=s follows
(II-1)*dr = s0+JJ*ds
or
II = 1 + s0/dr + JJ*ds/dr
Using the constants s0=0.450D0, dr=1.0D-4, ds=1.0D-2 yields
II = 4501 + JJ*10
So, whenever this combination is true for two (or more) threads at a time, you run into the observed issue.
Simple solution for this case: add the thread number to the file name.
I am having a problem with this simple code, giving me the following error.
Somehow it is saying that there is a conflict with the Intent (in) attribute.
gfortran -o build/lib/larsa.o -c -ffree-form -g -J./build/lib lib/larsa.f
lib/larsa.f:2701.8:
sep, sty, shr &
1
Error: PROCEDURE attribute conflicts with INTENT attribute in 'sep' at (1)
lib/larsa.f:2710.17:
If (Len_trim (sep) > 0) Then
1
Error: 'string' argument of 'len_trim' intrinsic at (1) must be CHARACTER
This is the subroutine
Subroutine write_separator_new &
( &
sep, sty, shr &
)
Character (len=*), Intent(in) :: sep, sty
Integer, Intent(in), Optional :: shr
Character (len=65) :: a, fmt
If (Len_trim (sep) > 0) Then
a = Repeat (sep(1), 60)
Else
Write (*,*) ""
End If
End Subroutine write_separator_new
Indexing of character strings requires :
a = Repeat (sep(1:1), 60)
The compiler assumed sep is a a function, because you used it as such and not as a character string.
In FileMaker Pro, I am trying to append the current date and time to a filename to which I export data. If I use
Get (CurrentTime)
I get 12-hour time, complete with " PM" or " AM" at the end. Is there built-in functionality to return 24-hour time, instead?
FileMaker help says that the format follows the format of system time, but that is not the case. System time is showing as 17:22, but CurrentTime is returning 52218 PM. (Mac OS 10.8.5, FileMaker Pro 12.0v4.)
Filemaker's internal time storage notation is simply the number of seconds elapsed since midnight of the current day.
I.e. 56659 seconds since midnight = 3:44:19 PM.
When exporting data, you can check off the "Apply current layout's data formatting to exported data" checkbox, so that times displayed as 24-hour in FMP layouts are exported as such.
But, for other internal use such as the file-naming case you're asking about, you will need to use a custom function to convert the output of Get(currentTime) to 24-hour format.
For example, see the TimeFormatAs ( theTime ; type12or24 ) function at Briandunning.com.
(Full code of the custom function is pasted below for protection against dead links in the future, but if the link above still works, use that version as it may be more up-to-date:)
/*---------------------------------------------------------------
Function Name: TimeFormatAs
Syntax: TimeFormatAs ( theTime; type12or24 )
Author - Jonathan Mickelson, Thought Development Corp.
(www.thought-dev.com)
---------------------------------------------------------------*/
Case ( not IsEmpty ( theTime ) ;
Let (
[
// FIXED VARIABLES
padHoursChar = "" ; // Character to pad the Hours with in a text result, (Ex."0", " ", "")
padAMPMChar = " " ; // Character to pad the AM/PM with in a text result, (Ex."0", " ", "")
suffixAM = "AM" ; // <------------ CHANGE AM Suffix Here
suffixPM = "PM" ; // <------------ CHANGE PM Suffix Here
// DYN. VARIABLES
theTime = GetAsTime ( theTime ) ;
hasSeconds = PatternCount ( GetAsText ( theTime ) ; ":" ) = 2 ;
secs = Mod ( Seconds ( theTime ) ; 60 ) ;
mins = Mod ( Minute ( theTime ) ; 60 ) + Div ( Seconds ( theTime ) ; 60 ) ;
hours = Hour ( theTime ) + Div ( Minute ( theTime ) ; 60 ) ;
// -------------- BEGIN 24 HOUR TIME CALC ----------------------
result24 = GetAsTime ( theTime ) + 1 - 1 ;
// -------------- BEGIN 12 HOUR TIME CALC ----------------------
hours = Mod ( Hour ( theTime ) ; 12 ) ;
tempHours = Case ( ( hours < 1 ) or ( hours - 12 = 0 ) ; 12 ; hours ) ;
calc12Hours =
Left (
padHoursChar & padHoursChar ;
2 - Length ( tempHours )
) &
tempHours ;
calc12Minutes = Left ( "00" ; 2 - Length ( mins ) ) & mins ;
calc12Seconds = Left ( "00" ; 2 - Length ( secs ) ) & secs ;
calc12Suffix = Case ( Mod ( Hour ( theTime ) ; 24 ) >= 12 ; suffixPM ; suffixAM ) ;
result12 = calc12Hours &
":" & calc12Minutes &
// if original time included a non-zero seconds value, display seconds
Case ( hasSeconds and secs > 0 ; ":" & calc12Seconds ) &
padAMPMChar & calc12Suffix
] ;
Case ( type12or24 >= "24" ; result24 ; result12 ) // END CASE
) // END LET
) // END CASE
Now I am facing the problem that in a module, with a seed I am generating random numbers to be used in a loop of a function but each time I call that function, the same random numbers are generated (because the seed is obviously the same) but it's supposed that it must continue the series or at least it must be different between calls. One solution could be that the main program gives a new seed to be used in the module but I think it there could be another elegant solution.
I am using Mersenne Twister generator by suggestion of many people.
Added
My function in my module (it is a package of functions) escentially makes such a Metropolis test using random numbers generated by a seed, for some reason compilation complains if I put
module mymod
uses mtmod
call sgrnd(4357)!<-- this line causes compilation error
contains
myfunc(args)
implicit none
// declarations etc
!call sgrnd(4357) <-- if I put this call here compilator says ok,
!but re-start random number series each time this function is called :(
....
!the following part is inside a loop
if (prob < grnd()) then
!grnd() is random number generated
return
else continue testing to the end of the loop cycle
end myfunc
But if I put that function in the contains of the main program (using mtmod too) and call sgrnd(4357) before contains section and the calls to myfunc, now everything compile and run nicely. For clarity, I didn't want to put that long function in the main program, it has 70 lines of code, but it seems I have no escape. Notice that so, the seed is once called. The simulations have now physical meanings but with that price payed.
I always used this subroutine (I'm running a MonteCarlo simulation), call it in the beginning of your main program and tis should do the job:
(Source: gfortran 4.6.1)
c initialize a random seed from the system clock at every run (fortran 95 code)
subroutine init_random_seed()
INTEGER :: i, n, clock
INTEGER, DIMENSION(:), ALLOCATABLE :: seed
CALL RANDOM_SEED(size = n)
ALLOCATE(seed(n))
CALL SYSTEM_CLOCK(COUNT=clock)
seed = clock + 37 * (/ (i - 1, i = 1, n) /)
CALL RANDOM_SEED(PUT = seed)
DEALLOCATE(seed)
end
You can find here a subroutine that uses system time to re-seed the random number generator. You shouldn't have to do this every time you call random_number(), just each time you re-start the program.
Honestly, it didn't take me more than ten minutes to find this with Google.
In order to recover my points taken, I was obliged to find my own answer, here it is (after one hour of tries)
main program is
program callrtmod
use mymod
implicit none
real::x
x=1.0
write(*,*) x+writerandnum()
write(*,*) x+writerandnum()
write(*,*) x+writerandnum()
end program callrtmod
here's my module
module mymod
implicit none
!-------------mt variables-------------
! Default seed
integer, parameter :: defaultsd = 4357
! Period parameters
integer, parameter :: N = 624, N1 = N + 1
! the array for the state vector
integer, save, dimension(0:N-1) :: mt
integer, save :: mti = N1
!--------------------------------------
contains
function writerandnum
implicit none
real(8)::writerandnum
writerandnum = grnd()
!if you please, you could perform a Metropolis test here too
end function writerandnum
!Initialization subroutine
subroutine sgrnd(seed)
implicit none
integer, intent(in) :: seed
mt(0) = iand(seed,-1)
do mti=1,N-1
mt(mti) = iand(69069 * mt(mti-1),-1)
enddo
!
return
end subroutine sgrnd
!---------------------------------------------------------------------------
!the function grnd was here
!---------------------------------------------------------------------------
subroutine mtsavef( fname, forma )
character(*), intent(in) :: fname
character, intent(in) :: forma
select case (forma)
case('u','U')
open(unit=10,file=trim(fname),status='UNKNOWN',form='UNFORMATTED', &
position='APPEND')
write(10)mti
write(10)mt
case default
open(unit=10,file=trim(fname),status='UNKNOWN',form='FORMATTED', &
position='APPEND')
write(10,*)mti
write(10,*)mt
end select
close(10)
return
end subroutine mtsavef
subroutine mtsaveu( unum, forma )
integer, intent(in) :: unum
character, intent(in) :: forma
select case (forma)
case('u','U')
write(unum)mti
write(unum)mt
case default
write(unum,*)mti
write(unum,*)mt
end select
return
end subroutine mtsaveu
subroutine mtgetf( fname, forma )
character(*), intent(in) :: fname
character, intent(in) :: forma
select case (forma)
case('u','U')
open(unit=10,file=trim(fname),status='OLD',form='UNFORMATTED')
read(10)mti
read(10)mt
case default
open(unit=10,file=trim(fname),status='OLD',form='FORMATTED')
read(10,*)mti
read(10,*)mt
end select
close(10)
return
end subroutine mtgetf
subroutine mtgetu( unum, forma )
integer, intent(in) :: unum
character, intent(in) :: forma
select case (forma)
case('u','U')
read(unum)mti
read(unum)mt
case default
read(unum,*)mti
read(unum,*)mt
end select
return
end subroutine mtgetu
!===============================================
!Random number generator
! real(8) function grnd()
function grnd !agregue yo
implicit integer(a-z)
real(8) grnd !agregue yo
! Period parameters
integer, parameter :: M = 397, MATA = -1727483681
! constant vector a
integer, parameter :: LMASK = 2147483647
! least significant r bits
integer, parameter :: UMASK = -LMASK - 1
! most significant w-r bits
! Tempering parameters
integer, parameter :: TMASKB= -1658038656, TMASKC= -272236544
dimension mag01(0:1)
data mag01/0, MATA/
save mag01
! mag01(x) = x * MATA for x=0,1
TSHFTU(y)=ishft(y,-11)
TSHFTS(y)=ishft(y,7)
TSHFTT(y)=ishft(y,15)
TSHFTL(y)=ishft(y,-18)
if(mti.ge.N) then
! generate N words at one time
if(mti.eq.N+1) then
! if sgrnd() has not been called,
call sgrnd( defaultsd )
! a default initial seed is used
endif
do kk=0,N-M-1
y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK))
mt(kk)=ieor(ieor(mt(kk+M),ishft(y,-1)),mag01(iand(y,1)))
enddo
do kk=N-M,N-2
y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK))
mt(kk)=ieor(ieor(mt(kk+(M-N)),ishft(y,-1)),mag01(iand(y,1)))
enddo
y=ior(iand(mt(N-1),UMASK),iand(mt(0),LMASK))
mt(N-1)=ieor(ieor(mt(M-1),ishft(y,-1)),mag01(iand(y,1)))
mti = 0
endif
y=mt(mti)
mti = mti + 1
y=ieor(y,TSHFTU(y))
y=ieor(y,iand(TSHFTS(y),TMASKB))
y=ieor(y,iand(TSHFTT(y),TMASKC))
y=ieor(y,TSHFTL(y))
if(y .lt. 0) then
grnd=(dble(y)+2.0d0**32)/(2.0d0**32-1.0d0)
else
grnd=dble(y)/(2.0d0**32-1.0d0)
endif
return
end function grnd
end module mymod
test my solution and vote me up ;) [of course, as you see, I modified mt.f90 code to be included conveniently in my module, so I can keep separately the main program from the randon numbers generation part, so I can do a Metropolis test aside the main program. The main program just wants to know if a trial was accepted or not. My solution does give more clarity to the main progam]