Intel Fortran cannot read from a long line properly?

1

Dear all,

A quick question, I have a code and need to read in from a file, like below, call it input.dat,

code.exe < input.dat

It usually works. But today I found that if my input file is like below, then after typing code.exe < input.dat and hit enter, the code does not run, just stuck there. It seem only occur with Intel Fortran and on Windows.

Below is the input.dat

9002785287		# * irn. boss random number seed
12			# imode. 11 mean V fixed. 12 means full mixing, both V and k are flexable. CHoose 12 for now.
1000			# * itermax. max iteration number. Usually with stopping criterion code should stop before itermax.
.true.			# * stop_criterion_on. Enabling stop criterion or not. .true. means yes enable.	
30			# * LL_n. The number of continuous iterations for averaged slope. and then calculating the averaged parameters. currently just use this one number. 
0.0			# * crit_1. The value of slope for stop criterion. The iteration begin 'smoothing' stage after averaged slope smaller than this value. Set to zero.
1			# * kmix. The gaussian mixing number.
.true.			# read Yji or generate Yji. Currently set it as .true. 
1000			# * mgauss_all. number of gaussian samples in E step.
5000000			# * m_all. Metropolos samples in M step.
30			# * i_init. This is for initial condition. Currently it is from 1 to 50 which is the number of subjects. Select the subject from simpar to start initial condition	
simdata.csv		# data.csv name
simpar.csv		# parcsvname

From # it is just the comment.

However, if I make my input file shorter like below,

9002785287		# * irn. 
12				# imode. 
1000			# * itermax. 
.true.			# * stop_criterion_on. 
30				# * LL_n. 
0.0				# * crit_1. 
1				# * kmix. 
.true.			# read Yji or generate Yji. 
1000			# * mgauss_all. 
5000000			# * m_all. 
30				# * i_init.
simdata.csv		# data.csv name
simpar.csv		# parcsvname

Then the code can read the file correctly and run.
The read-in part of the code is

    read (5,*) irn
    read (5,*) imode
    read (5,*) itermax
    read (5,*) stop_criterion_on
    read (5,*) LL_n
    read (5,*) crit_1
    read (5,*) kmix
    read (5,*) readYji 
    read (5,*) mgauss_all
    read (5,*) m_all
    read (5,*) i_init
    read (5,'(a30)') csvname
    read (5,'(a30)') parcsvname

But I am confused, why the longer version of input file does not work?
Is there some limitation of the read-in file XXX, when using < XXX ?

Like in the XXX file, between the stuff and # should I use TAB or SPACE?

...
30 TAB TAB TAB #

or

30 SPACE SPAVE SPACE #

Does anyone know or has anyone has similar experience?
Thank you very much indeed in advance!
Sorry I know this is a sloppy question and I did not investigate this I/O stuff too much and just asked the question lol.

PS.
I know usually there should be an additional line at the end the file, that is why there is an additional line as below

...
simpar.csv		# parcsvname
          ! this is the additional line.
2

Reading a file like that means that you read it line by line. The format is inherent to the READ statements that you use, not to the redirection. The phenomenon you describe is weird - do you have a reproducer (Fortran source plus input file) that we could have a look at?

1 Like
3

Thank you @Argen ! Sure, 3 files. main program, mympi.f90 (my mpi module), and an input file.
You only need to compile and build the main + mympi.f90.
Say the exe file is run.exe.
Then if you do (I am on windows, and use Intel OneAPI 2021.4),

mpiexec -n 6 run.exe < input.dat

the program just hangs, not sure why. However if I do not use MPI then there is no problem.

The program is extremely simple, it just use rank0 to read in the input file, then print to the screen.

main program is

