SUBROUTINE RDRM1(IFILE,NPTEMP,NETEMP,IMIDS) SAVE REAL*8 CX,CY CHARACTER DLINE*140,ID1*3,BLANK*20 DIMENSION ILN(8) data blank/' '/ REWIND (IFILE) READ(ifile,'(A80)') TITLE READ(IFILE,'(100X,I5)') IFORM1 READ(IFILE,'(A80)') DLINE(1:80) IMIDS=0 NP=0 NE=0 NPTEMP=0 NETEMP=0 100 CALL GINPT1(IFILE,DLINE) !ipk feb12 add format test IF(MOD(IFORM1,2) .EQ. 1) THEN READ(DLINE,'(10I6,F10.3,I6)') J,ILN,IMT,EDIR,INU ELSE READ(DLINE,'(10I5,F10.3,I5)') J,ILN,IMT,EDIR,INU ENDIF IF(ILN(1) .EQ. 0 .AND. (J .EQ. 9999 .OR. J .EQ. 99999)) THEN GO TO 120 ELSE IF(ILN(7) .NE. 0) THEN NCN=8 ELSEIF(ILN(5) .NE. 0) THEN NCN=6 ELSEIF(ILN(3) .NE. 0) THEN NCN=3 ENDIF DO K=1,NCN NPTEMP=MAX(NPTEMP,ILN(K)) NETEMP=MAX(NETEMP,J) IF(MOD(K,2) .EQ. 0 .AND. ILN(K) .EQ. 0) IMIDS=1 ENDDO GO TO 100 ENDIF 120 continue CALL GINPT1(IFILE,DLINE) IF(IFORM1 .LT. 2) THEN READ(DLINE,'(I10,9F10.0,I10,F10.0)') J, CX, CY, BELEV,& WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11 ELSE ! do kct=1,140 ! if(dline(kct:kct) .eq. '*') then do kcl=61,140 dline(kcl:kcl)=' ' enddo ! go to 8888 ! endif ! enddo !8888 continue READ(DLINE,'(I10,2F20.0,7F10.0,I10,F10.0)',err=8888) J, CX, CY, BELEV,& WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11 go to 8889 8888 do kcl=61,140 dline(kcl:kcl)=' ' enddo READ(DLINE,'(I10,2F20.0,7F10.0,I10,F10.0)') J, CX, CY, BELEV,& WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11 8889 continue ENDIF IF(DLINE(11:30) .eq. blank .AND. (J .EQ. 9999 .OR. J .EQ. 99999)) THEN GO TO 140 ELSE NPTEMP=MAX(NPTEMP,J) GO TO 120 ENDIF 140 CONTINUE REWIND(IFILE) RETURN END SUBROUTINE GINPT1(IIN,DLIN) CHARACTER DLIN*140 100 CONTINUE READ(IIN,7000) DLIN !IPK SEP08 write(75,7000) dlin 7000 FORMAT(A140) do i=1,140 if(dlin(i:i) .eq. char(9)) go to 200 enddo RETURN 200 continue !IPK SEP04 CLOSE(75) OPEN(75,file='ERROR.OUT') write(*,*) 'Error Tab character found in the following line' write(75,*) 'Error Tab character found in the following line' write(75,7000) dlin write(*,7000) dlin stop END