Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
29253 Discussions

I/O formatting - read data separated by blank or dash characters

h_amini
Beginner
‎04-27-2009 10:15 AM
2,170 Views

I need to read data lines on which there are positive integer numbers between two forward slashes (two slashes on each line). They are separated by one dash or an unknown number of blank characters, e.g. / 1 30 45-47 105 /

The dash separator represents a series of continues integers including the numbers just before and after the dash, in the above example: 45, 46 and 47. So in the example all the data must be read are: 1 , 30, 45, 46, 47 and 105 (the number of the integers on each lineand their digits are unknown).

My solution is to read each line as a character variable, then to scan the line letter by letter using internal reads. So I can find the number of the integers first, allocate my arrays and restart scanning to record the numbers. For this purpose I need to record the begging and end columns of each integer to read with variable format expressions.

Id appreciate any comment.

Many thanks

Hamid

0 Kudos

Link Copied

8 Replies
bmchenry
New Contributor II
‎04-27-2009 02:18 PM
2,170 Views
your question reminds me of some old code from mainframe/mini computer daze, and so i am uploading a read1/read2 routine which parses a character array for up to 12 numbers.
it was a FOR file soI quickly converted to f90 with SPAG.
Thisupload is mainly to assist you in the many issues related to parsing a character array for numbers (real or integer)
obviously there are tools/functions which can clean this up, but it's a start!
enjoy!

brian

[cpp]      SUBROUTINE READ1(Value,Icode)
      IMPLICIT NONE
      INTEGER :: Icode
      REAL , DIMENSION(12) :: Value
      INTENT (OUT) Icode
!
! Local variables
!
      INTEGER :: i , j , jcode , jst , nword
      INTEGER , DIMENSION(12) :: iend , istart
      CHARACTER(1) :: jblnk , jbs , jcomma , jqm
      CHARACTER(1) , DIMENSION(80) :: line
!
!*** End of declarations rewritten by SPAG
!
!*		          SUBROUTINE READ1(VALUE,ICODE)		      
!*            FUNCTION: READS A LINE OF CHARACTERS AND EXTRACTS UP TO 12	 
!*	                NUMBERS FROM THAT LINE.				       
!*	                USER IS EXPECTED TO SEPARATE NUMBERS BY BLANKS OR COMMAS.
!*	                ANY ERRORS DETECTED WILL ONLY CAUSE A RETURN CODE, NOT   
!*	                THE RUN TERMINATION WITH REGULAR FORTRAN I/O PROCESSING. 
!*	                THUS, THIS IS AN IDIOT-PROOF WAY TO ENTER NUMERIC DATA   
!*	                VIA THE KEYBOARD. 				       
!*            PARAMETERS: VALUE(12)----- ARRAY CONTAINING THE ENTERED NUMBERS.   
!*		ICODE--------- RETURN CODE: 1-12 = # OF VALID ENTRIES  
!*					                 0 = BLANK LINE ENTERED  
!*					                -1 = QUESTION MARK FOUND 
!*					                -2 = BACKSPACE FOUND     
!*					              -999 = SYNTAX ERROR        
!*            PROCEDURE:	VARIABLES ARE INITIALIZED.			       
!*		A           LINE OF CHARACTERS IS READ WITH 80A1 FORMAT.	       
!*		THE           ENTERED LINE IS SCANNED FOR ? OR $ COMMAND CODES.  
!*		A           DECIMITER SCAN FINDS THE START AND END OF EACH FIELD.
!*		A           LITTLE LOOP CALLS READ2 TO INTERPRET EACH FIELD.     
!*		VALID           DATA ITEMS ARE LOADED INTO ARRAY VALUE.	       
!*		ANY           ERRORS CAUSE AN IMMEDIATE RETURN WITH THE	       
!*		APPROPRIATE RETURN CODE.			       
!*            VARIABLES USED: VALUE(12)------ ARRAY OF ENTERED NUMBERS	       
!*		              ICODE---------- SUBROUTINE RETURN CODE	       
!*		              ISTART(12)----- ARRAY OF FIELD STARTING LOCATIONS  
!*		              IEND(12)------- ARRAY OF FIELD ENDING LOCATIONS    
!*		              LINE(80)------- ARRAY TO HOLD 80 CHARACTER LINE    
!*		              JST------------ 0=LOOKING FOR START OF NUMBER      
!*				              1=LOOKING FOR END OF NUMBER        
!*		              NWORD---------- # OF NUMBERS ENTERED	       
!*		              JQM------------ QUESTION MARK CHARACTER (A1)       
!*		              JBS------------ BACKSPACE CHARACTER (A1)	       
!*		              JBLNK---------- BLANK SPACE CHARACTER (A1)	       
!*		              JCOMMA--------- COMMA CHARACTER (A1)	       
!*		              JCODE---------- SUBROUTINE READ2 RETURN CODE)      
      DATA jblnk/' '/ , jqm/'?'/ , jbs/'$'/ , jcomma/','/