program main
use mympi
integer, parameter :: i4=selected_int_kind(9)
integer, parameter :: i8=selected_int_kind(15)
integer, parameter :: r8=selected_real_kind(15,9)
integer(kind=i8) :: irn,imode,itermax,kmix,mgauss_all,m_all,i_init
integer :: LL_n
logical :: stop_criterion_on,readYji
real(kind=r8) :: crit_1
character(len=50) :: csvname != 'simdata.csv' 
character(len=50) :: parcsvname ! = 'simpar.csv'
call init0 !mpi initialization must be done before reading    
  if (myrank()==0) then
    read (5,*) irn
    read (5,*) imode
    read (5,*) itermax
    read (5,*) stop_criterion_on
    read (5,*) LL_n
    read (5,*) crit_1
    read (5,*) kmix
    read (5,*) readYji 
    read (5,*) mgauss_all
    read (5,*) m_all
    read (5,*) i_init
		read (5,'(a50)') csvname
    read (5,'(a50)') parcsvname
    
    csvname = adjustl(csvname)
    csvname = csvname(1:index(csvname,' ')-1) ! there should be space before # in the input file.
    parcsvname = adjustl(parcsvname) 
    parcsvname = parcsvname(1:index(parcsvname,' ')-1) 
    
    write (6,'(''Boss random number seed ='',t30,i20)') irn
    write (6,'(''imode ='',t30,i20)') imode
    write (6,'(''iteration max # ='',t30,i20)') itermax
    write (6,'(''Stop Criterion (SC) on ='',t40,l10)') stop_criterion_on
    write (6,'(''SC # of averaged iterations ='',t30,i20)') LL_n
    write (6,'(''SC stopping slope <'',t40,f10.5)') crit_1
    write (6,'(''Mixing number ='',t30,i20)') kmix
    write (6,'(''Read Yji ='',t40,l10)') readYji
    write (6,'(''# Gauss samples for E step ='',t30,i20)') mgauss_all
    write (6,'(''# Metropolis samples for M step ='',t30,i20)') m_all
    write (6,'(''Initially from subject # '',t30,i20)') i_init
    write (6,'(''data.csv file name ='',t30,a30)') csvname
    write (6,'(''simpar.csv file name ='',t30,a30)') parcsvname  
endif  
end

My mpi module is,

module mympi
   implicit none
   include 'mpif.h'
   integer, private, parameter :: i4=selected_int_kind(9)
   integer, private, parameter :: i8=selected_int_kind(15)
   integer, private, parameter :: r8=selected_real_kind(15,9)
   integer, private, save :: mpii4,mpii8,mpir8
   integer(kind=i4), private, save :: irank,iproc

interface bcast ! broadcast from process 0
   module procedure bcastirn
   module procedure bcasti1,bcasti1d,bcasti2d,bcasti3d,bcasti4d
   module procedure bcastr1,bcastr1d,bcastr2d,bcastr3d,bcastr4d
   module procedure bcastlogi
   module procedure bcastchar
   !module procedure bcast_varchar
end interface bcast

interface addall ! return sum to process 0
   module procedure addalli1,addalli1d,addalli1_8,addalli1d_8
   module procedure addallr1,addallr1d,addallr2d
   module procedure addallc1,addallc1d
end interface addall

interface gather ! gather to process 0
   module procedure gatheri1,gatheri1d,gatheri81
   module procedure gatherr1,gatherr1d
end interface gather

interface scatter ! scatter from process 0 to all process, evenly scatter. inverse of gather
   module procedure scatteri1,scatteri1d,scatteri81
   module procedure scatterr1,scatterr1d
end interface scatter

interface send ! send to someone else
   module procedure sendi1,sendi1d
   module procedure sendr1,sendr1d
   module procedure sendc1,sendc1d
end interface send

interface recv ! recv from someone else
   module procedure recvi1,recvi1d
   module procedure recvr1,recvr1d
   module procedure recvc1,recvc1d
end interface recv

