Skip to content

Commit

Permalink
correct sifdecode error for level 3 do loops
Browse files Browse the repository at this point in the history
  • Loading branch information
@nimgould
nimgould committed Nov 19, 2018
1 parent 119d3f0 commit 351844b
Showing 1 changed file with 45 additions and 35 deletions.
80 changes: 45 additions & 35 deletions src/decode/sifdecode.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1756,10 +1756,10 @@ SUBROUTINE INTERPRET_gpsmps( &
nuline = blnkln
IF ( fixed ) THEN
READ ( input, 1000, END = 810, ERR = 810 ) nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, TRIM( nuline )
ELSE
READ ( input, 1010, END = 810, ERR = 810 ) nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, TRIM( nuline )

! if the card is in free format, translate it into fixed format

Expand All @@ -1774,7 +1774,8 @@ SUBROUTINE INTERPRET_gpsmps( &
ilines = 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )

! there are only blank lines on the free format card

Expand All @@ -1789,7 +1790,8 @@ SUBROUTINE INTERPRET_gpsmps( &
ilines = ilines + 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )
END IF

! consider the header part of the card
Expand Down Expand Up @@ -3649,9 +3651,9 @@ SUBROUTINE INTERPRET_gpsmps( &
2960 FORMAT( /, ' From within do loop ending on line ', i5, &
', current line is ', /, &
2X, A2, 1X, A10, A10, 1P, D12.4, 3X, A10, D12.4 )
2970 FORMAT( ' Line ', i5, 4X, A160 )
2980 FORMAT( ' Line ', i5, '.', i2, 1X, A65 )
2990 FORMAT( ' Line ', i5, 4X, A65 )
2970 FORMAT( ' Line ', I7, 3X, A )
2980 FORMAT( ' Line ', I7, '.', I1, 1X, A )
2990 FORMAT( ' Line ', I7, 3X, A )
3000 FORMAT( /, ' Row names ', /, ' --------- ', /, 8( 1X, A8 ) )
3010 FORMAT( /, ' Column names ', /, ' ------------', /, 8( 1X, A8 ) )
3020 FORMAT( /, 3(' Col Row Value '), &
Expand Down Expand Up @@ -10361,10 +10363,10 @@ SUBROUTINE MAKE_elfun( input, out, outfn, outra, status, &
nuline = blnkln
IF ( fixed ) THEN
READ( input, 1000, END = 590, ERR = 590 ) nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, TRIM( nuline )
ELSE
READ( input, 1010, END = 590, ERR = 590 ) nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, TRIM( nuline )

! if the card is in free format, translate it into fixed format

Expand All @@ -10379,7 +10381,8 @@ SUBROUTINE MAKE_elfun( input, out, outfn, outra, status, &
ilines = 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )

! there are only blank lines on the free format card

Expand All @@ -10394,7 +10397,8 @@ SUBROUTINE MAKE_elfun( input, out, outfn, outra, status, &
ilines = ilines + 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )
END IF

! consider the header part of the card
Expand Down Expand Up @@ -11772,9 +11776,9 @@ SUBROUTINE MAKE_elfun( input, out, outfn, outra, status, &
2720 FORMAT( ' ** Exit from MAKE_elfun - field 3 not blank on', &
' A, F or G card ' )
2900 FORMAT( ' ' )
2970 FORMAT( ' Line ', i5, 4X, A160 )
2980 FORMAT( ' Line ', i5, '.', i2, 1X, A65 )
2990 FORMAT( ' Line ', i5, 4X, A65 )
2970 FORMAT( ' Line ', I7, 3X, A )
2980 FORMAT( ' Line ', I7, '.', I1, 1X, A )
2990 FORMAT( ' Line ', I7, 3X, A )
3000 FORMAT( ' SUBROUTINE ', A6, '( ', 5( A6, ', ' ), /, &
' * ', 5( A6, ', ' ), /, &
' * ', 5( A6, ', ' ), /, &
Expand Down Expand Up @@ -12289,10 +12293,10 @@ SUBROUTINE MAKE_elfun_ad( input, out, outff, outfd, outra, outem, &
nuline = blnkln
IF ( fixed ) THEN
READ ( input, 1000, END = 590, ERR = 590 ) nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, TRIM( nuline )
ELSE
READ ( input, 1010, END = 590, ERR = 590 ) nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, TRIM( nuline )

! if the card is in free format, translate it into fixed format

Expand All @@ -12307,7 +12311,8 @@ SUBROUTINE MAKE_elfun_ad( input, out, outff, outfd, outra, outem, &
ilines = 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )

! there are only blank lines on the free format card

Expand All @@ -12322,7 +12327,8 @@ SUBROUTINE MAKE_elfun_ad( input, out, outff, outfd, outra, outem, &
ilines = ilines + 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )
END IF

! consider the header part of the card
Expand Down Expand Up @@ -13953,9 +13959,9 @@ SUBROUTINE MAKE_elfun_ad( input, out, outff, outfd, outra, outem, &
2720 FORMAT( ' ** Exit from MAKE_elfun_ad - field 3 not blank on', &
' A, F or G card ' )
2900 FORMAT( ' ' )
2970 FORMAT( ' Line ', i5, 4X, A160 )
2980 FORMAT( ' Line ', i5, '.', i2, 1X, A65 )
2990 FORMAT( ' Line ', i5, 4X, A65 )
2970 FORMAT( ' Line ', I7, 3X, A )
2980 FORMAT( ' Line ', I7, '.', I1, 1X, A )
2990 FORMAT( ' Line ', I7, 3X, A )
3000 FORMAT( ' SUBROUTINE ', A6, '( ', 5( A6, ', ' ), /, &
' * ', 5( A6, ', ' ), /, &
' * ', 5( A6, ', ' ), /, &
Expand Down Expand Up @@ -14541,15 +14547,15 @@ SUBROUTINE MAKE_group( input, out, outgr, status, ngtype, ngpnames, &
nuline = blnkln
READ ( input, 1000, END = 590, ERR = 590 ) nuline
END IF
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, TRIM( nuline )
ELSE
IF ( gotlin ) THEN
gotlin = .FALSE.
ELSE
nuline = blnkln
READ ( input, 1010, END = 590, ERR = 590 ) nuline
END IF
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, TRIM( nuline )

! if the card is in free format, translate it into fixed format

Expand All @@ -14564,7 +14570,8 @@ SUBROUTINE MAKE_group( input, out, outgr, status, ngtype, ngpnames, &
ilines = 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )

! there are only blank lines on the free format card

Expand All @@ -14579,7 +14586,8 @@ SUBROUTINE MAKE_group( input, out, outgr, status, ngtype, ngpnames, &
ilines = ilines + 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )
END IF

! consider the header part of the card
Expand Down Expand Up @@ -15438,9 +15446,9 @@ SUBROUTINE MAKE_group( input, out, outgr, status, ngtype, ngpnames, &
2730 FORMAT( ' ** Exit from MAKE_group - field 2 or 3 not blank on', &
' A, F, G or H card ' )
2900 FORMAT( ' ' )
2970 FORMAT( ' Line ', i5, 4X, A160 )
2980 FORMAT( ' Line ', i5, '.', i2, 1X, A65 )
2990 FORMAT( ' Line ', i5, 4X, A65 )
2970 FORMAT( ' Line ', I7, 3X, A )
2980 FORMAT( ' Line ', I7, '.', I1, 1X, A )
2990 FORMAT( ' Line ', I7, 3X, A )
3000 FORMAT( ' SUBROUTINE ', A6, '( ', 5( A6, ', ' ), /, &
' * ', 5( A6, ', ' ), /, &
' * ', 4( A6, ', ' ), A6, ' )', /, &
Expand Down Expand Up @@ -15712,15 +15720,15 @@ SUBROUTINE MAKE_group_ad( input, out, outgf, outgd, outem, status, &
nuline = blnkln
READ ( input, 1000, END = 590, ERR = 590 ) nuline
END IF
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2990 ) lineno, TRIM( nuline )
ELSE
IF ( gotlin ) THEN
gotlin = .FALSE.
ELSE
nuline = blnkln
READ ( input, 1010, END = 590, ERR = 590 ) nuline
END IF
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2970 ) lineno, TRIM( nuline )

! if the card is in free format, translate it into fixed format

Expand All @@ -15735,7 +15743,8 @@ SUBROUTINE MAKE_group_ad( input, out, outgf, outgd, outem, status, &
ilines = 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )

! there are only blank lines on the free format card

Expand All @@ -15750,7 +15759,8 @@ SUBROUTINE MAKE_group_ad( input, out, outgf, outgd, outem, status, &
ilines = ilines + 1
nuline = blnkln
nuline = NULINA( ilines )
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) lineno, ilines, nuline
IF ( out > 0 .AND. debug ) WRITE( out, 2980 ) &
lineno, ilines, TRIM( nuline )
END IF

! consider the header part of the card
Expand Down Expand Up @@ -16807,9 +16817,9 @@ SUBROUTINE MAKE_group_ad( input, out, outgf, outgd, outem, status, &
2730 FORMAT( ' ** Exit from MAKE_group_ad - field 2 or 3 not blank on', &
' A, F, G or H card ' )
2900 FORMAT( ' ' )
2970 FORMAT( ' Line ', i5, 4X, A160 )
2980 FORMAT( ' Line ', i5, '.', i2, 1X, A65 )
2990 FORMAT( ' Line ', i5, 4X, A65 )
2970 FORMAT( ' Line ', I7, 3X, A )
2980 FORMAT( ' Line ', I7, '.', I1, 1X, A )
2990 FORMAT( ' Line ', I7, 3X, A )
3000 FORMAT( ' SUBROUTINE ', A6, '( ', 5( A6, ', ' ), /, &
' * ', 5( A6, ', ' ), /, &
' * ', 4( A6, ', ' ), A6, ' )', /, &
Expand Down

0 comments on commit 351844b

Please sign in to comment.