!
!             INITIALIZE ALL ARRAYS
!
      DO j = 1 , 12
         istart(j) = 0
         iend(j) = 0
         Value(j) = 0.0
      ENDDO
      DO j = 1 , 80
         line(j) = jblnk
      ENDDO
!
!             READ A LINE OF CHARACTERS
!
      READ (5,10010) (line(j),j=1,80)
10010 FORMAT (80A1)
!
!             SCAN ENTIRE LINE FOR QUESTION MARK (?) OR BACKSPACE ($)
!
      DO j = 1 , 80
         IF ( line(j)==jqm ) THEN
            Icode = -1
            RETURN
         ELSEIF ( line(j)==jbs ) THEN
            Icode = -2
            RETURN
         ELSE
         ENDIF
      ENDDO
      DO
!
!             DELIMITER SCAN
!
         jst = 0
         nword = 0
         DO j = 1 , 80
            IF ( jst==1 ) THEN
               IF ( line(j)/=jblnk ) THEN
                  IF ( line(j)/=jcomma ) THEN
                     IF ( j<72 ) THEN
                        CYCLE
                     ENDIF
                  ENDIF
               ENDIF
               iend(nword) = j - 1
               jst = 0
            ELSEIF ( line(j)/=jblnk ) THEN
               IF ( line(j)/=jcomma ) THEN
                  nword = nword + 1
                  IF ( nword>12 ) GOTO 200
                  istart(nword) = j
                  jst = 1
                  IF ( j>=80 ) THEN
                     iend(nword) = j
                     jst = 0
                     GOTO 100
                  ENDIF
               ENDIF
            ELSE
            ENDIF
         ENDDO
         IF ( nword/=0 ) THEN
!
!             USING THE LOCATED FIELDS, CALL READ2 TO CONSTRUCT THE NUMBER
!
            DO i = 1 , nword
               CALL READ2(line,Value(i),istart(i),iend(i),jcode)
               IF ( jcode==-999 ) GOTO 200
            ENDDO
            Icode = nword
            RETURN
         ELSE
            Icode = 0
            RETURN
         ENDIF
 100  ENDDO
!
!             ERROR SECTION HERE
!
 200  Icode = -999
      END SUBROUTINE READ1
      SUBROUTINE READ2(Line,Result,Jstart,Jend,Icode)
      IMPLICIT NONE
!
! Dummy arguments
!
      INTEGER :: Icode , Jend , Jstart
      REAL :: Result
      CHARACTER(1) , DIMENSION(80) :: Line
      INTENT (IN) Jend , Jstart , Line
      INTENT (OUT) Icode , Result
!
! Local variables
!
      INTEGER :: ex , idigit , j , jdigit , jdone , jexp , jmine , jminf , jpl , jpluse , jplusf ,  &
               & jpoint , nex , se , x
      REAL , INTRINSIC :: FLOAT
      CHARACTER(1) :: iblnk , idecpt , iexp , iexpd , iminus , iplus , jchar
      CHARACTER(1) , DIMENSION(10) :: itable
      INTEGER , DIMENSION(10) :: jtable
      REAL :: sx
