better large field support

Author: SteveDoyle2

Source/LK1/L1A/LOADB.f90

@@ -1123,9 +1123,15 @@ SUBROUTINE TO_UPPER_LINE(LINE)
       CHARACTER(26), parameter   :: LOW = 'abcdefghijklmnopqrstuvwxyz'
 
       DO I = 1,256
+          ! remove $
+          IF (LINE(I:I) == '$') THEN
+              LINE(I:) = ' '
+              GOTO 100 ! break
+          ENDIF
+
           J = index(LOW, LINE(I:I))      ! Is ith character in LOW
           IF (J>0) LINE(I:I) = UPP(J:J)  ! Yes, then subst with UPP
-      ENDDO
+  100 ENDDO
       END SUBROUTINE TO_UPPER_LINE
       !end function to_upper
 
@@ -1179,5 +1185,4 @@ SUBROUTINE READ_BDF_LINE(IN1, IOCHK, LINE)
   100 ENDDO
 
   101 FORMAT(A)
-      !write(err,*) 'returning:', LINE
       END SUBROUTINE READ_BDF_LINE

Source/LK1/L1U/NEXTC2.f90

@@ -65,7 +65,7 @@ SUBROUTINE NEXTC2 ( PARENT, ICONTINUE, IERR, CHILD )
       CHILD(1:) = 'z'
       OLDTAG(1:) = ' '
 
-      IERR  = 0
+      IERR = 0
 
       ! Make units for writing errors the error file and output file
       OUNT(1) = ERR
@@ -83,11 +83,30 @@ SUBROUTINE NEXTC2 ( PARENT, ICONTINUE, IERR, CHILD )
       IF (NEWTAG == OLDTAG) THEN
          ICONTINUE = 1
       ELSE IF ((OLDTAG(1:1) == '*') .AND. (NEWTAG(1:1) == ' ') .AND. (OLDTAG(2:8) == NEWTAG(2:8))) THEN
+         ! large field
          ICONTINUE = 1
       ELSE IF ((OLDTAG(1:1) == ' ') .AND. (NEWTAG(1:1) == '*') .AND. (OLDTAG(2:8) == NEWTAG(2:8))) THEN
+         ! large field
          ICONTINUE = 1
+      ELSE IF ((NEWTAG(1:1) /= '*') .AND. (NEWTAG(1:1) /= '$')) THEN
+         ! different card type (e.g., LOAD -> FORCE
+         BACKSPACE(IN1)
+         CARD = TCARD
+         RETURN
       ELSE
+         ! can't find the continuation marker.  FATAL :)
          BACKSPACE(IN1)
+         WRITE(F06,102) OLDTAG
+         WRITE(ERR,102) OLDTAG
+         WRITE(F06,103)
+         WRITE(ERR,103)
+         WRITE(F06,104) 'CHILD1:', CHILD1
+         WRITE(ERR,104) 'CHILD1:', CHILD1
+         FLUSH(F06)
+         FLUSH(ERR)
+         FATAL_ERR = FATAL_ERR + 1
+         CALL OUTA_HERE('Y')  ! FATAL error
+         RETURN
          RETURN
       ENDIF