contains
   subroutine init0 ! call this before anything else
   use mpi
   integer :: ierror,isize,ir,ip
   integer(kind=i4) :: itest4
   integer(kind=i8) :: itest8
   real(kind=r8) :: rtest8
   call mpi_init(ierror)
   call mpi_comm_rank(mpi_comm_world,ir,ierror)
   irank=ir
   call mpi_comm_size(mpi_comm_world,ip,ierror)
   iproc=ip
   call mpi_sizeof(itest4,isize,ierror)
   call mpi_type_match_size(mpi_typeclass_integer,isize,mpii4,ierror)
   call mpi_sizeof(itest8,isize,ierror)
   call mpi_type_match_size(mpi_typeclass_integer,isize,mpii8,ierror)
   call mpi_sizeof(rtest8,isize,ierror)
   call mpi_type_match_size(mpi_typeclass_real,isize,mpir8,ierror)
   return
   end subroutine init0

   subroutine done ! wrapper for finalize routine
   integer :: ierror
   call mpi_finalize(ierror)
   return
   end subroutine done

   subroutine bcastlogi(i)
   logical :: i
   integer :: ierror
   call mpi_bcast(i,1,mpi_logical,0,mpi_comm_world,ierror)
   return
   end subroutine bcastlogi   
   
   subroutine bcastirn(i)
   integer(kind=i8) :: i
   integer :: ierror
   call mpi_bcast(i,1,mpii8,0,mpi_comm_world,ierror)
   return
   end subroutine bcastirn

   subroutine bcasti1(i)
   integer(kind=i4) :: i
   integer :: ierror
   call mpi_bcast(i,1,mpii4,0,mpi_comm_world,ierror)
   return
   end subroutine bcasti1

   subroutine bcasti1d(i)
   integer(kind=i4) :: i(:)
   integer :: ierror
   call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
   return
   end subroutine bcasti1d

   subroutine bcasti2d(i)
   integer(kind=i4) :: i(:,:)
   integer :: ierror
   call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
   return
   end subroutine bcasti2d

   subroutine bcasti3d(i)
   integer(kind=i4) :: i(:,:,:)
   integer :: ierror
   call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
   return
   end subroutine bcasti3d

   subroutine bcasti4d(i)
   integer(kind=i4) :: i(:,:,:,:)
   integer :: ierror
   call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
   return
   end subroutine bcasti4d

   subroutine bcastr1d(r)
   real(kind=r8) :: r(:)
   integer :: ierror
   call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
   return
   end subroutine bcastr1d

   subroutine bcastr2d(r)
   real(kind=r8) :: r(:,:)
   integer :: ierror
   call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
   return
   end subroutine bcastr2d

   subroutine bcastr3d(r)
   real(kind=r8) :: r(:,:,:)
   integer :: ierror
   call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
   end subroutine bcastr3d

   subroutine bcastr4d(r)
   real(kind=r8) :: r(:,:,:,:)
   integer :: ierror
   call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
   end subroutine bcastr4d

   subroutine bcastr1(r)
   real(kind=r8) :: r
   integer :: ierror
   call mpi_bcast(r,1,mpir8,0,mpi_comm_world,ierror)
   end subroutine bcastr1

   !subroutine bcastchar(w)
   !integer(kind=i4) :: ierror
   !character(len=*) :: w
   !character(:), allocatable :: wa
   !integer(kind=i4) :: wlen   
   !if (myrank()==0) then
   !  wlen = len(w)
   !   if (allocated(wa)) deallocate(wa)
   !   allocate( character(wlen) :: wa )
   !  wa = w
   !  write (6,*) 'myrank info', myrank(), wlen, w, len(wa), wa    
   !endif 
   !call bcast(wlen)
   !if (myrank()/=0) then
   !   if (allocated(wa)) deallocate(wa)
   !   allocate( character(wlen) :: wa )
   !endif   
   !call mpi_bcast(wa,wlen,mpi_character,0,mpi_comm_world,ierror)
   !if (myrank()/=0) then
   !  w = wa
   !  write (6,*) 'myrank info !!!!', myrank(), len(w), w
   !endif
   !return
   !end subroutine bcastchar   
   
   subroutine bcastchar(w)
   integer(kind=i4) :: ierror
   character(len=*) :: w
   call mpi_bcast(w,len(w),mpi_character,0,mpi_comm_world,ierror)
   return
   end subroutine bcastchar   
   
   
   subroutine bcast_varchar(w)
   integer(kind=i4) :: ierror
   character(:), allocatable :: w
   integer(kind=i4) :: wlen
   if (myrank()==0) wlen = len(w)
   call bcast(wlen)
   if (myrank()/=0) then
    if (allocated(w)) deallocate(w)
    allocate( character(wlen) :: w )
   endif
   call mpi_bcast(w,wlen,mpi_character,0,mpi_comm_world,ierror)
   return
   end subroutine bcast_varchar
   
   
   function myrank() ! which process am I?
   integer(kind=i4) :: myrank
   myrank=irank
   return
   end function myrank

   function nproc() ! How many of use are there anyway?
   integer(kind=i4) :: nproc
   nproc=iproc
   return
   end function nproc

   subroutine addalli1(i,isum)
   integer(kind=i4) :: ierror,i,isum
   call mpi_reduce(i,isum,1,mpi_integer,mpi_sum,0,mpi_comm_world,ierror)
   return
   end subroutine addalli1

   subroutine addalli1d(i,isum)
   integer(kind=i4) :: ierror,i(:),isum(:)
   call mpi_reduce(i,isum,size(i),mpi_integer,mpi_sum,0,mpi_comm_world,ierror)
   return
   end subroutine addalli1d
   
   subroutine addalli1_8(i,isum)
   integer(kind=i4) :: ierror
   integer(kind=i8) :: i,isum
   call mpi_reduce(i,isum,1,mpi_integer8,mpi_sum,0,mpi_comm_world,ierror)
   return
   end subroutine addalli1_8

   subroutine addalli1d_8(i,isum)
   integer(kind=i4) :: ierror
   integer(kind=i8) :: i(:),isum(:)
   call mpi_reduce(i,isum,size(i),mpi_integer8,mpi_sum,0,mpi_comm_world,ierror)
   return
   end subroutine addalli1d_8

   subroutine addallr1(r,rsum)
   integer(kind=i4) :: ierror
   real(kind=r8) :: r,rsum
   call mpi_reduce(r,rsum,1,mpi_double_precision,mpi_sum,0, &
      mpi_comm_world,ierror)
   return
   end subroutine addallr1

   subroutine addallr1d(r,rsum)
   real(kind=r8) :: r(:),rsum(:)
   integer(kind=i4) :: ierror
   call mpi_reduce(r,rsum,size(r),mpi_double_precision,mpi_sum,0, &
      mpi_comm_world,ierror)
   return
   end subroutine addallr1d

   subroutine addallr2d(r,rsum)
   real(kind=r8) :: r(:,:),rsum(:,:)
   integer(kind=i4) :: ierror
   call mpi_reduce(r,rsum,size(r),mpi_double_precision,mpi_sum,0, &
      mpi_comm_world,ierror)
   return
   end subroutine addallr2d

   subroutine addallc1(c,csum)
   integer(kind=i4) :: ierror
   complex(kind=r8) :: c,csum
   call mpi_reduce(c,csum,1,mpi_double_complex,mpi_sum,0, &
      mpi_comm_world,ierror)
   return
   end subroutine addallc1

   subroutine addallc1d(c,csum)
   complex(kind=r8) :: c(:),csum(:)
   integer(kind=i4) :: ierror
   call mpi_reduce(c,csum,size(c),mpi_double_complex,mpi_sum,0, &
      mpi_comm_world,ierror)
   return
   end subroutine addallc1d

   subroutine gatheri1(i,igather)
   integer(kind=i4) :: i,igather(:)
   integer :: ierror
   call mpi_gather(i,1,mpii4,igather,1,mpii4,0,mpi_comm_world,ierror)
   return
   end subroutine gatheri1

   subroutine gatheri1d(i,igather)
   integer(kind=i4) :: i(:),igather(:)
   integer :: ierror
   call mpi_gather(i,size(i),mpii4,igather,size(i),mpii4,0, &
      mpi_comm_world,ierror)
   return
   end subroutine gatheri1d

   subroutine gatheri81(i,igather)
   integer(kind=i8) :: i,igather(:)
   integer :: ierror
   call mpi_gather(i,1,mpii8,igather,1,mpii8,0, &
      mpi_comm_world,ierror)
   return
   end subroutine gatheri81   

   subroutine gatherr1(r,rgather)
   real(kind=r8) :: r,rgather(:)
   integer :: ierror
   call mpi_gather(r,1,mpir8,rgather,1,mpir8,0,mpi_comm_world,ierror)
   return
   end subroutine gatherr1

   subroutine gatherr1d(r,rgather)
   real(kind=r8) :: r(:),rgather(:)
   integer :: ierror
   call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
      mpi_comm_world,ierror)
   return
   end subroutine gatherr1d
  
   subroutine scatteri1(i,iscatter)
   integer(kind=i4) :: i(:),iscatter
   integer :: ierror   
   call mpi_scatter(i,1,mpii4,iscatter,1,mpii4,0, &
      mpi_comm_world,ierror)  
   return
   end subroutine scatteri1    
   
   subroutine scatteri81(i,iscatter)
   integer(kind=i8) :: i(:),iscatter
   integer :: ierror   
   call mpi_scatter(i,1,mpii8,iscatter,1,mpii8,0, &
      mpi_comm_world,ierror)  
   return
   end subroutine scatteri81
   
   subroutine scatteri1d(i,iscatter)
   integer(kind=i4) :: i(:),iscatter(:)
   integer :: ierror
   call mpi_scatter(i,size(iscatter),mpii4,iscatter,size(iscatter),mpii4,0, &
      mpi_comm_world,ierror) 
   return
   end subroutine scatteri1d
   
   subroutine scatterr1(r,rscatter)
   real(kind=r8) :: r(:),rscatter
   integer :: ierror
   call mpi_scatter(r,1,mpir8,rscatter,1,mpir8,0, &
      mpi_comm_world,ierror)
   return
   end subroutine scatterr1   
   
   subroutine scatterr1d(r,rscatter)
   real(kind=r8) :: r(:),rscatter(:)
   integer :: ierror
   call mpi_scatter(r,size(rscatter),mpir8,rscatter,size(rscatter),mpir8,0, &
      mpi_comm_world,ierror)
   return
   end subroutine scatterr1d   
   
   subroutine sendi1(i,idto,itag)
   integer(kind=i4) :: i,idto,itag,ierror
   call mpi_send(i,1,mpi_integer,idto,itag,mpi_comm_world,ierror)
   return
   end subroutine sendi1

   subroutine sendi1d(i,idto,itag)
   integer(kind=i4) :: i(:),idto,itag,ierror
   call mpi_send(i,size(i),mpi_integer,idto,itag,mpi_comm_world,ierror)
   return
   end subroutine sendi1d

   subroutine sendr1(r,idto,itag)
   integer(kind=i4) :: idto,itag,ierror
   real(kind=r8) :: r
   call mpi_send(r,1,mpi_double_precision,idto,itag,mpi_comm_world,ierror)
   return
   end subroutine sendr1

   subroutine sendr1d(r,idto,itag)
   integer(kind=i4) :: idto,itag,ierror
   real(kind=r8) :: r(:)
   call mpi_send(r,size(r),mpi_double_precision,idto,itag,mpi_comm_world,ierror)
   return
   end subroutine sendr1d

   subroutine sendc1(c,idto,itag)
   integer(kind=i4) :: idto,itag,ierror
   complex (kind=r8) :: c
   call mpi_send(c,1,mpi_double_complex,idto,itag,mpi_comm_world,ierror)
   return
   end subroutine sendc1

   subroutine sendc1d(c,idto,itag)
   integer(kind=i4) :: idto,itag,ierror
   complex(kind=r8) :: c(:)
   call mpi_send(c,size(c),mpi_double_complex,idto,itag,mpi_comm_world,ierror)
   return
   end subroutine sendc1d

   subroutine recvi1(i,idfrom,itag)
   integer(kind=i4) :: i,idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)  
   call mpi_recv(i,1,mpi_integer,idfrom,itag,mpi_comm_world,status,ierror)
   return
   end subroutine recvi1

   subroutine recvi1d(i,idfrom,itag)
   integer(kind=i4) :: i(:),idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)  
   call mpi_recv(i,size(i),mpi_integer,idfrom,itag,mpi_comm_world,status,ierror)
   return
   end subroutine recvi1d

   subroutine recvr1(r,idfrom,itag)
   integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)  
   real(kind=r8) :: r
   call mpi_recv(r,1,mpi_double_precision,idfrom,itag,mpi_comm_world,status,ierror)
   return
   end subroutine recvr1

   subroutine recvr1d(r,idfrom,itag)
   integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)  
   real(kind=r8) :: r(:)
   call mpi_recv(r,size(r),mpi_double_precision,idfrom,itag,mpi_comm_world, &
      status,ierror)
   return
   end subroutine recvr1d

   subroutine recvc1(c,idfrom,itag)
   integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)  
   complex (kind=r8) :: c
   call mpi_recv(c,1,mpi_double_complex,idfrom,itag,mpi_comm_world,status,ierror)
   return
   end subroutine recvc1

   subroutine recvc1d(c,idfrom,itag)
   integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)  
   complex(kind=r8) :: c(:)
   call mpi_recv(c,size(c),mpi_double_complex,idfrom,itag,mpi_comm_world,status,ierror)
   return
   end subroutine recvc1d   
   
   subroutine barrier ! wrapper for mpi_barrier
   integer(kind=i4) :: ierror
   call mpi_barrier(mpi_comm_world,ierror)
   return
   end subroutine barrier   
   
   subroutine abort
   integer :: ierror
   call mpi_abort(mpi_comm_world,ierror)
   !stop
   return
   end subroutine abort

   subroutine mpiwait
   integer :: REQUEST, STATUS(MPI_STATUS_SIZE), IERROR
   call MPI_WAIT(REQUEST, STATUS, IERROR)
   return
   end subroutine mpiwait   