!
!*** End of declarations rewritten by SPAG
!
!*	           SUBROUTINE  READ2(LINE,RESULT,JSTART,JEND,ICODE)        
!*            PURPOSE: PERMITS IDIOT-PROOF READING OF A FIELD OF NUMERIC DATA.   
!*	               IF REGULAR FORTRAN NUMERIC I/O IS USED, THE USER MAY      
!*	               INADVERTANTLY MAKE A SPELLING ERROR AND CAUSE THE FORTRAN 
!*	               I/O PROCESSOR TO TERMINATE THE RUN WITH A DIAGNOSTIC.     
!*	               TO CIRCUMVENT THIS, SUBROUTINE READ2 SCANS A FIELD OF     
!*	               CHARACTERS AND CONSTRUCTS THE DESIRED NUMERIC ITEM.       
!*	               IF AN ERROR IS MADE, A RETURN CODE IS SET. 	       
!*            PARAMETERS: LINE---------- 80 CHARACTER ARRAY OF A1 FORMAT LITERAL 
!*			                 DATA PREVIOUSLY READ IN. 	       
!*								                 
!*		RESULT-------- THE ANSWER IN FLOATING POINT.	       
!*								                 
!*		JSTART-------- POSITION AT WHICH THE FIELD STARTS.     
!*								                 
!*		JEND---------- POSITION AT WHICH THE FIELD ENDS.       
!*								                 
!*		ICODE--------- RETURN CODE  -999 = ERROR	       
!*					                 0 = FIELD IS EMPTY      
!*					                 1 = VALID RESULT        
!*								                 
!*            CONVENTIONS: ANY VALID INTEGER OR FLOATING POINT NUMBER MAY BE     
!*		           ENTERED IN THE FIELD.				 
!*		           EMBEDDED BLANKS,INCOMPLETE NUMBERS,AND ILLEGAL        
!*		           CHARACTERS WILL CAUSE AN ERROR RETURN CODE.	       
!*								               
!*		           EXAMPLES OF VALID NUMBERS:  1527		       					              -1527.31		       *
!*					              -1527.31E-3 	       
!*					              -.312E5		       
!*								               
!*            SYMBOLS: SX-------- SIGN OF FRACTIONAL PART 		       
!*	               SE-------- SIGN OF EXPONENTIAL PART		       
!*	               X--------- FINAL FRACTIONAL PART			       
!*	               EX-------- FINAL EXPONENTIAL PART			
!*	               NEX------- # OF DECIMAL PLACES IN FRACTIONAL PART	
!*	               JPLUSF---- + SIGN FLAG (FRACTIONAL)      0 = LEGAL        
!*						                1 = NOT ALLOWED  
!*	               JMINF----- - SIGN FLAG (FRACTIONAL)      0 = LEGAL        
!*						                1 = NOT ALLOWED  
!*	               JPLUSE---- + SIGN FLAG (EXPONENTIAL)     0 = LEGAL        
!*						                1 = NOT ALLOWED  
!*	               JMINE----- - SIGN FLAG (EXPONENTIAL)     0 = LEGAL        
!*						                1 = NOT ALLOWED  
!*	               JPOINT---- DECIMAL POINT FLAG  0 = NO POINT FOUND	 
!*					              1 = DECIMAL POINT FOUND    
!*	               JEXP------ EXPONENT FLAG  0 = NO EXPONENT		 
!*				                 1 = EXPONENT FOUND	       
!*	               JDIGIT---- DIGIT FLAG  0 = NO DIGITS FOUND 	       
!*				              1 = FRACTIONAL DIGITS FOUND        
!*				              2 = EXPONENTIAL DIGITS FOUND       
!*	               JDONE----- FIELD COMPLETION FLAG 0 = FIELD NOT FINISHED   
!*					                1 = NUMBER DONE	       
!*	               ICODE----- SUBROUTINE RETURN CODE (SEE PARAMETER LIST)    
!*	               JCHAR----- SCALAR VERSION OF CURRENT CHARACTER	       
!*	               LINE(80)-- 80A1 FIELD OF CHARACTERS		       
!*	               ITABLE(10,2)- LOOKUP TABLE  CHARACTER-TO-NUMERALS	       
!*	               IDIGIT---- NUMERIC EQUIVALENT OF CHARACTER 	       
!*	               J--------- FIELD POSITION COUNTER			       
!*	               IBLNK----- BLANK CHARACTER 			       
!*	               IPLUS----- PLUS CHARACTER				       
!*	               IMINUS---- MINUS CHARACTER 			       
!*	               IDECPT---- DECIMAL POINT CHARACTER 		       
!*	               IEXP------ EXPONENT MARK 'E'                              
!*	               IEXPD----- EXPONENT MARK 'D'                              
!*	               RESULT---- FLOATING POINT RESULT			       
!*								                 
!*              SPECIAL THANKS TO GENE BUTLER FOR ASSISTANCE ON THIS	       
!*              SUBROUTINE.						       
!
      DATA iblnk/' '/ , iplus/'+'/ , iminus/'-'/ , idecpt/'.'/ , iexp/'E'/ , iexpd/'D'/
      DATA itable/'0' , '1' , '2' , '3' , '4' , '5' , '6' , '7' , '8' , '9'/
      DATA jtable/0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9/
