read(100,5) temp, a, charac
5 format(A11,i1,A7)
read(100,*) b
read(100,*) c
read(100,*) d
if ((a .ne. 0 .or. b .ne. 0 .or. c .ne. 0 &
.or. d .ne. 0) .and. trim(charac) .ne. 'spline') then
print *, 'Scenario A'
else if ((a .ne. 0 .or. b .ne. 0 .or. c .ne. 0 &
.or. d .ne. 0) .and. trim(charac) .eq. 'spline') then
print *, 'Scenario B'
else
print *, 'Scenario C'
end if
Input file:
*---------------------------------------------------------------
My input file from which i am reading these looks as below:
1 spline
0
0
0
*----------------------------------------------------------------
what I want
scenario A is triggered if any of the integers a,b,c,d have a value of "1" and input file not containing the word "spline"
scenario B is triggered if any of the integers a,b,c,d have a value of "1" and input file contains the word "spline"
scenario C is triggered if all of the integers a,b,c,d have a value of "0" and input file not containing the word "spline"
*---------------------------------------------------------------------
I was initially placing some other word in place of spline for Scenario A to trigger, but I require that Scenario A and C trigger if there is nothing written i.e. empty space.
This is the reason that I am using formatting in read, otherwise the read statement goes to the next line when it does not finds any character in that specific line.
I have tried printing the variables and the variables shows correct values to trigger Scenario B but it still triggers A
read(100,*,end=5)a,charac
5 go to 6
6 read(100,*)b
read(100,*)c
read(100,*)d
if ((a .ne. 0 .or. b .ne. 0 .or. c .ne. 0 &
.or. d .ne. 0) .and. trim(charac) .ne. 'spline') then
print*, 'Scenario A'
else if ((a .ne. 0 .or. b .ne. 0 .or. c .ne. 0 &
.or. d .ne. 0) .and. trim(charac) .eq. 'spline') then
print*, 'Scenario B'
else
print*, 'Scenario C'
endif
Explanation:
The problem that I was facing was that I wanted the code to work such that it reads values for an integer "a" and character "charac" from the same line. I wanted the code to go through different scenarios in case if the "charac" had specific value in the input file and in case if there is no input for "charac" i.e. the input line contains integer only and no character.
What was going wrong was that in case if the input file had no character in that specific line, the read statement continues to read into the next line.
To avoid this I was using formatting to stop the read line after it has read certain number of characters, This is what is shown in my question. Doing it that way the if statement was not working properly, may be the inputs were not being read properly due to the formatting.
I did it the other way by using end statement in the read command and using go to command. So now the read statement ends at that line and I ask the code to go to the next read statement if it does not finds any input for charac.
This is the exact code that I am using:
read(100,*)curv,spanwise_spline
if (trim(spanwise_spline).eq.'spline')then
go to 6
elseif (trim(spanwise_spline).ne.'spline')then
go to 7
endif
6 read(100,*)
7 read(100,*)thick_distr
read(100,*)
read(100,*)thick
read(100,*)
read(100,*)LE
I have a code as enclosed below. It is supposed to read a binary file and produce a special format. (This code is a part of siesta code.) However, I receive the following error when I execute the code:
At line 127 of file grid2cube.f (unit = 5, file = 'stdin')
Fortran runtime error: Bad real number in item 0 of list input
The fortran compiler and flags that I have compiled the main code are:
FC= /usr/local/bin/mpif90
FFLAGS=-g -O2 FPPFLAGS= -DMPI
-DFC_HAVE_FLUSH -DFC_HAVE_ABORT LDFLAGS=
This code is also compiled with the same flag:
/usr/local/bin/mpif90 -c -g -O2 grid2cube.f
/usr/local/bin/mpif90 -o grid2cube grid2cube.o
I also change "-O2" to "-O1" and "O0" and recompiled everything. But the same error was produced.Besides I am using mpich-3.0.4 and gfortran as the base.
Please kindly help me correct this error.
program grid2cube
implicit none
integer maxp, natmax, nskip
parameter (maxp = 12000000)
parameter (natmax = 1000)
integer ipt, isp, ix, iy, iz, i, ip, natoms, np,
. mesh(3), nspin, Ind, id(3), iix, iiy,
. iiz, ii, length, lb
integer is(natmax), izat(natmax)
character sysname*70, fnamein*75, fnameout(2)*75,
. fnamexv*75, paste*74, task*5, fform*12
double precision rho(maxp,2), rhot(maxp,2)
double precision cell(3,3), xat(natmax,3), cm(3), rt(3),
. delta(3), dr(3), residual
external paste, lb
c ---------------------------------------------------------------------------
read(*,*)
read(5,*) sysname
read(5,*) task
read(5,*) rt(1),rt(2),rt(3)
read(5,*) nskip
read(5,*) fform
fnamexv = paste(sysname,'.XV')
if (task .eq. 'rho') then
fnamein = paste(sysname,'.RHO')
else if (task .eq. 'drho') then
fnamein = paste(sysname,'.DRHO')
else if (task .eq. 'ldos') then
fnamein = paste(sysname,'.LDOS')
else if (task .eq. 'vt') then
fnamein = paste(sysname,'.VT')
else if (task .eq. 'vh') then
fnamein = paste(sysname,'.VH')
else if (task .eq. 'bader') then
fnamein = paste(sysname,'.BADER')
else
write(6,*) 'Wrong task'
write(6,*) 'Accepted values: rho, drho, ldos, vh, vt, bader'
write(6,*) '(in lower case!!!!)'
stop
endif
length = lb(fnamein)
write(6,*)
write(6,*) 'Reading grid data from file ',fnamein(1:length)
c read function from the 3D grid --------------------------------------------
open( unit=1, file=fnamein, form=fform, status='old' )
if (fform .eq. 'unformatted') then
read(1) cell
else if (fform .eq. 'formatted') then
do ix=1,3
read(1,*) (cell(iy,ix),iy=1,3)
enddo
else
stop 'ERROR: last input line must be formatted or unformatted'
endif
write(6,*)
write(6,*) 'Cell vectors'
write(6,*)
write(6,*) cell(1,1),cell(2,1),cell(3,1)
write(6,*) cell(1,2),cell(2,2),cell(3,2)
write(6,*) cell(1,3),cell(2,3),cell(3,3)
residual = 0.0d0
do ix=1,3
do iy=ix+1,3
residual = residual + cell(ix,iy)**2
enddo
enddo
if (residual .gt. 1.0d-6) then
write(6,*)
write(6,*) 'ERROR: this progam can only handle orthogonal cells'
write(6,*) ' with vectors pointing in the X, Y and Z directions'
stop
endif
if (fform .eq. 'unformatted') then
read(1) mesh, nspin
else
read(1,*) mesh, nspin
endif
write(6,*)
write(6,*) 'Grid mesh: ',mesh(1),'x',mesh(2),'x',mesh(3)
write(6,*)
write(6,*) 'nspin = ',nspin
write(6,*)
do ix=1,3
dr(ix)=cell(ix,ix)/mesh(ix)
enddo
np = mesh(1) * mesh(2) * mesh(3)
if (np .gt. maxp) stop 'grid2d: Parameter MAXP too small'
C read(1) ( (rho(ip,isp), ip = 1, np), isp = 1,nspin)
do isp=1,nspin
Ind=0
if (fform .eq. 'unformatted') then
do iz=1,mesh(3)
do iy=1,mesh(2)
read(1) (rho(Ind+ix,isp),ix=1,mesh(1))
Ind=Ind+mesh(1)
enddo
enddo
else
do iz=1,mesh(3)
do iy=1,mesh(2)
read(1,'(e15.6)') (rho(Ind+ix,isp),ix=1,mesh(1))
Ind=Ind+mesh(1)
enddo
enddo
endif
enddo
C translate cell
do ix=1,3
delta(ix) = rt(ix)/dr(ix)
id(ix) = delta(ix)
delta(ix) = rt(ix) - id(ix) * dr(ix)
enddo
do iz=1,mesh(3)
do iy=1,mesh(2)
do ix=1,mesh(1)
iix=ix+id(1)
iiy=iy+id(2)
iiz=iz+id(3)
if (iix .lt. 1) iix=iix+mesh(1)
if (iiy .lt. 1) iiy=iiy+mesh(2)
if (iiz .lt. 1) iiz=iiz+mesh(3)
if (iix .gt. mesh(1)) iix=iix-mesh(1)
if (iiy .gt. mesh(2)) iiy=iiy-mesh(2)
if (iiz .gt. mesh(3)) iiz=iiz-mesh(3)
if (iix .lt. 1) stop 'ix < 0'
if (iiy .lt. 1) stop 'iy < 0'
if (iiz .lt. 1) stop 'iz < 0'
if (iix .gt. mesh(1)) stop 'ix > cell'
if (iiy .gt. mesh(2)) stop 'iy > cell'
if (iiz .gt. mesh(3)) stop 'iz > cell'
i=ix+(iy-1)*mesh(1)+(iz-1)*mesh(1)*mesh(2)
ii=iix+(iiy-1)*mesh(1)+(iiz-1)*mesh(1)*mesh(2)
do isp=1,nspin
rhot(ii,isp)=rho(i,isp)
enddo
enddo
enddo
enddo
close(1)
open( unit=3, file=fnamexv, status='old', form='formatted')
read(3,*)
read(3,*)
read(3,*)
read(3,*) natoms
do i=1,natoms
read(3,*) is(i),izat(i),(xat(i,ix),ix=1,3)
enddo
do i=1,natoms
do ix=1,3
xat(i,ix)=xat(i,ix)+rt(ix)-delta(ix)
if (xat(i,ix) .lt. 0.0) xat(i,ix)=xat(i,ix)+cell(ix,ix)
if (xat(i,ix) .gt. cell(ix,ix))
. xat(i,ix)=xat(i,ix)-cell(ix,ix)
enddo
enddo
close(3)
if (nspin .eq. 1) then
fnameout(1) = paste(fnamein,'.cube')
else if (nspin .eq. 2) then
fnameout(1) = paste(fnamein,'.UP.cube')
fnameout(2) = paste(fnamein,'.DN.cube')
else
stop 'nspin must be either 1 or 2'
endif
do isp=1,nspin
length = lb(fnameout(isp))
write(6,*) 'Writing CUBE file ',fnameout(isp)(1:length)
C open( unit=2, file=fnameout(isp), status='new', form='formatted')
open( unit=2, file=fnameout(isp), form='formatted')
length = lb(fnameout(isp))
write(2,*) fnameout(isp)(1:length)
write(2,*) fnameout(isp)(1:length)
write(2,'(i5,4f12.6)') natoms, 0.0,0.0,0.0
do ix=1,3
ii = mesh(ix)/nskip
if (ii*nskip .ne. mesh(ix)) ii = ii+1
write(2,'(i5,4f12.6)')
. ii,(cell(ix,iy)/ii,iy=1,3)
enddo
do i=1,natoms
write(2,'(i5,4f12.6)') izat(i),0.0,(xat(i,ix),ix=1,3)
enddo
do ix=1,mesh(1),nskip
do iy=1,mesh(2),nskip
write(2,'(6e13.5)')
. (rhot(ix+(iy-1)*mesh(1)+(iz-1)*mesh(1)*mesh(2),isp),
. iz=1,mesh(3),nskip)
enddo
enddo
close(2)
enddo
write(6,*)
end
CHARACTER*(*) FUNCTION PASTE( STR1, STR2 )
C CONCATENATES THE STRINGS STR1 AND STR2 REMOVING BLANKS IN BETWEEN
C Writen by Jose M. Soler
CHARACTER*(*) STR1, STR2
DO 10 L = LEN( STR1 ), 1, -1
IF (STR1(L:L) .NE. ' ') GOTO 20
10 CONTINUE
20 PASTE = STR1(1:L)//STR2
END
INTEGER FUNCTION LB ( STR1 )
C RETURNS THE SIZE IF STRING STR1 WITH BLANKS REMOVED
C Writen by P. Ordejon from Soler's paste.f
CHARACTER*(*) STR1
DO 10 L = LEN( STR1 ), 1, -1
IF (STR1(L:L) .NE. ' ') GOTO 20
10 CONTINUE
20 LB = L
END
The statement at the error line is:
read(5,*) rt(1),rt(2),rt(3)
This is is a list-directed formatted read. As you indicated in the comment, you are trying to read binary (unformatted) data. That cannot work. The statement above expects formatted, data, that means text with human readable numbers.
Also the pre-connected unit 5 is standard input. It shouldn't work for unformatted data if you first read formatted from it (with read(5,*) sysname).
Side note: the number 5 for standard input is not standardized, but is quite a safe assumption in practice. But I would use * instead of 5 anyway.
Response to a comment:
The (*,*) also cannot work. Generally, whenever you provide a format, which is the second argument in the parenthesis to read or write, you do formatted i/o. It doesn't matter if the format is * or something different. You cannot read unformatted data this way. You have to open a file for the unformatted read with form=unformatted with any possible access and read it with:
read(file_unit_number) rt(1),rt(2),rt(3)
If you cannot read the numbers in the data file as a text you cannot use formatted read.
Apologies for inconvenience , I have resubmitted the code now.
Problem: I am trying to write a program that reads the precipitation from a binary (.DAT) file. It calculates the value of precipitation at each grid and for every grid the maximum value month is returned as output. For example if there was a value of 25 highest in the month of June then our output value should be "Jun".
implicit none
integer,parameter :: ix=44,iy=27,nyr=12
integer :: ntot
real :: v_obs(ix,iy,nyr),TestVal,b(ix,iy,nyr),wet(ix,iy)
real:: Mon(12),Y(12),missing_obs,missing_mod,missing
integer :: ii,jj,i,j,k,ik,jk,irec,m,n
character (130) dir,jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec
data missing_obs/-999000000/
data missing/-999./
open(21,file='C:/Fortran/test-dat.dat',access='direct',recl=ix*iy*nyr,form='unformatted')
open(23,file='C:/wet-month.dat',access='direct',recl=ix*iy*nyr,form='unformatted')
irec=1
Do j=1,nyr
read(21,rec=irec) ((v_obs(ii,jj,j),ii=1,ix),jj=1,iy)
ntot=0
do ik=1,nyr
ntot=ntot+1
Y(ik)=v_obs(ii,jj,ik)
enddo
if (Y(ik) .eq. missing_obs)then
wet=-999
go to 199
endif
enddo
Mon(1)=v_obs(ii,jj,1)
Mon(2)=v_obs(ii,jj,2)
Mon(3)=v_obs(ii,jj,3)
Mon(4)=v_obs(ii,jj,4)
Mon(5)=v_obs(ii,jj,5)
Mon(6)=v_obs(ii,jj,6)
Mon(7)=v_obs(ii,jj,7)
Mon(8)=v_obs(ii,jj,8)
Mon(9)=v_obs(ii,jj,9)
Mon(10)=v_obs(ii,jj,10)
Mon(11)=v_obs(ii,jj,11)
Mon(12)=v_obs(ii,jj,12)
TestVal=MAXVAL(Mon)
If (TestVal .eq. Mon(1)) then
wet=jan
else if (TestVal .eq. Mon(2)) Then
wet=feb
else if (TestVal .eq. Mon(3)) Then
wet=mar
else if (TestVal .eq. Mon(4)) Then
wet=apr
else if (TestVal .eq. Mon(5)) Then
wet=may
else if (TestVal .eq. Mon(6)) Then
wet=jun
else if (TestVal .eq. Mon(7)) Then
wet=jul
else if (TestVal .eq. Mon(8)) Then
wet=aug
else if (TestVal .eq. Mon(9)) Then
wet=sep
else if (TestVal .eq. Mon(10)) Then
wet=oct
else if (TestVal .eq. Mon(11)) Then
wet=nov
else if (TestVal .eq. Mon(12)) Then
wet=dec
endif
199 continue
irec=1
do k=1,nyr
write(23,rec=irec)((wet(ii,jj),ii=1,ix),jj=1,iy)
irec=irec+1
enddo
close(21)
close(22)
end
The compliation error says
You cannot assign an expression of type CHARACTER(LEN=130) to a variable of type REAL(KIND=1)" i.e: "wet=jan".
But I want to save data as character for each grid point.Please help to resolve this error.
The problem is all those lines wet=jan, wet=feb, etc.
As I read from your code wet is real,dimension(44,27). jan and feb are of type character(130). Those are incompatible (as the compiler says).