end module mympi

The input file is

9002785287  # * irn. boss random number seed
12          # imode. 11 mean V fixed. 12 means full mixing, both V and k are flexable. CHoose 12 for now.
1000        # * itermax. max iteration number. Usually with stopping criterion code should stop before itermax.
.true.      # * stop_criterion_on. Enabling stop criterion or not. .true. means yes enable.	
30          # * LL_n. The number of continuous iterations for averaged slope. and then calculating the averaged parameters. currently just use this one number. 
0.0         # * crit_1. The value of slope for stop criterion. The iteration begin 'smoothing' stage after averaged slope smaller than this value. Set to zero.
1           # * kmix. The gaussian mixing number.
.true.      # read Yji or generate Yji. Currently set it as .true. 
1000        # * mgauss_all. number of gaussian samples in E step.
5000000     # * m_all. Metropolos samples in M step.
30          # * i_init. This is for initial condition. Currently it is from 1 to 50 which is the number of subjects. Select the subject from simpar to start initial condition	
simdata.csv     # data.csv name
simpar.csv      # parcsvname
4

I never use TAB myself with Fortran: it’s not in the Fortran character set, and is it always the same number of blanks in all systems? Also CRquantum’s last 2 read statements used format (a30). Then csvname and parcsvname may have collected the # and some stuff beyond it. I usually use (A) when reading character variables, but there may be a good reason why CRquantum did not. Does # have some special meaning to Microsoft? (I use Linux myself so I don’t know.)