!
!             INITIALIZE ALL DATA
!
      Icode = 0
      jplusf = 0
      jpluse = 0
      jminf = 0
      jmine = 0
      jpoint = 0
      jexp = 0
      jdigit = 0
      jdone = 0
      se = 1
      nex = 0
      x = 0
      ex = 0
      j = 1
      sx = 1.0
      Result = 0.0
!
!             FETCH THE NEXT CHARACTER
!
 100  jchar = Line(Jstart+j-1)
!
!             IS THE CHARACTER A BLANK ?
!
!             NOTE: BLANKS ARE IGNORED TILL THE NUMBER STARTS.
!	AFTER             THAT, THE APPEARANCE OF A BLANK WILL END THE FIELD.
!
      IF ( jchar/=iblnk ) THEN
!
!             IS THE CHARACTER A PLUS SIGN?
!
!             NOTE: IF THE FIELD IS FINISHED, A PLUS SIGN WILL SET AN ERROR CODE.
!	IF              (JPLUSF,JMINF,JEXP = 0)    THIS IS THE FRACTION SIGN
!	IF             (JPLUSE,JMINE = 0, JEXP = 1)  THIS IS THE EXPONENT SIGN
!	ANYTHING             ELSE WILL CAUSE AN ERROR.
!
         IF ( jchar==iplus ) THEN
            IF ( jdone/=1 ) THEN
               IF ( (jplusf==0) .AND. (jminf==0) .AND. (jexp==0) ) THEN
                  sx = 1.0
                  jplusf = 1
                  GOTO 200
               ELSEIF ( (jpluse==0) .AND. (jmine==0) .AND. (jexp==1) ) THEN
                  se = 1
                  jpluse = 1
                  GOTO 200
               ELSE
               ENDIF
            ENDIF
            Icode = -999
            RETURN
!
!             IS THE CHARACTER A MINUS SIGN?
!
!             NOTE: IF THE FIELD IS FINISHED, A MINUS SIGN WILL CAUSE AN ERROR.
!	IF              (JPLUSF,JMINF,JEXP = 0)    THIS IS THE FRACTION SIGN
!	IF             (JPLUSE,JMINE = 0, JEXP = 1)  THIS IS THE EXPONENT SIGN
!	ANYTHING             ELSE IS AN ERROR.
!
         ELSEIF ( jchar==iminus ) THEN
            IF ( jdone/=1 ) THEN
               IF ( (jplusf==0) .AND. (jminf==0) .AND. (jexp==0) ) THEN
                  sx = -1.0
                  jminf = 1
                  GOTO 200
               ELSEIF ( (jpluse==0) .AND. (jmine==0) .AND. (jexp==1) ) THEN
                  se = -1
                  jmine = 1
                  GOTO 200
               ELSE
               ENDIF
            ENDIF
            Icode = -999
            RETURN
!
!             IS THE CHARACTER A DECIMAL POINT
!
!             NOTE: IF FIELD IS FINISHED, A DECIMAL POINT WILL CAUSE AN ERROR.
!	DECIMAL             POINTS ARE ONLY ALLOWED IN THE FRACTIONAL PART.
!
         ELSEIF ( jchar==idecpt ) THEN
            IF ( jdone/=1 ) THEN
               IF ( (jpoint==0) .AND. (jexp==0) ) THEN
                  jpoint = 1
                  jplusf = 1
                  jminf = 1
                  GOTO 200
               ENDIF
            ENDIF
            Icode = -999
            RETURN
