diff --git a/upflib/read_upf_new.f90 b/upflib/read_upf_new.f90
index 0f2109cc6..91918961c 100644
--- a/upflib/read_upf_new.f90
+++ b/upflib/read_upf_new.f90
@@ -87,7 +87,15 @@ CONTAINS
IF( .NOT. upf%tcoulombp) then
allocate ( upf%vloc(upf%mesh) )
CALL xmlr_readtag( capitalize_if_v2('pp_local'), &
- upf%vloc(:) )
+ upf%vloc(:), ierr )
+ !
+ ! existing PP files may have pp_nlcc first, pp_local later,
+ ! but also the other way round - check that everything was right
+ !
+ if ( ierr /= 0 ) then
+ ierr = -81
+ return
+ end if
end if
!
CALL read_pp_semilocal ( upf )
@@ -258,51 +266,32 @@ CONTAINS
allocate ( vnl(1:upf%mesh) )
CALL xmlr_opentag( capitalize_if_v2('pp_semilocal') )
!
- IF ( v2 ) THEN
- tag = 'PP_VNL.1'
- ELSE
- tag = 'vnl'
- END IF
+ tag = 'vnl'
DO nb = 1,upf%nbeta
+ IF ( v2 ) THEN
+ ! NOTA BENE: v2 format follows available PP files, written
+ ! using original write_upf_v2; not FoX-based write_upf_v2
+ IF ( nb - 1 == upf%lloc ) CYCLE
+ tag = 'PP_VNL.'//i2c(nb-1)
+ END IF
CALL xmlr_readtag( tag, vnl, ierr )
- if ( ierr /= 0 ) then
- if ( v2 ) then
- go to 10
- else
- call upf_error('read_pp_semilocal','error reading SL PPs',1)
- end if
- end if
+ if ( ierr /= 0 ) &
+ call upf_error('read_pp_semilocal','error reading SL PPs',1)
CALL get_attr ( 'l', l)
ind = 1
IF ( upf%has_so ) then
CALL get_attr ( 'j', j)
IF ( l > 0 .AND. ABS(j-l-0.5_dp) < 0.001_dp ) ind = 2
- if ( v2 .and. ind == 2 ) &
- call upf_error('read_pp_semilocal','inconsistency in SL',1)
+ ! FIXME: what about spin-orbit case for v.2 upf?
+ if ( v2 ) &
+ call upf_error('read_pp_semilocal','check spin-orbit',1)
END IF
upf%vnl(:,l,ind) = vnl(:)
END DO
+ deallocate ( vnl )
!
CALL xmlr_closetag( ) ! end pp_semilocal
!
-10 IF ( v2 .and. upf%has_so ) then
- rewind ( iun )
- CALL xmlr_opentag( capitalize_if_v2('pp_semilocal') )
- ind = 2
- tag = 'PP_VNL.2'
- DO nb = 1,upf%nbeta
- CALL xmlr_readtag( tag, vnl, ierr )
- if ( ierr /= 0 ) exit
- CALL get_attr ( 'l', l)
- CALL get_attr ( 'j', j)
- IF ( .not. (l > 0 .AND. ABS(j-l-0.5_dp) < 0.001_dp) ) ind = 1
- if ( v2 .and. ind == 1 ) &
- call upf_error('read_pp_semilocal','inconsistency in SL',2)
- upf%vnl(:,l,ind) = vnl(:)
- END DO
- CALL xmlr_closetag( ) ! end pp_semilocal
- END IF
- deallocate ( vnl )
END IF
!
END SUBROUTINE read_pp_semilocal
@@ -359,7 +348,7 @@ CONTAINS
CALL get_attr('cutoff_radius_index', upf%kbeta(nb))
CALL get_attr('cutoff_radius', upf%rcut(nb))
CALL get_attr('ultrasoft_cutoff_radius', upf%rcutus(nb))
-
+ !
END DO
!
! pp_dij (D_lm matrix)
@@ -599,7 +588,7 @@ CONTAINS
!
IMPLICIT NONE
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
- INTEGER :: nw, nb
+ INTEGER :: nw, nb, ierr
CHARACTER(LEN=1) :: dummy
!
IF ( .NOT. v2 .OR. .NOT. upf%has_so ) RETURN
@@ -617,7 +606,15 @@ CONTAINS
ENDDO
!
DO nb = 1,upf%nbeta
- CALL xmlr_readtag( 'PP_RELBETA.'//i2c(nb), dummy )
+ CALL xmlr_readtag( 'PP_RELBETA.'//i2c(nb), dummy, ierr )
+ !
+ ! existing PP files may have pp_relbeta first, pp_relwfc later,
+ ! but also the other way round - check that everything was right
+ !
+ if ( ierr /= 0 ) then
+ ierr = -81
+ return
+ end if
CALL get_attr( 'index' , nw )
IF ( nb /= nw ) CALL upf_error('read_pp_spinorb','mismatch',2)
CALL get_attr( 'lll', upf%lll(nb) )
diff --git a/upflib/xmltools.f90 b/upflib/xmltools.f90
index e6779ba12..1488f9be0 100644
--- a/upflib/xmltools.f90
+++ b/upflib/xmltools.f90
@@ -16,23 +16,35 @@ MODULE xmltools
! * lines no more than 1024 characters long (see maxline parameter)
! * no more than 9 levels of tags (see maxlevel parameter)
! * length of tags no more than 80 characters (see maxlength parameter)
- ! Can read tags only in the correct order and in the following format:
- ! * tags holding a single value should begin and end in the same line
- ! * tags holding arrays of values should be opened in a single line,
- ! then the array in free format, then a single line with closing tag
+ ! * can read tags only in the correct order. If a tag is not found, the
+ ! file is rewound. If "ierr" is present, a second attempt to find the
+ ! tag is done starting from the top of the file - may work if the searched
+ ! tag is found only above the current position, and nowhere else
+ ! * only single values (e.g. no vectors) in attributes
! * attributes should not contain commas or strange characters
- ! Unpredictable results may follow otherwise.
!
USE upf_kinds, ONLY : dp
IMPLICIT NONE
!
+#undef __debug
+ !! define __debug to print information on opened and closed tags
+ LOGICAL, PARAMETER :: one_line_tags=.true.
+ !! if true, write tags with one value in a single line:
+ !! value
+ !! otherwise, as in iotk:
+ !!
+ !! value
+ !!
+ !! Only for single values; arrays are always written as in iotk
+ !
! internal variables for reading and writing
!
INTEGER :: xmlunit
INTEGER, PARAMETER :: maxline=1024
- character(len=maxline) :: line
- integer :: eot
- integer :: nattr
+ CHARACTER(LEN=maxline) :: line
+ INTEGER :: eot
+ ! eot points to the end of tag in line just scanned
+ INTEGER :: nattr
CHARACTER(LEN=:), ALLOCATABLE :: attrlist
!
! variables used keep track of open tags
@@ -55,12 +67,18 @@ MODULE xmltools
!
INTERFACE xmlr_readtag
MODULE PROCEDURE readtag_c, readtag_r, readtag_l, readtag_i, &
- readtag_rv, readtag_rm, readtag_rt, readtag_zv, readtag_zm
+ readtag_iv, readtag_rv, readtag_rm, readtag_rt, &
+ readtag_zv, readtag_zm
END INTERFACE xmlr_readtag
!
+ ! IMPORTANT NOTICE: complex numbers, z=a+ib, are written as two reals:
+ ! "a b", not in fortran free format as "(a,b)". Reason:
+ ! make the file readable by non-fortran tools, e.g. python
+ !
INTERFACE xmlw_writetag
MODULE PROCEDURE writetag_c, writetag_r, writetag_l, writetag_i, &
- writetag_rv, writetag_rm, writetag_rt, writetag_zv, writetag_zm
+ writetag_iv, writetag_rv, writetag_rm, writetag_rt, &
+ writetag_zv, writetag_zm
END INTERFACE xmlw_writetag
!
INTERFACE get_attr
@@ -224,18 +242,22 @@ CONTAINS
xmlunit = iun
nlevel = 0
open_tags(nlevel) = 'root'
- if ( allocated(attrlist) ) DEALLOCATE ( attrlist)
+ if ( allocated(attrlist) ) DEALLOCATE ( attrlist)
+#if defined ( __debug )
+ print "('file ',a,' opened with unit ',i5)",trim(filexml),iun
+#endif
!
END FUNCTION xml_openfile
!
SUBROUTINE xml_closefile ( )
!
CLOSE ( UNIT=xmlunit, STATUS='keep' )
+#if defined ( __debug )
+ print "('unit ',i5,': file closed')", xmlunit
+#endif
xmlunit = -1
- IF ( nlevel > 0 ) THEN
- print '("severe error: file closed at level ",i1," with tag ",A," open")', &
- nlevel, trim(open_tags(nlevel))
- END IF
+ IF (nlevel > 0) print '("warning: file closed at level ",i1,&
+ & " with tag ",A," open")', nlevel, trim(open_tags(nlevel))
nlevel = 0
!
END SUBROUTINE xml_closefile
@@ -278,7 +300,7 @@ CONTAINS
! If cval=' ' write
! If cval='?' write
! otherwise, write cval
- ! (su di una stessa riga)
+ ! (on a same line if one_line_tags=.true.)
! On output, same as xmlw_opentag
!
CHARACTER(LEN=*), INTENT(IN) :: name
@@ -307,7 +329,11 @@ CONTAINS
CALL xmlw_closetag ( '?' )
ELSE
! write value (character)
- WRITE (xmlunit, "('>',A)", ADVANCE='no') trim(cval)
+ IF (one_line_tags) THEN
+ WRITE (xmlunit, "('>',A)", ADVANCE='no') trim(cval)
+ ELSE
+ WRITE (xmlunit, "('>',/,A)") trim(cval)
+ ENDIF
! close here the tag
CALL xmlw_closetag ( name )
END IF
@@ -317,7 +343,6 @@ CONTAINS
ierr = ier_
ELSE IF ( ier_ > 0 ) THEN
print '("Fatal error ",i2," in xmlw_writetag!")', ier_
- stop
END IF
!
END SUBROUTINE writetag_c
@@ -334,6 +359,20 @@ CONTAINS
!
END SUBROUTINE writetag_i
!
+ SUBROUTINE writetag_iv (name, ivec, ierr )
+ !
+ ! As writetag_c, for integer value
+ !
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER, INTENT(IN) :: ivec(:)
+ INTEGER, INTENT(OUT),OPTIONAL :: ierr
+ !
+ CALL xmlw_opentag (name, ierr )
+ WRITE( xmlunit, *) ivec
+ CALL xmlw_closetag ( )
+ !
+ END SUBROUTINE writetag_iv
+ !
SUBROUTINE writetag_l (name, lval, ierr )
!
! As writetag_c, for logical value
@@ -404,26 +443,50 @@ CONTAINS
!
! As writetag_c, for a vector of complex values
!
+ USE iso_c_binding
CHARACTER(LEN=*), INTENT(IN) :: name
- COMPLEX(dp), INTENT(IN) :: zvec(:)
- INTEGER, INTENT(OUT),OPTIONAL :: ierr
+ COMPLEX(dp), INTENT(IN), TARGET:: zvec(:)
+ INTEGER, INTENT(OUT), OPTIONAL :: ierr
!
+ ! Casts a real pointer (rvec) to a complex array (zvec) via C pointer (!)
+ ! in order to write complexes as two reals. Some compilers require that
+ ! the argument of c_loc (zvec) is a pointer or has the "target" attribute
+ !
+ TYPE (c_ptr) :: cp
+ REAL(dp), POINTER :: rvec(:)
+ INTEGER :: n, ndim
+ !
+ NULLIFY (rvec)
+ cp = c_loc(zvec)
+ CALL c_f_pointer (cp, rvec, shape(zvec)*[2])
CALL xmlw_opentag (name, ierr )
- WRITE( xmlunit, *) zvec
+ ndim = SIZE (zvec)
+ DO n=1,2*ndim,2
+ WRITE( xmlunit, *) rvec(n), rvec(n+1)
+ END DO
CALL xmlw_closetag ( )
!
END SUBROUTINE writetag_zv
!
SUBROUTINE writetag_zm (name, zmat, ierr )
!
- ! As writetag_c, for a matrix of complex values
+ ! As writetag_c for a matrix of complex values - see comments in writetag_zv
!
+ USE iso_c_binding
CHARACTER(LEN=*), INTENT(IN) :: name
- COMPLEX(dp), INTENT(IN) :: zmat(:,:)
- INTEGER, INTENT(OUT),OPTIONAL :: ierr
+ COMPLEX(dp), INTENT(IN), TARGET:: zmat(:,:)
+ INTEGER, INTENT(OUT), OPTIONAL :: ierr
+ !
+ TYPE (c_ptr) :: cp
+ REAL(dp), POINTER :: rmat(:,:)
+ INTEGER :: n, nvec
+ !
+ NULLIFY (rmat)
+ cp = c_loc(zmat)
+ CALL c_f_pointer (cp, rmat, shape(zmat)*[2,1])
!
CALL xmlw_opentag (name, ierr )
- WRITE( xmlunit, *) zmat
+ WRITE( xmlunit, *) rmat
CALL xmlw_closetag ( )
!
END SUBROUTINE writetag_zm
@@ -455,7 +518,9 @@ CONTAINS
WRITE (xmlunit, "(' ')", ADVANCE="no", ERR=10)
END DO
WRITE (xmlunit, "('<',A)", ADVANCE="no", ERR=10) trim(name)
- ! print '("opened at level ",i1," tag ",A)', nlevel, trim(open_tags(nlevel))
+#if defined ( __debug )
+ print '("opened (write) level-",i1," tag ",A)', nlevel, trim(open_tags(nlevel))
+#endif
!
! attributes (if present)
!
@@ -478,24 +543,35 @@ CONTAINS
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: tag
INTEGER :: i
!
- IF ( nlevel < 0 ) &
- print '("severe error: closing tag that was never opened")'
+ IF ( nlevel < 0 ) print "('severe error: closing tag that was never opened')"
IF ( .NOT.PRESENT(tag) ) THEN
DO i=2,nlevel
WRITE (xmlunit, '(" ")', ADVANCE='NO')
END DO
WRITE (xmlunit, '("")') trim(open_tags(nlevel))
+#if defined ( __debug )
+ print '("closed (write) level-",i1," tag ",A)', nlevel, trim(open_tags(nlevel))
+#endif
ELSE
i = len_trim(tag)
IF ( i == 0 ) THEN
WRITE (xmlunit, '("/>")')
+#if defined ( __debug )
+ print '("closed (write) level-",i1," tag ",A)', &
+ nlevel, trim(open_tags(nlevel))
+#endif
ELSE IF ( i == 1 .AND. tag(1:1) == '?' ) THEN
WRITE (xmlunit, '("?>")')
+#if defined ( __debug )
+ print '("closed (write) level-",i1," tag ",A)', nlevel, tag
+#endif
ELSE
WRITE (xmlunit, '("")') trim(tag)
+#if defined ( __debug )
+ print '("closed (write) level-",i1," tag ",A)', nlevel, tag
+#endif
END IF
END IF
- !print '("closed at level ",i1," tag ",A)', nlevel, trim(open_tags(nlevel))
nlevel = nlevel-1
!
END SUBROUTINE xmlw_closetag
@@ -586,6 +662,26 @@ CONTAINS
!
END SUBROUTINE readtag_i
!
+ SUBROUTINE readtag_iv (name, ivec, ierr)
+ !
+ ! As readtag_c, for a vector of integer values
+ !
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER, INTENT(OUT) :: ivec(:)
+ INTEGER, INTENT(OUT),OPTIONAL :: ierr
+ INTEGER :: ier_
+ !
+ CALL xmlr_opentag (name, ier_)
+ if ( ier_ == 0 ) then
+ READ(xmlunit, *) ivec
+ CALL xmlr_closetag ( )
+ else
+ ivec = 0.0_dp
+ end if
+ IF ( present (ierr) ) ierr = ier_
+ !
+ END SUBROUTINE readtag_iv
+ !
SUBROUTINE readtag_l (name, lval, ierr )
!
! As readtag_c, for logical value
@@ -684,16 +780,23 @@ CONTAINS
!
SUBROUTINE readtag_zv (name, zvec, ierr)
!
- ! As readtag_c, for a vector of complex values
+ ! As readtag_c, for a vector of complex values - see comments in writetag_zv
!
+ USE iso_c_binding
CHARACTER(LEN=*), INTENT(IN) :: name
- COMPLEX(dp), INTENT(OUT) :: zvec(:)
+ COMPLEX(dp), INTENT(OUT), target :: zvec(:)
INTEGER, INTENT(OUT),OPTIONAL :: ierr
+ !
+ TYPE (c_ptr) :: cp
+ REAL(dp), POINTER :: rvec(:)
INTEGER :: ier_
!
CALL xmlr_opentag (name, ier_)
if ( ier_ == 0 ) then
- READ(xmlunit, *) zvec
+ NULLIFY (rvec)
+ cp = c_loc(zvec)
+ CALL c_f_pointer ( cp, rvec, shape(zvec)*[2])
+ READ( xmlunit, *) rvec
CALL xmlr_closetag ( )
else
zvec = 0.0_dp
@@ -704,16 +807,22 @@ CONTAINS
!
SUBROUTINE readtag_zm (name, zmat, ierr)
!
- ! As readtag_c, for a matrix of complex values
+ ! As readtag_c, for a matrix of complex values - see comments in writetag_zv
!
+ USE iso_c_binding
CHARACTER(LEN=*), INTENT(IN) :: name
- COMPLEX(dp), INTENT(OUT) :: zmat(:,:)
+ COMPLEX(dp), INTENT(OUT), target :: zmat(:,:)
INTEGER, INTENT(OUT),OPTIONAL :: ierr
+ TYPE (c_ptr) :: cp
+ REAL(dp), POINTER :: rmat(:,:)
INTEGER :: ier_
!
CALL xmlr_opentag (name, ier_)
if ( ier_ == 0 ) then
- READ(xmlunit, *) zmat
+ NULLIFY (rmat)
+ cp = c_loc(zmat)
+ CALL c_f_pointer (cp, rmat, shape(zmat)*[2,1])
+ READ(xmlunit, *) rmat
CALL xmlr_closetag ( )
else
zmat = 0.0_dp
@@ -734,44 +843,64 @@ CONTAINS
! 1: error parsing file
! 2: error in arguments
!
- integer :: i, j, lt
+ integer :: i, j, lt, ll
character(len=1) :: endtag
!
call xmlr_opentag ( tag, ierr )
!
- if ( eot > 0 ) then
- j = eot
- lt = len_trim(tag)
- ! beginning of val at line(j:j): search for end tag
- i = index ( line(j:), ' not found on this line
- ! print *, 'tag not found'
- ierr = 1
- return
- else
- ! maybe found end tag?
- endtag = adjustl( line(j+i+1+lt:) )
- if ( endtag /= '>' ) then
- ! print *, 'tag ',trim(tag),' not correctly closed'
- if (present(ierr)) ierr = 1
- else
- ! val found, exit
- cval = adjustl(trim(line(j:j+i-2)))
- ! print *, 'value=',cval
- end if
- ! print '("closed at level ",i1," tag ",A)', nlevel, trim(open_tags(nlevel))
- nlevel = nlevel -1
- !
- return
- !
- endif
- else if ( eot == 0 ) then
+ cval = ''
+ if ( eot < 0 ) then
! print *, 'end of file reached, tag not found'
if ( present(ierr) ) ierr =-1
- else if ( eot < 0 ) then
+ return
+ else if ( eot == 0 ) then
! print *, 'tag found, no value to read on line'
- cval = ''
+ return
+ else
+ ! scan current line if there is something after the end of tag
+ ! (variable "eot"); read a new line otherwise
+ do while(.true.)
+ if ( eot > len_trim(line) ) then
+ read(xmlunit,'(a)', end=10) line
+ j = 1
+ else
+ j = eot
+ end if
+ ! beginning of val at line(j:j): search for end tag
+ i = index ( line(j:), ' not found on this line: read value and continue
+ cval = trim(cval) // adjustl(trim(line(j:)))
+ else
+ ! possible end tag found
+ lt = len_trim(tag)
+ endtag = adjustl( line(j+i+1+lt:) )
+ if ( endtag /= '>' ) then
+ ! print *, 'tag ',trim(tag),' not correctly closed'
+ if (present(ierr)) ierr = 1
+ else
+ ! end of tag found, read value (if any) and exit
+ if ( i > 1 ) cval = trim(cval) // adjustl(trim(line(j:j+i-2)))
+ ! print *, 'value=',cval
+ end if
+#if defined ( __debug )
+ print '("closed (read) level-",i1," tag ",A)', &
+ nlevel, trim(open_tags(nlevel))
+#endif
+ nlevel = nlevel -1
+ !
+ return
+ !
+ endif
+ !
+ end do
+ !
+ end if
+ ! print *, 'tag not found'
+10 if ( present(ierr) ) then
+ ierr = 1
+ else
+ print *, 'end of file reached, tag not found'
end if
!
end subroutine readtag_c
@@ -788,7 +917,7 @@ CONTAINS
! 2: line too long
! 3: too many levels of tags
!
- integer :: stat, ll, lt, i, j, j0
+ integer :: stat, ntry, ll, lt, i, j, j0
! stat= 0: begin
! stat=-1: in comment
! stat=1 : tag found
@@ -796,16 +925,18 @@ CONTAINS
character(len=1) :: quote
!
nattr=0
+ ntry =0
if ( allocated(attrlist) ) deallocate (attrlist)
- !
lt = len_trim(tag)
+ !
+ 1 ntry = ntry+1
stat=0
- eot =0
+ eot =-1
do while (.true.)
read(xmlunit,'(a)', end=10) line
ll = len_trim(line)
if ( ll == maxline ) then
- print *, 'line too long'
+ print *, 'severe error: line too long'
if (present(ierr)) ierr = 2
return
end if
@@ -840,11 +971,12 @@ CONTAINS
! tag found? check what follows our would-be tag
j = j+i+lt
if ( j > ll ) then
- print *, 'oops... opened tag not closed on same line'
+ stat = 1
+ ! ' &
.or. line(j:j+1)=='/>') then
- ! print *, ' or found
stat = 1
end if
end if
@@ -859,29 +991,26 @@ CONTAINS
else if ( line(j:j+1) == '/>' ) then
! found : return
if (present(ierr)) ierr = 0
- ! eot = -2: tag with no value found
- eot = -2
+ ! eot = 0: tag with no value found
+ eot = 0
!
return
!
else if ( line(j:j) == '>' ) then
! found
- if ( j+1 > ll ) then
- ! eot = -1: tag found, line ends
- eot = -1
- else
- ! eot points to the rest of the line
- eot = j+1
- end if
+ ! eot points to the rest of the line
+ eot = j+1
if (present(ierr)) ierr = 0
nlevel = nlevel+1
IF ( nlevel > maxlevel ) THEN
- print *, ' too many levels'
+ print *, ' severe error: too many levels'
if (present(ierr)) ierr = 3
else
open_tags(nlevel) = trim(tag)
- !print '("opened at level ",i1," tag ",A)', &
- ! nlevel, trim(open_tags(nlevel))
+#if defined ( __debug )
+ print '("opened (read) level-",i1," tag ",A)',&
+ nlevel, trim(open_tags(nlevel))
+#endif
end if
!
return
@@ -923,11 +1052,16 @@ CONTAINS
10 if ( stat == 0 ) then
if ( present(ierr) ) then
ierr =-1
+ ! quick-and-dirty pseudo-fix to deal with tags not found:
+ ! rewind and try again - will work if the desired tag is
+ ! found above the current position (and nowhere else)
+ rewind(xmlunit)
+ if ( ntry == 1 ) go to 1
else
print *, 'end of file reached, tag '//trim(tag)//' not found'
end if
else
- print *, 'parsing error'
+ print *, 'severe parsing error'
if ( present(ierr) ) ierr = 1
end if
!
@@ -948,16 +1082,22 @@ CONTAINS
! stat= 0: begin
! stat= 1: end
!
- IF ( nlevel < 0 ) &
+ if ( nlevel < 0 ) &
print '("severe error: closing tag that was never opened")'
stat=0
- !write(6,'("closing at level ",i1," tag ",A,"...")',advance='no') &
- ! nlevel,trim(open_tags(nlevel))
+#if defined ( __debug )
+ if ( .not. present(tag) ) then
+ print '("closed (read) level-",i1," tag ",A)', &
+ nlevel, trim(open_tags(nlevel))
+ else
+ print '("closed (read) level-",i1," tag ",A)', nlevel, tag
+ end if
+#endif
do while (.true.)
read(xmlunit,'(a)', end=10) line
ll = len_trim(line)
if ( ll == maxline ) then
- print *, 'line too long'
+ print *, 'Fatal error: line too long'
if (present(ierr)) ierr = 1
return
end if
@@ -996,10 +1136,11 @@ CONTAINS
! tag found? check what follows our would-be tag
j = j+i+1+lt
if ( j > ll ) then
- print *, 'oops... opened tag not closed on same line'
+ stat = 1
+ ! ') then
- ! print *, ' found
stat = 1
end if
end if