1 Like
5

Thank you @Harper !
I guess I just randomly set (a30), no particular reason lol. Just to display a file name. But (A) definitely is a better idea!
Indeed, I will collect #, that is why I did some stupid things like

csvname = adjustl(csvname)
csvname = csvname(1:index(csvname,' ')-1) ! there should be space before # in the input file.

to delete #. Like I may read in superman.csv # superman is super. then after the treatment I will read in the correct file name superman.csv.
About #, it is just indicating the beginning of a comment which will help me remember the meaning of each input. My PhD advisor’s input file using # for comment (well he use Linux like you) so I just followed the tradition and did not even think about it, lol. Perhaps it does not have particular meaning in Windows.

Yeah, I tried to use space instead of TAB, but i still have the problem. But it looks like the problem is in my MPI part. If do not use my MPI module, thenwithout MPI it seems the read in process is OK.

6

There is no specific meaning for # on Windows either.

1 Like
7

Although list-directed input can be used to read part of a line,
there are several issues with doing so.

Note that in general
tabs are not standard in input files and should always be avoided
or expanded; and reading a character file with a format statement
as indicated means you will read the first thirty characters
including the comment in your case.

There are a lot of libraries for reading
different types of configuration files and even simple expressions
like TOML and JSON files, but a built-in facility is NAMELIST.