!
!             IS THE CHARACTER AN 'E' OR A 'D'?
!
!             NOTE: IF THE FIELD IS FINISHED, AN EXPONENT WILL CAUSE AN ERROR.
!	ONLY             ONE EXPONENT MARK IS ALLOWED.
!
         ELSEIF ( (jchar/=iexp) .AND. (jchar/=iexpd) ) THEN
!
!             IS THE CHARACTER A VALID NUMERAL?
!
!             NOTE: IF THE FIELD IS FINISHED, A NUMERAL WILL CAUSE AN ERROR.
!	USE             THE LOOKUP-TABLE TO GET THE NUMERIC EQUIVALENT.
!
            DO jpl = 1 , 10
               IF ( jchar==itable(jpl) ) THEN
                  idigit = jtable(jpl)
                  IF ( jdone==1 ) THEN
                     EXIT
                  ENDIF
                  IF ( jexp==1 ) THEN
!
!             IF WE'RE DOING THE EXPONENTIAL PART, GET THE RUNNING EXPONENT.
!
                     ex = ex*10 + idigit
                     jdigit = 2
                     jpluse = 1
                     jmine = 1
                  ELSE
!
!             IF WE'RE DOING THE FRACTIONAL PART, GET THE RUNNING ANSWER.
!
                     x = x*10 + idigit
                     nex = nex + jpoint
                     jdigit = 1
                     jplusf = 1
                     jminf = 1
                  ENDIF
                  GOTO 200
               ENDIF
            ENDDO
            Icode = -999
            RETURN
         ELSE
            IF ( jdone/=1 ) THEN
               IF ( jexp==0 ) THEN
                  jexp = 1
                  jpoint = 1
                  jplusf = 1
                  jminf = 1
                  GOTO 200
               ENDIF
            ENDIF
            Icode = -999
            RETURN
         ENDIF
      ELSEIF ( (jplusf/=0) .OR. (jminf/=0) .OR. (jpluse/=0) .OR. (jmine/=0) .OR. (jpoint/=0) .OR.   &
             & (jexp/=0) .OR. (jdigit/=0) ) THEN
         jdone = 1
      ELSE
      ENDIF
!
!             SEE IF THE END-OF-THE-FIELD HAS BEEN REACHED?
!
 200  IF ( (Jstart+j-1)/=Jend ) THEN
         j = j + 1
         GOTO 100
!
!             END-OF-FIELD HAS BEEN REACHED.
!
!             NOTE: CHECK IF ENTIRE FIELD WAS COMPLETELY BLANK.
!	CHECK             IF ANY DIGITS AT ALL WERE ENCOUNTERED
!	CHECK             IF THE EXPONENTIAL PART HAD ANY DIGITS.
!
      ELSEIF ( (jplusf==0) .AND. (jminf==0) .AND. (jpluse==0) .AND. (jmine==0) .AND. (jpoint==0)    &
             & .AND. (jexp==0) .AND. (jdigit==0) ) THEN
!
!             HANDLE BLANK FIELD HERE.
!
         Icode = 0
         RETURN
      ELSEIF ( jdigit>=1 ) THEN
         IF ( (jexp/=1) .OR. (jdigit==2) ) THEN
!
!             WORK OUT NUMERICAL RESULT HERE
!
            Result = sx*FLOAT(x)*10.0**(se*ex-nex)
            Icode = 1
            GOTO 99999
         ENDIF
      ELSE
      ENDIF
      Icode = -999
      RETURN
99999 END SUBROUTINE READ2
[/cpp]

0 Kudos
Copy link
h_amini
Beginner
‎04-28-2009 02:19 AM
2,170 Views
Quoting - bmchenry
your question reminds me of some old code from mainframe/mini computer daze, and so i am uploading a read1/read2 routine which parses a character array for up to 12 numbers.
it was a FOR file soI quickly converted to f90 with SPAG.
Thisupload is mainly to assist you in the many issues related to parsing a character array for numbers (real or integer)
obviously there are tools/functions which can clean this up, but it's a start!
enjoy!

