This is my MEMO for coding materials in Fortran 90.
- Append data to the existing file
- Sequential names for output files
- Output with the fixed filename
- Save-and-load routine
- Random-number generator according to the date and time
- Recording the time
- Bouble-sorting routine
Append data to the existing file
open(1111, file='DTD_003_Pserv.dat', action='write', access='append', status='old')
do it = 0, ntmax ; t = dble(it)*dt ; gamma = hbarc*dsdum(it+1)/psurv(it)
write (1111, '(F12.5,2(2X,E15.7))') t, pndcy(it), gamma
end do
close(1111)
Sequential names for output files
character(32) :: filename
iq = 10*i1 + j1
write(filename, *) iq ! iq --> filename
!! read (filename, *) iq ! iq <-- filename
filename = 'fort.sigma_'//trim(adjustl(filename))//'.dat'
print *, filename
open(173, file=filename, action='write', status='replace')
close(173)
Output with the fixed filename
integer :: mane, ilab
character(32) :: filename
ilab = 1000
..........
mane = ilab*100+90000 +100*lsp +10*jsp +k!--- Label for output file
write(filename,*) mane !--- fix the file name as "19000XX".
filename = 'fpsurv_'//trim(adjustl(filename))//'.dat'
open(8492, file=filename, action='write', status='replace')
do it = 0, ntmax
t = dble(it)*dt
gamma = -hbarc*(dpsdum(it+1)/psdum(it+1))
write(8492, '(F11.3,2(2X,G12.5))') t, psdum(it+1), gamma
end do
close(8492)
Save-and-load routine
!----------------------------------------------------
subroutine Trans_12(xind, T_12, Tinv_12)
use setting, only : NN
implicit none
character(4), Intent(IN) :: xind
double precision, intent(INOUT) :: T_12(NN,NN), Tinv_12(NN,NN)
double precision, save :: T(NN,NN), Tinv(NN,NN)
if (xind == 'save') then
T = T_12
Tinv = Tinv_12
elseif (xind == 'load') then
T_12 = T
Tinv_12 = Tinv
end if
end subroutine Trans_12
!----------------------------------------------------
Random-number generator according to the date and time
subroutine random_at_date_and_time(n,x)
implicit none
integer, intent(IN) :: n
double precision, intent(OUT) :: x(n)
integer :: nsize, md(8)
integer, allocatable :: iseed(:)
double precision :: rnd(n)
call random_seed(size=nsize) ; allocate(iseed(nsize))
call random_seed(get=iseed) !; write(6,*) iseed
call date_and_time(values = md) !only md(8) is used here.
iseed = iseed*md(8)
call random_seed(put=iseed)
call random_number(rnd)
deallocate(iseed)
x = rnd
end subroutine random_at_date_and_time
Recording the time
subroutine rectime(id)
implicit none
integer, intent(in) :: id!--- Label for record.
integer, dimension (8) :: md
call date_and_time(values = md) !md(4) & md(8) are useless.
!! write(6, *) md
70 format(" ### >>> time -",i2,":",x, i4, ".", i2, ".", i2, " | ", i2,":",i2,":",i2, " <<<")
!! write(6, '(">>> time -",i2,":",x, i4, ".", i2, ".", i2, " | ", i2,":",i2,":",i2, " <<<")')
write(6,70) id, md(1),md(2),md(3),md(5),md(6),md(7)
write(6, *) ""
end subroutine rectime
Bouble-sorting routine
!###############################################
program kaban_sort_bouble
implicit none
write(6,*) ">>>>>>>>>>>>>>>>>>>>>>>>>>>> PROGRAM STARTS."
write(6,*) "Case 1:"
call example_01
write(6,*) "--------------------------------------"
write(6,*) "Case 2:"
call example_02
write(6,*) ">>>>>>>>>>>>>>>>>>>>>>>>>>>> PROGRAM ENDS."
end program kaban_sort_bouble
!###############################################
subroutine example_02
implicit none
integer :: nd, i, j
integer, allocatable :: id(:)
double precision :: x
double precision, allocatable :: r(:)
nd = 12
allocate(r(1:nd), id(1:nd))
call random_at_date_and_time(nd,r)
do i = 1, nd ; write(6,*) r(i) ; end do
!---
write(6,*) "--> Now I am sorting ..."
call bouble_indexer(nd,r,id)
do i = 1, nd
j = id(i)
write(6,*) r(j)
end do
deallocate(r, id)
return
end subroutine example_02
!###############################################
subroutine bouble_indexer(nd,r,id)
implicit none
integer, intent(IN) :: nd
integer, intent(OUT) :: id(1:nd)
double precision, intent(IN) :: r(1:nd)
integer :: i, j, k
double precision :: p, s(1:nd)
s = r
do j = 1, nd
id(j) = j
end do
!---
do i = 1, ND-1
k = i ; p = s(i)
do j = i + 1, ND
if(s(j) .le. p) then
k = j ; p = s(j)
end if
end do
!---
if(k .ne. i) then
j = id(k) ; id(k) = id(i) ; id(i) = j
p = s(k) ; s(k) = s(i) ; s(i) = p
end if
end do
return
end subroutine bouble_indexer
!###############################################
subroutine example_01
implicit none
integer :: nd, i
double precision :: x
double precision, allocatable :: r(:)
nd = 6
allocate(r(1:nd))
call random_at_date_and_time(nd,r)
do i = 1, nd ; write(6,*) r(i) ; end do
write(6,*) "--> Now I am sorting ..."
call bouble_sorter(nd,r)
do i = 1, nd ; write(6,*) r(i) ; end do
deallocate(r)
return
end subroutine example_01
!###############################################
subroutine bouble_sorter(nd,r)
implicit none
integer, intent(IN) :: nd
double precision, intent(INOUT) :: r(1:nd)
integer :: i, j, k
double precision :: p
do i = 1, ND-1
k = i ; p = r(i)
do j = i + 1, ND
if(r(j) .le. p) then
k = j ; p = r(j)
end if
end do
!---
if(k .ne. i) then
p = r(k)
r(k) = r(i)
r(i) = p
end if
end do
return
end subroutine bouble_sorter
!###############################################