I would suggest using NAMELIST and something more like the
following. Otherwise, you need to write your own parsing routines for
anything other than the simplest file formats, while NAMELIST will allow
you to read not just simple values but arrays and even user-defined
types in arbitrary order.

The suggested code sample is critical to diagnose your problems
but they could be multiple. Just for starters likely ones from your
description so far are

  • tabs characters in input
  • overflow reading first value
  • reading the comments into the filenames
  • / is the comment delimiter for list-directed input, not # (sort of)

In general creating your own parser is not a simple task so I would
stick with NAMELIST or use some of the parser libraries available,
several of which are trivially accessible as remote dependencies if
you use fpm(1) (the Fortran Package Manager).

program main
use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64
implicit none
! declare variables and default values
integer(kind=int64) :: irn=13141517
integer :: imode=11, itermax=2000, LL_n=40,kmix=1, &
         & mgauss_all=500,m_all=1000000,i_init=20
real    :: crit_1=0.0
logical :: stop_criterion_ond=.true. , Yji=.true. 
character(len=30) :: dataname="simdata.csv", parcsvname="simpar.csv" 
! add variables to a NAMELIST group
namelist /args/ irn, imode, itermax, LL_n, kmix, mgauss_all, m_all, i_init
namelist /args/ crit_1
namelist /args/ stop_criterion_ond, Yji
namelist /args/ dataname, parcsvname
! read in namelist
   read(*,nml=args)