brian

Appreciated very much. It is fairly similar to the subroutine I am writing.

Hamid

0 Kudos
Copy link
onkelhotte
New Contributor II
‎04-28-2009 03:56 AM
2,170 Views
Quoting - h.amini

Appreciated very much. It is fairly similar to the subroutine I am writing.

Hamid


I havent looked through the whole code of bmhenry...

I think all you need is "index" and "adjustl". The following code is written in this quote, I havent tested it in IVF, but it should work with a few modifications...

myCode is your line " 1 45-47 350 "

[cpp]character*255 tempstring, tempstring2,tempstring3
integer(kind=4) arraysize, dummyInt1, dummyInt2, posDash, arrayCounter, i
integer(kind=4), allocatable:: intArray(:)

arraysize = 0
read(tempstring,'(a)') myCode
! removing first 
tempstring = tempstring(index(tempstring,'')+1:)
tempstring = adjustl(tempstring)
read(tempstring2,'(a)') tempstring

! getting the arraysize
do while(tempstring(1) /= '')
! removing leading blanks
  read(tempstring3,'(a)') tempstring(:index(tempstring,' '))
  posDash = index(tempstring3,'-')
  if(posDash  == 0) then
    arraysize = arraysize + 1
  else
! reading start and endvalue (not sure if -1 is right...)
    read(dummyInt1,'(i)') tempstring3(:posDash-1)
    read(dummyInt2,'(i)') tempstring3(posDash:)
    arraysize = arraysize + (dummyInt2-dummyInt1+1)
  end if
! removing number(s)
  tempstring = tempstring(:index(tempstring,' '))
! remove leading blanks
  tempstring = adjustl(tempstring)
end do

! filling the array
if (arraySize > 0) then
  allocate intArray(arraySize))
  arrayCounter = 1
  do while(tempstring2(1) /= '')
! removing leading blanks
    read(tempstring3,'(a)') tempstring2(:index(tempstring2,' '))
    posDash = index(tempstring3,'-')
    if(posDash  == 0) then
      read(intArray(arrayCounter),'(i)') = tempstring2(:index(tempstring2,' '))
      arrayCounter = arrayCounter + 1
    else
! reading start and endvalue (not sure if -1 is right...)
      read(dummyInt1,'(i)') tempstring3(:posDash-1)
      read(dummyInt2,'(i)') tempstring3(posDash:)
      do i = dummyInt1,dummyInt2
        read(intArray(arrayCounter),'(i)') = i
        arrayCounter = arrayCounter + 1
      end do
    end if
! removing number(s)
    tempstring2 = tempstring(:index(tempstring2,' '))
! remove leading blanks
    tempstring2 = adjustl(tempstring2)
  end do
end if
[/cpp]
0 Kudos
Copy link
Les_Neilson
Valued Contributor II
‎04-28-2009 05:01 AM
2,170 Views

I didn't look closely but a couple of things caught my eye.

Minor points :
"" is "/" in the original

replace internal read for tempstring2 with
tempstring2 = tempstring.


read(tempstring3,'(a)') tempstring(:index(tempstring,' '))
(apart from being wrong way round) why not just
tempstring3 = adjustl(tempstring(:index(tempstring,' ')))

the adjustl above may not be needed as adjustl is done at end of the loop

The internal reads need swapping round e.g. :
should be
read(tempstring3(:posdash-1), '(i)' ) dummyInt1 ! format could be (*)
read(tempstring3(posDash+1:), '(i)' ) dummyInt2 ! Need to bypass thedash "-"

Les
0 Kudos
Copy link
h_amini
Beginner
‎04-28-2009 02:17 PM
2,170 Views
Quoting - Les Neilson

I didn't look closely but a couple of things caught my eye.

Minor points :
"" is "/" in the original

replace internal read for tempstring2 with
tempstring2 = tempstring.


read(tempstring3,'(a)') tempstring(:index(tempstring,' '))
(apart from being wrong way round) why not just
tempstring3 = adjustl(tempstring(:index(tempstring,' ')))