! write it back out
   write(*,nml=args)
end program main

&args
irn=9002785287  ! boss random number seed
imode=12        ! 11 mean V fixed. 12 means full mixing, both V and k are flexable. CHoose 12 for now.
itermax=1000    ! max iteration number. Usually with stopping criterion code should stop before itermax.
stop_criterion_ond=.true.    ! Enabling stop criterion or not. .true. means yes enable. 
LL_n=30  ! The number of continuous iterations for
         ! averaged slope. and then calculating the averaged parameters. currently
         ! just use this one number.
crit_1=0.0  ! The value of slope for stop criterion. The
            ! iteration begin 'smoothing' stage after averaged slope smaller than this
            ! value. Set to zero.
kmix=1           ! * kmix. The gaussian mixing number.
Yji=.true.       ! read Yji or generate Yji. Currently set it as .true. 
mgauss_all=1000  ! * mgauss_all. number of gaussian samples in E step.
m_all=5000000    ! * m_all. Metropolos samples in M step.
i_init=30        ! * i_init. This is for initial condition. Currently
                 ! it is from 1 to 50 which is the number of subjects. Select the subject
                 ! from simpar to start initial condition
dataname="simdata.csv"    ! data.csv name
parcsvname="simpar.csv"   ! parcsvname
/

I see you added the samples, which helps a lot. A few debug statements or the use of a debugger will probably help you isolate where you are hanging.

1 Like
8

Thank you very much @urbanjost ! The NAMELIST trick seems to be a robust way of read in from a file! Will investigate it!

By the way,

Like what kind of debug statements? Thanks!

It seems when in MPI, the read is slightly different from without mpi.
I checked the line ending like some CR|LF stuff, and it looks fine,

image
image3378×856 216 KB

Perhaps when in MPI, the read from rank 0 has a line length limit or format restriction or something?

9

Debugging parallel codes and doing I/O in parallel codes for that matter can be complicated. Debuggers vary, so it depends on which one you use, if any. Otherwise,
WRITE statements as simple as “write(,)‘GOT HERE 1’” followed by a FLUSH are usually quite useful even though somewhat primitive. Depending on your compiler compiling with debug values (depends, but usually -g and sometimes --traceback) and then doing a ctrl-C might give you a traceback; starting the program with a debugger and interrupting it and doing a “where” is a common debugger command; … debugging (especially parallel code) is a topic all it’s own, especially without knowing which (if any) debugger you are using and which compiler on which platform; which is best covered in your debugger manual.

I know people that essentially develop while continiously using debuggers and others that despise them, but it is a topic that requires a bit of study, not easily discussed here.

Note that some people really like that namelist ignores lines until it encounters the &GROUPNAME line; so some people like to proceed a namelist group in a file with
a description of the case, often using markdown now-adays.

2 Likes
10

did not look at all the code, not sure if enough is there to tell, but you may have more than one process reading input, a common issue. So you might be sitting at a read from stdin from the other threads. If you run using one process and it runs or several ctrl-D inputs end the hang look for that, and make sure you only have the master doing the read. Some MPI/system configurations make reading from stdin problematic although that is less of a problem now-adays; but are you making sure only the master process is doing the read?

1 Like
11

Thank you @urbanjost ! Uhm I think I made only rank 0 do the reading, as below shows,

The

if (myrank==0) then

guarantee the rank 0 is the only process doing the reading.

Interestingly, the same xxx.exe file, if I execute mpiexec -n 6 xxx.exe < input.dat it just hangs. But if I just do xxx.exe < input.dat it works no problem.