the adjustl above may not be needed as adjustl is done at end of the loop

The internal reads need swapping round e.g. :
should be
read(tempstring3(:posdash-1), '(i)' ) dummyInt1 ! format could be (*)
read(tempstring3(posDash+1:), '(i)' ) dummyInt2 ! Need to bypass thedash "-"

Les

Many thanks. You are right. The code needs modification. Please see post 6.

Hamid

0 Kudos
Copy link
h_amini
Beginner
‎04-28-2009 02:20 PM
2,170 Views
Quoting - onkelhotte

I havent looked through the whole code of bmhenry...

I think all you need is "index" and "adjustl". The following code is written in this quote, I havent tested it in IVF, but it should work with a few modifications...


Thank you very much for your kind consideration. It is possible not to have a blank character between the last number and the second "/". Also there are some data after the second slash, so I modified your code, but got a strange problem in getting the array size.

character*255 tempstring, tempstring1, tempstring2,tempstring3

character*255 tempstring4

character*255 dummyInt20

integer(kind=4) arraysize, dummyInt1, dummyInt2, posDash,

& arrayCounter, i

integer(kind=4), allocatable:: intArray(:)

arraysize = 0

OPEN(unit = 2, file = 'zread.dat')

READ (UNIT = 2, FMT = "(a)") tempstring

! removing first /

tempstring = tempstring(index(tempstring,'/')+1:)

! removing last /

tempstring = tempstring(:index(tempstring,'/')-1)

tempstring = adjustl(tempstring)

tempstring2 = tempstring

! getting the arraysize

do while(tempstring .NE. ' ')

! removing leading blanks

read(tempstring,'(a)') tempstring3(:index(tempstring,' '))

posDash = index(tempstring3,'-')

PRINT*, 'tempstring3',tempstring3,'posDash',posDash

if(posDash .EQ. 0) then

arraysize = arraysize + 1

else

! reading start and endvalue

tempstring3 = adjustl(tempstring3)

read(tempstring3(:posDash-1),'(i)') dummyInt1

PRINT*, 'dummyInt1',dummyInt1

10 read(tempstring3(posDash+1:),'(a)') tempstring4

20 PRINT*, 'tempstring4',tempstring4

30 read(tempstring3(posDash+1:),'(i)') dummyInt2

40 PRINT*, 'dummyInt2',dummyInt2

arraysize = arraysize + (dummyInt2-dummyInt1+1)

end if

! removing number(s)

tempstring = tempstring(index(tempstring,' '):)

tempstring = adjustl(tempstring)

end do

PRINT*, 'arraysize',arraysize

END

In reading a data file like / 12 30-132 33 45 / 3, the code cannot read the number after the dash (132). Using similar format it can be read with a string character (tempstring4), but not with the integer variable (dummyInt2). The error I get is:

forrtl: severe (64): input conversion error, unit -5, file Internal Formatted Re

Does anyone know what's wrong?

Many thanks

Hamid

0 Kudos
Copy link
onkelhotte
New Contributor II
‎04-29-2009 12:12 AM
2,170 Views
Your mistake is, that you want to store the character string "132 " in an integer variable. That causes your error.

You can do it that way:
30 read(tempstring3(posDash+1:index(tempstring,' ')),'(i)') dummyInt2

Markus
0 Kudos
Copy link
h_amini
Beginner
‎04-29-2009 02:41 AM
2,170 Views
Quoting - onkelhotte
Your mistake is, that you want to store the character string "132 " in an integer variable. That causes your error.

You can do it that way:
30 read(tempstring3(posDash+1:index(tempstring,' ')),'(i)') dummyInt2

Markus

Many thanks Markus. You are absolutely right!

Hamid

0 Kudos
Copy link
Reply

Community support is provided Monday to Friday. Other contact methods are available here.

Intel does not verify all solutions, including but not limited to any file transfers that may appear in this community. Accordingly, Intel disclaims all express and implied warranties, including without limitation, the implied warranties of merchantability, fitness for a particular purpose, and non-infringement, as well as any warranty arising from course of performance, course of dealing, or usage in trade.

For more complete information about compiler optimizations, see our Optimization Notice.