However if the input.dat is concise as shown at the 1st thread and also as below, then mpiexec -n 6 xxx.exe < input.dat works.

9002785287		# * irn. 
12				# imode. 
1000			# * itermax. 
.true.			# * stop_criterion_on. 
30				# * LL_n. 
0.0				# * crit_1. 
1				# * kmix. 
.true.			# read Yji or generate Yji. 
1000			# * mgauss_all. 
5000000			# * m_all. 
30				# * i_init.
simdata.csv		# data.csv name
simpar.csv		# parcsvname
12

Just an idea: do you wait until rank 0 is done reading before letting all ranks proceed? You could be facing a race condition, where reading a smaller amount of input just makes rank 0 finish that before the other ranks get started. With a slightly larger amount, the other ranks could start without the proper data to work with.

1 Like
13

Thank you @Arjen ! Nice question.
Actually after rank 0 read in each vairable the file, I have some broadcasting,

	call init0 !mpi initialization must be done before reading    
  if (myrank()==0) then 
    read (5,*) irn
    read (5,*) imode
    read (5,*) itermax
    read (5,*) stop_criterion_on
    read (5,*) LL_n
    read (5,*) crit_1
    read (5,*) kmix
    read (5,*) readYji 
    read (5,*) mgauss_all
    read (5,*) m_all
    read (5,*) i_init
		read (5,'(a)') csvname
    read (5,'(a)') parcsvname
    
    csvname = adjustl(csvname)
    csvname = csvname(1:index(csvname,' ')-1) ! there should be space before # in the input file.
    parcsvname = adjustl(parcsvname) 
    parcsvname = parcsvname(1:index(parcsvname,' ')-1) 
    
    write (6,'(''MPI number of cores ='',t30,i20)') nproc()
    write (6,'(''Boss random number seed ='',t30,i20)') irn
    write (6,'(''imode ='',t30,i20)') imode
    write (6,'(''iteration max # ='',t30,i20)') itermax
    write (6,'(''Stop Criterion (SC) on ='',t40,l10)') stop_criterion_on
    write (6,'(''SC # of averaged iterations ='',t30,i20)') LL_n
    write (6,'(''SC stopping slope <'',t40,f10.5)') crit_1
    write (6,'(''Mixing number ='',t30,i20)') kmix
    write (6,'(''Read Yji ='',t40,l10)') readYji
    write (6,'(''# Gauss samples for E step ='',t30,i20)') mgauss_all
    write (6,'(''# Metropolis samples for M step ='',t30,i20)') m_all
    write (6,'(''Initially from subject # '',t30,i20)') i_init
    write (6,'(''data.csv file name ='',t30,a)') csvname
    write (6,'(''simpar.csv file name ='',t30,a)') parcsvname  
  endif
  call bcast(irn)
  call bcast(imode)
  call bcast(itermax)
  call bcast(stop_criterion_on)
  call bcast(LL_n)
  call bcast(crit_1)
  call bcast(kmix)
  call bcast(readYji)
  call bcast(mgauss_all)
  call bcast(m_all)
  call bcast(i_init)
  call bcast(csvname)
  call bcast(parcsvname)

Those call bcast(), is to do MPI broadcast, it broadcast every variable read in from rank 0 to all the other cores. if I understand correctly, when other cores see broadcast, they will automatically wait and wait for rank 0 to broadcast to them. I also have some MPI_barrier in the code, to eliminate the racing condition. But this is really a good question. Thanks for reminding me :slight_smile:

But perhaps modern way is to do MPI IO, but I am not too familiar with that, and IO is very minimal in my code, so I basically let rank 0 do the IO.

14

Try something like this:

if ( myrank () == 0 ) then
    read and stuff
else  
   mpi_wait - whatever the right invocation
endif

And should the broadcast not be within the if-block? Because otherwise every rank will broadcast to every other one its own values of the variables. (My MPI foo is a trifle rusty :slight_smile: )

1 Like
15

Thank you @Arjen , I feel the way I did perhaps is not too bad. The mpi_wait in the else if perhaps may let other ranks stuck there if not been treated too well :slight_smile: The MPI_bcast works good for what I am doing, lol :wink: My bottleneck is not IO so I am not going to optimize that part too much, lol.