Why Does This Fortran Code Result in an Infinite Loop?

debbieanne · Sep 9, 2015

I've inherited the code below. It's giving an infinite loop but I can't find what's causing it. This is code originally on OpenVMS written now for AIX. Can you help?

Code:

SUBROUTINE MREAD3(N_VESSEL,N_TRIP,N_ICNAF,N_SPECIES,N_DELSTR,
  +  N_SETDEL,N_SELSTR,VESSELS_TO_BE_SELECTED,
  +  TRIPS_TO_BE_SELECTED,ICNAF_TO_BE_SELECTED,
  +  SPECIES_TO_BE_SELECTED,STRATUM_TO_BE_DELETED,
  +  SETS_TO_BE_DELETED,STRATUM_TO_BE_SELECTED,
  +  IRECS,IER,IAREA,N_SEX,N_MALE_LFS,N_FEMALE_LFS,
  +  N_UNSEXED_LFS)

  INTEGER N_VESSEL,N_TRIP,N_ICNAF,N_SPECIES,N_DELSTR,N_SETDEL(20)
  INTEGER N_SELSTR,IRECS,IER,IAREA,N_SEX,N_MALE_LFS,N_FEMALE_LFS
  INTEGER N_UNSEXED_LFS
  CHARACTER*97 INSDE  INTEGER VESSELS_TO_BE_SELECTED(20)
  INTEGER TRIPS_TO_BE_SELECTED(2,20)
  CHARACTER*2 ICNAF_TO_BE_SELECTED(20)
  INTEGER STRATUM_TO_BE_DELETED(20)
  INTEGER SETS_TO_BE_DELETED(100,20)
  INTEGER STRATUM_TO_BE_SELECTED(100)
  INTEGER SPECIES_TO_BE_SELECTED(2)
  INTEGER STRATUM_IN_USE(100),ISTRATUM
  REAL LFS_TEMP(100,3)
  REAL PROP
  INTEGER SPECIES_CHK, STAT, ii
  CHARACTER*3 STRING2

  INTEGER CARD_TYPE
  INTEGER VESSEL
  INTEGER TRIP_NO
  INTEGER SET_NO
  INTEGER YEAR
  INTEGER MONTH
  INTEGER DAY
  INTEGER SET_TYPE
  INTEGER STRATUM
  CHARACTER*2 DIVISION
  CHARACTER*3 UNIT_AREA
  INTEGER LIGHT_CONDITION
  INTEGER WIND_DIRECTION
  INTEGER WIND_FORCE
  INTEGER SEA
  INTEGER BOTTOM_TYPE
  INTEGER TIME
  INTEGER DURATION

  INTEGER DISTANCE
  INTEGER OPERATION
  INTEGER DEPTH_MEAN
  INTEGER DEPTH_MIN
  INTEGER DEPTH_MAX
  INTEGER DEPTH_BOTTOM

  INTEGER TEMPERATURE_SURFACE

  INTEGER TEMPERATURE_FISHED
  INTEGER LATITUDE_DEG

  INTEGER LATITUDE_MIN
  INTEGER LONGITUDE_DEG

  INTEGER LONGITUDE_MIN
  INTEGER POSITION_METHOD
  INTEGER GEAR
  INTEGER SPECIES_CODE
  INTEGER SPECIES_NUMBER

  INTEGER LF_VESSEL
  INTEGER LF_TRIP_NO
  INTEGER LF_STRATUM
  INTEGER LF_SET
  INTEGER LF_DAY
  INTEGER LF_MONTH
  INTEGER LF_YEAR
  CHARACTER*2 LF_ICNAF
  INTEGER LF_TYPE
  INTEGER LF_SPECIES
  INTEGER LF_NUMBER
  INTEGER LF_RATIO
  INTEGER LF_SEX

  CHARACTER*1 LF_GEAR
  INTEGER LF_DAY_NITE
  CHARACTER*1 LF_FILL01
  INTEGER LF_GROUPING
  INTEGER LF_START
  INTEGER LFS(100)

  CHARACTER*6 SET_OUT_FILL01
  INTEGER SET_OUT_SET_NO
  CHARACTER*6 SET_OUT_FILL02
  INTEGER SET_OUT_SET_TYPE
  INTEGER SET_OUT_STRATUM
  CHARACTER*19 SET_OUT_FILL03
  REAL SET_OUT_DISTANCE
  CHARACTER*1 SET_OUT_FILL04
  INTEGER SET_OUT_DEPTH
  CHARACTER*784 SET_OUT_FILL05  CHARACTER*5 LF_OUT_FILL01
  INTEGER LF_OUT_STRATUM
  INTEGER LF_OUT_SET
  CHARACTER*9 LF_OUT_FILL02
  INTEGER LF_OUT_SPECIES
  CHARACTER*7 LF_OUT_FILL03
  INTEGER LF_OUT_SEX
  REAL LFS_OUT(100)

  CHARACTER*80 TEMP_RECORD_TEXT

  CHARACTER*80 TITLE1_TEXT01  CHARACTER*20 TITLE2_TEXT01
  INTEGER TITLE2_TRIPNO(6)
  CHARACTER*3 TITLE2_TEXT02(6)
  INTEGER TITLE2_YEAR(6)
  CHARACTER*2 TITLE2_TEXT03(6)  CHARACTER*80 TITLE2_ALTERNATE_TEXT01  CHARACTER*20 TITLE3_TEXT01
  INTEGER TITLE3_VESSEL(6)
  CHARACTER*8 TITLE3_TEXT02(6)

  CHARACTER*80 TITLE3_ALTERNATE_TEXT01  CHARACTER*80 TITLE4_TEXT01

  INTEGER ISTNO
  CHARACTER*77 STRATUM_AREAS_FILL01

  CHARACTER*5 PRINT_LINE1_TEXT01
  INTEGER PRINT_LINE1_SET
  CHARACTER*7 PRINT_LINE1_TEXT02
  INTEGER PRINT_LINE1_TRIP
  CHARACTER*5 PRINT_LINE1_TEXT03
  INTEGER PRINT_LINE1_YEAR
  CHARACTER*9 PRINT_LINE1_TEXT04
  INTEGER PRINT_LINE1_VESSEL
  CHARACTER*93 PRINT_LINE1_TEXT05  CHARACTER*5 PRINT_LINE2_TEXT01
  INTEGER PRINT_LINE2_SET
  CHARACTER*7 PRINT_LINE2_TEXT02
  INTEGER PRINT_LINE2_TRIP
  CHARACTER*5 PRINT_LINE2_TEXT03
  INTEGER PRINT_LINE2_YEAR
  CHARACTER*9 PRINT_LINE2_TEXT04
  INTEGER PRINT_LINE2_VESSEL
  CHARACTER*93 PRINT_LINE2_TEXT05  CHARACTER*133 PRINT_LINE4_TEXT01  CHARACTER*14 PRINT_LINE5_TEXT01
  INTEGER PRINT_LINE5_STRATUM
  CHARACTER*115 PRINT_LINE5_TEXT02  CHARACTER*32 PRINT_LINE6_TEXT01
  INTEGER PRINT_LINE6_SET
  CHARACTER*7 PRINT_LINE6_TEXT03
  INTEGER PRINT_LINE6_TRIP
  CHARACTER*5 PRINT_LINE6_TEXT04
  INTEGER PRINT_LINE6_YEAR
  CHARACTER*7 PRINT_LINE6_TEXT05
  INTEGER PRINT_LINE6_VESSEL
  CHARACTER*16 PRINT_LINE6_TEXT06
  INTEGER PRINT_LINE6_STRATUM
  CHARACTER*48 PRINT_LINE6_TEXT07

  SET_OUT_STRATUM = 0
  SET_OUT_DEPTH = 0
  SET_OUT_FILL01 = ' '
  SET_OUT_FILL02 = ' '
  SET_OUT_FILL03 = ' '
  SET_OUT_FILL04 = ' '
  SET_OUT_FILL05 = ' '  LF_OUT_FILL01 = ' '
  LF_OUT_FILL02 = ' '
  LF_OUT_FILL03 = ' '

  TITLE2_TEXT01='ANALYSIS FOR TRIP'

  TITLE2_ALTERNATE_TEXT01='ANALYSIS FOR TRIP  (SEE ABOVE FOR '//
  +  'COMPLETE LIST)'

  TITLE3_TEXT01='  VESSEL'  TITLE3_ALTERNATE_TEXT01='  VESSEL (SEE ABOVE FOR '//
  +  'COMPLETE LIST)'
  TITLE4_TEXT01='  ICNAF'

  PRINT_LINE1_TEXT01='SET #'
  PRINT_LINE1_TEXT02=' TRIP #'
  PRINT_LINE1_TEXT04=' VESSEL #'
  PRINT_LINE1_TEXT05=' WAS UNSUCCESSFUL AND HAS BEEN DROPPED.'

  PRINT_LINE2_TEXT01='SET #'
  PRINT_LINE2_TEXT02=' TRIP #'
  PRINT_LINE2_TEXT03=' YEAR'
  PRINT_LINE2_TEXT04=' VESSEL #'
  PRINT_LINE2_TEXT05=' HAS ZERO/BLANK DISTANCE TOWED'

  PRINT_LINE4_TEXT01='MORE THAN 100 STRATUM IN THIS SELECION.'//
  +  'DIMENSIONS OF PROGRAM MUST BE CHANGED.'

  PRINT_LINE5_TEXT01='STRATUM NUMBER'
  PRINT_LINE5_TEXT02=' FOUND ON SET-CATCH FILE FOR THIS'//
  +  ' SELECTION HAS NO MATCH ON THE STRATUM AREAS FILE.'

  PRINT_LINE6_TEXT01='INVALID STRATUM NUMBER FOR SET #'
  PRINT_LINE6_TEXT03='TRIP #'
  PRINT_LINE6_TEXT04=' YEAR'
  PRINT_LINE6_TEXT05=' VESSEL'
  PRINT_LINE6_TEXT06=' . NUMBER CODED='
  PRINT_LINE6_TEXT07=' '

  GOTO 331

  OPEN(20,FILE="TEMP1")
  OPEN(6,FILE="PRINTER")
  PRINT *, "OPEN(20,FILE=TEMP1 LINE 332)"301  DO I=1, 1
  PRINT *, "DO LINE 336"

  IF (IER.EQ.0) THEN

  PRINT *, "IF (IER.EQ.0) THEN LINE 338)"

  OPEN(17,FILE="STAREA")
  OPEN(2,FILE="TEMP3")
  DO J=1, ISTRATUM
  PRINT *, "DO LINE 345"

311  READ(17,314,END=321) ISTNO,STRATUM_AREAS_FILL01
314  FORMAT(I3,A77)
  write(6,*) ISTNO,STRATUM_AREAS_FILL01,STRATUM_IN_USE(J)
  IF (ISTNO.NE.STRATUM_IN_USE(J)) GOTO 311

  WRITE(2,314) ISTNO,STRATUM_AREAS_FILL01
  END DO

  END IF

  REWIND(17)
  CLOSE(17)
  REWIND(2)
  CLOSE(2)
  REWIND(19)
  CLOSE(19)
  REWIND(20)
  CLOSE(20)
  REWIND(1)
  CLOSE(1)
  REWIND(4)
  CLOSE(4)
  REWIND(16)
  CLOSE(16)
  RETURN
  PRINT *, "END DO LINE 377"
  END DO
  PRINT *, "DO LINE 381"

321  PRINT_LINE5_STRATUM=STRATUM_IN_USE(J)

  WRITE(6,325) PRINT_LINE5_TEXT_01, PRINT_LINE5_STRATUM,
  +  PRINT_LINE5_TEXT02
325  FORMAT('0',A14,I4,A83,32X)
  IER=1

  REWIND(17)
  CLOSE(17)
  REWIND(2)
  CLOSE(2)
  REWIND(19)
  CLOSE(19)
  REWIND(20)
  CLOSE(20)
  REWIND(1)
  CLOSE(1)
  REWIND(4)
  CLOSE(4)
  REWIND(16)
  CLOSE(16)
  REWIND(15)
  CLOSE(15)
  RETURN

331  DO I=1, 6
  PRINT *, "DO LINE 418"
  TITLE2_TEXT02(I)=' 19'
  TITLE2_TEXT03(I)=' '
  TITLE3_TEXT02(I)=' '
  PRINT *, "END DO LINE 419"
  END DO
  MAX_STRATUM=100
  ISTRATUM=0
  STRATUM_IN_USE=9999
  IRECS=0
  N_MALE_LFS=0
  N_FEMALE_LFS=0
  N_UNSEXED_LFS=0
  IER=0
  OPERATION=0

  DISTANCE=0
  READ(20,335,END=341) TITLE1_TEXT01
335  FORMAT(A80)
  WRITE(6,335)TITLE1_TEXT01

  WRITE(1,335) TITLE1_TEXT01
  IF (N_TRIP.GT.6) THEN

  WRITE(1,336) TITLE2_ALTERNATE_TEXT01
  WRITE(6,336) TITLE2_ALTERNATE_TEXT01
336  FORMAT(A49,31X)
  ELSE
  DO I=1, 6
  PRINT *, "DO LINE 462"
  TITLE2_TRIPNO(I)=0
  TITLE2_TEXT02(I)=' '
  TITLE2_YEAR(I)=0
  TITLE2_TEXT03(I)=' '
  PRINT *, "END DO LINE 463"
  END DO
  DO I=1, N_TRIP
  PRINT *, "DO LINE 470"
  TITLE2_TRIPNO(I)=TRIPS_TO_BE_SELECTED(2,I)
  TITLE2_TEXT02(I)=' 19'
  TITLE2_YEAR(I)=TRIPS_TO_BE_SELECTED(1,I)
  PRINT *, "END DO LINE 469"
  END DO
  WRITE(1,337) TITLE2_TEXT01,(TITLE2_TRIPNO(I),TITLE2_TEXT02(I),
  +  TITLE2_YEAR(I),TITLE2_TEXT03(I), I=1,6)
337  FORMAT(A20,6(I3,A3,I2,A2))
  WRITE(6,337) TITLE2_TEXT01,(TITLE2_TRIPNO(I),TITLE2_TEXT02(I),
  +  TITLE2_YEAR(I),TITLE2_TEXT03(I), I=1,6)
  END IF
  IF (N_VESSEL.GT.6) THEN

  TITLE3_ALTERNATE_TEXT01(14:19)='VESSEL'

  WRITE(1,338) TITLE3_ALTERNATE_TEXT01
  WRITE(6,338) TITLE3_ALTERNATE_TEXT01
338  FORMAT(A49,31(' '))
  ELSE
  DO I=1, 6
  PRINT *, "DO LINE 492"
  TITLE3_VESSEL(I)=0
  TITLE3_TEXT02(I)=' '
  PRINT *, "END DO LINE 489"
  END DO
  DO I=1, N_VESSEL
  PRINT *, "DO LINE 498"
  TITLE3_VESSEL(I)=VESSELS_TO_BE_SELECTED(I)
  write(6,*) "VESS BE SEL=",VESSELS_TO_BE_SELECTED(I)
  PRINT *, "END DO LINE 494"
  END DO

  WRITE(1,305) TITLE3_TEXT01,(TITLE3_VESSEL(I),TITLE3_TEXT02(I),
  +  I=1,6)
305  FORMAT(A20,6(I2,8(' ')))
  WRITE(6,305) TITLE3_TEXT01,(TITLE3_VESSEL(I),TITLE3_TEXT02(I),
  +  I=1,6)
  END IF
  IF (N_ICNAF.GT.17) THEN

  TITLE3_ALTERNATE_TEXT01(14:19)='ICNAF '

  WRITE(1,307) TITLE3_ALTERNATE_TEXT01
307  FORMAT(A80)
  ELSE
  TITLE4_TEXT01='  ICNAF'
  DO I=1, N_ICNAF
  PRINT *, "DO LINE 519"

  TITLE4_TEXT01(18+(3*I):20+(3*I))=ICNAF_TO_BE_SELECTED(I)
  write(6,*) "ICNAF TO BE SEL=",ICNAF_TO_BE_SELECTED(I)
  PRINT *, "END DO LINE 516"
  END DO
  IF (N_ICNAF.GT.1)
  +  TITLE4_TEXT01(23+(N_ICNAF*3):31+(N_ICNAF*3))='COMBINED'

  WRITE(1,307) TITLE4_TEXT01
  WRITE(6,307) TITLE4_TEXT01
  END IF

  DO
  PRINT *, "DO LINE 535"

  READ(20,339,END=341,IOSTAT=STAT) TEMP_RECORD_TEXT
  WRITE(6,339) TEMP_RECORD_TEXT
339  FORMAT(A80)
  IF (STAT.NE.0) EXIT

  WRITE(1,339) TEMP_RECORD_TEXT
  PRINT *, "END DO LINE 534"
  END DO

341  OPEN(16,FILE="LENFQ")
  OPEN(15,FILE="LENFQ2")
C  DO WHILE ('1'B)
  PRINT *, "BEFORE DO LINE 548"
  DO
  PRINT *, "DO LINE 548"

351  READ(16,355,END=391,IOSTAT=STAT) LF_VESSEL,LF_TRIP_NO,
  +  LF_STRATUM,LF_SET,LF_DAY,LF_MONTH,LF_YEAR,LF_ICNAF,
  +  LF_TYPE,LF_SPECIES,LF_NUMBER,LF_RATIO1,LF_SEX,LF_GEAR,
  +  LF_DAY_NITE,LF_FILL01,LF_GROUPING,LF_START,
  +  (LFS(ii),ii=1,100),LF_RATIO
355  FORMAT(I2,I3,I3,I3,I2,I2,I2,A2,I1,I4,I4,I2,I1,A1,I1,A1,I1,I3,
  +  100(I3),I5)
  WRITE(6,355) LF_VESSEL,LF_TRIP_NO,
  +  LF_STRATUM,LF_SET,LF_DAY,LF_MONTH,LF_YEAR,LF_ICNAF,
  +  LF_TYPE,LF_SPECIES,LF_NUMBER,LF_RATIO1,LF_SEX,LF_GEAR,
  +  LF_DAY_NITE,LF_FILL01,LF_GROUPING,LF_START,
  +  (LFS(ii),ii=1,100),LF_RATIO
  write(6,*) "LF_SEX=",LF_SEX
  IF (STAT.NE.0) EXIT  WRITE (STRING2,'(I3)') LF_STRATUM
  ICHK = 0
  DO I = 1, 3
  PRINT *, "DO LINE 586"
  K = ICHAR(STRING2(I:1))
  IF ((K.LT.48).OR.(K.GT.57)) THEN
  ICHK = 1
  END IF
  IF (ICHK.GT.0) GOTO 351
  END DO  IF (LF_STRATUM.EQ.0) GOTO 351
  IF (N_VESSEL.GT.1) THEN
  DO I=1, N_VESSEL
  PRINT *, "DO LINE 597"
  IF ((LF_VESSEL.EQ.VESSELS_TO_BE_SELECTED(I)) .AND.
  +  (LF_YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (LF_TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 604"
  IF (LF_SET.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 351
  END DO
  END IF
  GOTO 361
  END IF
  END DO
  GOTO 351
  END IF
  IF (LF_VESSEL.NE.VESSELS_TO_BE_SELECTED(1)) GOTO 351
  DO I=1, N_TRIP
  PRINT *, "DO LINE 615"
  IF ((LF_YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (LF_TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 621"
  IF (LF_SET.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 351
  END DO
  END IF
  GOTO 361
  END IF
  END DO
  GOTO 351

361  DO I=1, N_ICNAF
  PRINT *, "DO LINE 631"
  IF (LF_ICNAF.EQ.ICNAF_TO_BE_SELECTED(I)) GOTO 371
  END DO
  GOTO 351

371  IF (N_DELSTR.NE.0) THEN
  DO I=1, N_DELSTR
  PRINT *, "DO LINE 638"
  IF (LF_STRATUM.EQ.STRATUM_TO_BE_DELETED(I)) GOTO 351
  END DO
  END IF
  IF (N_SELSTR.NE.0) THEN
  DO I=1, N_SELSTR
  PRINT *, "DO LINE 644"
  IF (LF_STRATUM.EQ.STRATUM_TO_BE_SELECTED(I)) GOTO 381
  END DO
  GOTO 351
  END IF381  WRITE(15,385) LF_VESSEL,LF_TRIP_NO,LF_STRATUM,LF_SET,LF_DAY,
  +  LF_MONTH,LF_YEAR,LF_ICNAF,LF_TYPE,LF_SPECIES,
  +  LF_NUMBER,LF_RATIO,LF_SEX,LF_GEAR,LF_DAY_NITE,
  +  LF_FILL01,LF_GROUPING,LF_START,(LFS(ii),ii=1,100)
385  FORMAT(I2,I3,I3,I3,I2,I2,I2,A2,I1,I4,I4,I2,I1,A1,I1,A1,I1,
  +  I3,100(I3))
  write(6,*)"LF_SEX 2=",LF_SEX
  GOTO 351
  END DO391  REWIND(15)
  CLOSE(15)

  OPEN(19,FILE="SETCAT",BLANK="NULL")
  OPEN(4,FILE="TEMP5")

  DO
  PRINT *, "DO LINE 685"

392  READ(19,390,END=301,IOSTAT=STAT) CARD_TYPE,VESSEL,TRIP_NO,
  +  SET_NO,YEAR,MONTH,DAY,SET_TYPE,STRATUM,DIVISION,UNIT_AREA,
  +  LIGHT_CONDITION,WIND_DIRECTION,WIND_FORCE,SEA,BOTTOM_TYPE,
  +  TIME,DURATION,DISTANCE,OPERATION,DEPTH_MEAN,DEPTH_MIN,
  +  DEPTH_MAX,DEPTH_BOTTOM,TEMPERATURE_SURFACE,
  +  TEMPERATURE_FISHED,LATITUDE_DEG,LATITUDE_MIN,LONGITUDE_DEG,
  +  LONGITUDE_MIN,POSITION_METHOD,GEAR,SPECIES_CODE,
  +  SPECIES_NUMBER,SPECIES_WT
  WRITE(6,390) CARD_TYPE,VESSEL,TRIP_NO,
  +  SET_NO,YEAR,MONTH,DAY,SET_TYPE,STRATUM,DIVISION,UNIT_AREA,
  +  LIGHT_CONDITION,WIND_DIRECTION,WIND_FORCE,SEA,BOTTOM_TYPE,
  +  TIME,DURATION,DISTANCE,OPERATION,DEPTH_MEAN,DEPTH_MIN,
  +  DEPTH_MAX,DEPTH_BOTTOM,TEMPERATURE_SURFACE,
  +  TEMPERATURE_FISHED,LATITUDE_DEG,LATITUDE_MIN,LONGITUDE_DEG,
  +  LONGITUDE_MIN,POSITION_METHOD,GEAR,SPECIES_CODE,
  +  SPECIES_NUMBER,SPECIES_WT
389  FORMAT(I1,I2,I3,I3,I2,I2,I2,I2,I3,A2,A3,I3,I1,I1,I1,I1,I4,I3,
  +  F4.1,I1,I4,I4,I4,I4,F4.1,F4.1,I2,F4.1,I2,F4.1,I1,I4,I4,I6,F8.2)
390  FORMAT(I1,I2,I3,I3,I2,I2,I2,I2,I3,A2,A3,I3,I1,I1,I1,I1,I4,I3,
  +  I3,I1,I4,I4,I4,I4,I3,I3,I2,I3,I2,I3,I1,I4,I4,I6,I7)

  IF (SET_TYPE.NE.1) GOTO 392
  IF (CARD_TYPE.EQ.5) THEN

  WRITE (STRING2,'(I3)') STRATUM
  ICHK = 0
  DO I = 1, 3
  PRINT *, "DO LINE 776"
  K = ICHAR(STRING2(I:1))
  IF ((K.LT.48).OR.(K.GT.57)) THEN
  ICHK = 1
  END IF
  write(6,*)"ICHK=",ICHK
  IF (ICHK.GT.0) GOTO 392
  END DO
  WRITE(6,*) "****** ",STAT,SET_TYPE,CARD_TYPE,ICHK,STRATUM  IF (STRATUM.EQ.0) GOTO 392

  IF (N_VESSEL.GT.1) THEN
  write(6,*)"N_VESSEL GT1",N_VESSEL
  DO I=1, N_VESSEL
  PRINT *, "DO LINE 793"
  write(6,*) I," ",VESSEL," ",VESSELS_TO_BE_SELECTED(I)
  write(6,*) "  ",YEAR," ",TRIPS_TO_BE_SELECTED(1,I)
  write(6,*) "  ",TRIP_NO," ",TRIPS_TO_BE_SELECTED(2,I)
  IF ((VESSEL.EQ.VESSELS_TO_BE_SELECTED(I)) .AND.
  +  (YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  write(6,*) "N_SETDEL=",(N_SETDEL(ii),ii=1,20)
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 804"
  write(6,*) "SET_NO=",J,I,SET_NO,SETS_TO_BE_DELETED(J,I)
  IF (SET_NO.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 392
  END DO
  END IF
  GOTO 393
  END IF
  END DO
  GOTO 392
  END IF
  IF (VESSEL.NE.VESSELS_TO_BE_SELECTED(1)) GOTO 392
  DO I=1, N_TRIP
  PRINT *, "DO LINE 816"
  IF ((YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 822"
  IF (SET_NO.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 392
  END DO
  END IF
  GOTO 393
  END IF
  END DO
  GOTO 392

393  DO I=1, N_ICNAF
  PRINT *, "DO LINE 832"
  write(6,*)"DIV=",I,DIVISION,ICNAF_TO_BE_SELECTED(I)
  IF (DIVISION.EQ.ICNAF_TO_BE_SELECTED(I)) GOTO 394
  END DO
  GOTO 392
394  write(6,*)"N_DELSTR=",N_DELSTR
  IF (N_DELSTR.NE.0) THEN
  DO I=1, N_DELSTR
  PRINT *, "DO LINE 541"
  write(6,*)"STRATUM=",I,STRATUM,STRATUM_TO_BE_DELETED(I)
  IF (STRATUM.EQ.STRATUM_TO_BE_DELETED(I)) GOTO 392
  END DO
  END IF  write(6,*)"N_SELSTR=",N_SELSTR
  IF (N_SELSTR.NE.0) THEN
  DO I=1, N_SELSTR
  PRINT *, "DO LINE 849"
  write(6,*)"STBSEL=",I,STRATUM,STRATUM_TO_BE_SELECTED(I)
  IF (STRATUM.EQ.STRATUM_TO_BE_SELECTED(I)) GOTO 395
  END DO
  GOTO 392
  END IF395  write(6,*)"OPERATION,DIST=",OPERATION,DISTANCE
  IF (OPERATION.GT.2) THEN
  PRINT_LINE1_SET=SET_NO
  PRINT_LINE1_TRIP=TRIP_NO
  PRINT_LINE1_YEAR=YEAR
  PRINT_LINE1_VESSEL=VESSEL

  WRITE(6,345) PRINT_LINE1_TEXT01,PRINT_LINE1_SET,
  +  PRINT_LINE1_TEXT02,PRINT_LINE1_TRIP,
  +  PRINT_LINE1_TEXT03,PRINT_LINE1_YEAR,
  +  PRINT_LINE1_TEXT04,PRINT_LINE1_VESSEL,
  +  PRINT_LINE1_TEXT05
345  FORMAT(A5,I4,A7,I4,A5,I3,A9,I3,A39,54(' '))
  GOTO 392
  END IF
  IF (DISTANCE.EQ.0) THEN
  PRINT_LINE2_SET=SET_NO
  PRINT_LINE2_TRIP=TRIP_NO
  PRINT_LINE2_YEAR=YEAR
  PRINT_LINE2_VESSEL=VESSEL

  WRITE(6,346) PRINT_LINE2_TEXT01,PRINT_LINE2_SET,
  +  PRINT_LINE2_TEXT02,PRINT_LINE2_TRIP,
  +  PRINT_LINE2_TEXT03,PRINT_LINE2_YEAR,
  +  PRINT_LINE2_TEXT04,PRINT_LINE2_VESSEL,
  +  PRINT_LINE2_TEXT05
346  FORMAT(A5,I4,A7,I4,A5,I3,A9,I3,A30,63(' '))
  GOTO 392
  END IF

  write(6,*)"IAREA,STRATUM=",IAREA,STRATUM
  IF (IAREA.EQ.0) THEN
  IF ((STRATUM.GE.201 .AND. STRATUM.LE.236) .OR.
  +  (STRATUM.GE.301 .AND. STRATUM.LE.392) .OR.
  +  (STRATUM.GE.401 .AND. STRATUM.LE.408) .OR.
  +  (STRATUM.GE.501 .AND. STRATUM.LE.519) .OR.
  +  (STRATUM.GE.620 .AND. STRATUM.LE.649) .OR.
  +  (STRATUM.GE.705 .AND. STRATUM.LE.736) .OR.
  +  (STRATUM.GE.801 .AND. STRATUM.LE.834)) GOTO 396
  PRINT_LINE6_SET=SET_NO
  PRINT_LINE6_TRIP=TRIP_NO
  PRINT_LINE6_YEAR=YEAR
  PRINT_LINE6_VESSEL=VESSEL
  PRINT_LINE6_STRATUM=STRATUM

  WRITE(6,347) PRINT_LINE6_TEXT01,PRINT_LINE6_SET,
  +  PRINT_LINE6_TEXT03,PRINT_LINE6_TRIP,
  +  PRINT_LINE6_TEXT04,PRINT_LINE6_YEAR,
  +  PRINT_LINE6_TEXT05,PRINT_LINE6_VESSEL,
  +  PRINT_LINE6_TEXT06,PRINT_LINE6_STRATUM,
  +  PRINT_LINE6_TEXT07
347  FORMAT(A32,I4,A7,I4,A5,I3,A7,I3,A16,I4,48(' '))
  IER=1
  GOTO 392
  END IF

396  DO J=1, MAX_STRATUM
  write(6,*)"MAX_STRAT=",J,MAX_STRATUM,STRATUM,STRATUM_IN_USE(J)
  IF (STRATUM.EQ.STRATUM_IN_USE(J)) THEN
  GOTO 397
  END IF
  END DO
  ISTRATUM=ISTRATUM+1
  write(6,*)"MAX_STRAT=",MAX_STRATUM,STRATUM,STRATUM_IN_USE(1)
  write(6,*)"IST,MAX_STRAT=",MAX_STRATUM,ISTRATUM,STRATUM_IN_USE(1)
  IF (ISTRATUM.GT.MAX_STRATUM) THEN

  WRITE(6,348) PRINT_LINE4_TEXT01
348  FORMAT(A79,54X)
  IER=1
  GOTO 392
  END IF
  DO J=1, MAX_STRATUM
  PRINT *, "DO LINE 934"
  IF (STRATUM.LT.STRATUM_IN_USE(J)) THEN
  J1=J+1
  DO K=MAX_STRATUM, J1, -1
  PRINT *, "DO LINE 938"
  STRATUM_IN_USE(K)=STRATUM_IN_USE(K-1)
  END DO
  STRATUM_IN_USE(J)=STRATUM
  write(6,*)"348 LOOP ",J,STRATUM,STRATUM_IN_USE(J)
  GOTO 397
  END IF
  END DO

397  SET_OUT_SET_NO=SET_NO
  SET_OUT_SET_TYPE=SET_TYPE
  SET_OUT_STRATUM=STRATUM
  SET_OUT_DISTANCE=DISTANCE
  SET_OUT_DEPTH=DEPTH_MEAN

  WRITE(4,387) SET_OUT_FILL01,SET_OUT_SET_NO,SET_OUT_FILL02,
  +  SET_OUT_SET_TYPE,SET_OUT_STRATUM,SET_OUT_FILL03,
  +  SET_OUT_DISTANCE,SET_OUT_FILL04,SET_OUT_DEPTH,
  +  SET_OUT_FILL05
387  FORMAT(A6,I3,A6,I2,I3,A19,F4.1,A1,I4,A784)
  IRECS=IRECS+1

  OPEN(15,FILE="LENFQ2")
  LF_OUT_STRATUM=STRATUM
  LF_OUT_SET=SET_NO
  do ii=1,100
  PRINT *, "DO LINE 978"
  LFS_TEMP(ii,1)=0.0
  LFS_TEMP(ii,2)=0.0
  LFS_TEMP(ii,3)=0.0
  end do
  DO IPASS=1, N_SPECIES
  PRINT *, "DO LINE 984"
  SPECIES_CHK=SPECIES_TO_BE_SELECTED(IPASS)
  LF_OUT_SPECIES=SPECIES_CHK

  DO
  PRINT *, "DO LINE 990"

398  READ(15,400,END=399,IOSTAT=STAT) LF_VESSEL,LF_TRIP_NO,
  +  LF_STRATUM,LF_SET,LF_DAY,LF_MONTH,LF_YEAR,LF_ICNAF,
  +  LF_TYPE,LF_SPECIES,LF_NUMBER,LF_RATIO1,LF_SEX,LF_GEAR,
  +  LF_DAY_NITE,LF_FILL01,LF_GROUPING,LF_START,
  +  (LFS(ii),ii=1,100),LF_RATIO
400  FORMAT(I2,I3,I3,I3,I2,I2,I2,A2,I1,I4,I4,I2,I1,I1,I1,A1,
  +  I1,I3,100(I3),I5)
  write(6,'(A14,I1,A1,I5)')"LF_SEX STAT 3=",LF_SEX," ",STAT  write(6,*)"LF_SPECIES,SPECIES_CHK=",LF_SPECIES,SPECIES_CHK
  IF (LF_SPECIES.NE.SPECIES_CHK) GOTO 398
  write(6,*)"LF_VESSEL,VESSEL=",LF_VESSEL,VESSEL

  IF (LF_VESSEL.NE.VESSEL) GOTO 398
  write(6,*)"LF_YEAR,YEAR=",LF_YEAR,YEAR  IF (LF_YEAR.NE.YEAR) GOTO 398
  write(6,*)"LF_TRIP_NO,TRIP_NO=",LF_TRIP_NO,TRIP_NO  IF (LF_TRIP_NO.NE.TRIP_NO) GOTO 398
  write(6,*)"LF_SET,SET_NO=",LF_SET,SET_NO  IF (LF_SET.NE.SET_NO) GOTO 398
  write(6,*)"LF_STRATUM,STRATUM=",LF_STRATUM,STRATUM  IF (LF_STRATUM.NE.STRATUM) GOTO 398
  write(6,*) "LF_RATIO=",LF_RATIO  IF (LF_RATIO.EQ.0) THEN
  PROP=1.0
  ELSE
  PROP=100.0/LF_RATIO
  END IF
  write(6,*) "LF_SEX 4=",LF_SEX,PROP
  IF (LF_SEX.EQ.1) THEN
  DO I=1, 100
  PRINT *, "DO LINE 1023"
  LFS_TEMP(I,1)=LFS_TEMP(I,1)+LFS(I)*PROP
  write(6,*)"LF_S1X,I,TEMP,LFS=",LF_SEX,I,
  +  LFS_TEMP(I,1),LFS(I)
  END DO
  GOTO 398
  END IF
  IF (LF_SEX.EQ.5) THEN
  DO I=1, 100
  PRINT *, "DO LINE 1032"
  LFS_TEMP(I,2)=LFS_TEMP(I,2)+LFS(I)*PROP
  write(6,*)"LF_S2X,I,TEMP,LFS=",LF_SEX,I,
  +  LFS_TEMP(I,2),LFS(I)
  END DO
  GOTO 398
  END IF
  DO I=1, 100
  PRINT *, "DO LINE 1040"
  LFS_TEMP(I,3)=LFS_TEMP(I,3)+LFS(I)*PROP
  write(6,*)"LF_S3X,I,TEMP,LFS=",LF_SEX,I,
  +  LFS_TEMP(I,3),LFS(I)
  END DO
  GOTO 398
  END DO

399  write(6,*)"N_SEX=",N_SEX
  IF ((N_SEX.EQ.1) .OR. (N_SEX.EQ.3) .OR. (N_SEX.EQ.4)) THEN
  LF_OUT_SEX=1
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1052"
  LFS_OUT(I)=LFS_TEMP(I,1)+0.005
  write(6,*)"LFS_OUT&TEMP=",I,LFS_OUT(I),LFS_TEMP(I,1)
  IF (LFS_TEMP(I,1).GT.0.0) ICHK2=1  END DO
  write(6,*)"ICHK2=",ICHK2

  WRITE(4,388) LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_SPECIES,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
388  FORMAT(1X,I3,I3,9X,I3,7X,I1,100(F8.2))
  IF (ICHK2.GT.0) N_MALE_LFS=N_MALE_LFS+1
  END IF
  IF ((N_SEX.EQ.2) .OR. (N_SEX.EQ.3) .OR. (N_SEX.EQ.4)) THEN
  LF_OUT_SEX=5
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1070"
  LFS_OUT(I)=LFS_TEMP(I,2)+0.005
  IF (LFS_TEMP(I,2).GT.0.0) ICHK2=1
  END DO
  WRITE(4,388) LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_SPECIES,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
  IF (ICHK2.GT.0) N_FEMALE_LFS=N_FEMALE_LFS+1
  END IF
  IF (N_SEX.EQ.4) THEN
  LF_OUT_SEX=0
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1084"
  LFS_OUT(I)=LFS_TEMP(I,3)+0.005
  IF (LFS_TEMP(I,3).GT.0.0) ICHK2=1
  END DO
C  WRITE FILE(TEMP5) FROM(LF_OUT_RECORD)
  WRITE(4,388) LF_OUT_FILL01,LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_FILL02,LF_OUT_SPECIES,LF_OUT_FILL03,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
  IF (ICHK2.GT.0) N_UNSEXED_LFS=N_UNSEXED_LFS+1
  END IF
  IF (N_SEX.EQ.5) THEN
  LF_OUT_SEX=0
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1098"
  LFS_OUT(I) = LFS_TEMP(I,1) + LFS_TEMP(I,2)
  +  + LFS_TEMP(I,3) + 0.005
  IF ((LFS_TEMP(I,1).GT.0.0) .OR. (LFS_TEMP(I,2).GT.0.0)
  +  .OR. (LFS_TEMP(I,3).GT.0.0)) ICHK2=1
  END DOC  WRITE FILE(TEMP5) FROM(LF_OUT_RECORD)
  WRITE(4,388) LF_OUT_FILL01,LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_FILL02,LF_OUT_SPECIES,LF_OUT_FILL03,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
  IF (ICHK2.GT.0) N_UNSEXED_LFS=N_UNSEXED_LFS+1
  END IFC  CLOSE FILE(LENFQ2) ENV(REWIND_ON_CLOSE)
  REWIND(15)
  CLOSE(15)
  END DO
  END IF
  END DO
C
  END SUBROUTINE MREAD3

DavidSnider · Sep 9, 2015

Holy &#@*(@. Not sure what's broken, but you have my sympathy.
Have you run it through a debugger to identify the portions that are going through an infinite loop? Does it always do an infinite loop or just on certain parameters?

DEvens · Sep 9, 2015

I think you need a software developer. Debugging code of this nature usually starts about $150/hour. Plus, it would help if you could do better than "It's giving an infinite loop."

DavidSnider · Sep 9, 2015

DEvens said:

I think you need a software developer. Debugging code of this nature usually starts about $150/hour. Plus, it would help if you could do better than "It's giving an infinite loop."

If you are paying $150 an hour to debug code like this you are paying 3 times too much.

DEvens · Sep 9, 2015

DavidSnider said:

If you are paying $150 an hour to debug code like this you are paying 3 times too much.

Heh heh. I get paid that. Well, that is, the company I work for gets paid that for my time. I don't get paid that. Of course, I'm pretty senior. Junior guys are quite a bit less.

SteamKing · Sep 9, 2015

debbieanne said:

I've inherited the code below. It's giving an infinite loop but I can't find what's causing it. This is code originally on OpenVMS written now for AIX. Can you help?

Code:

SUBROUTINE MREAD3(N_VESSEL,N_TRIP,N_ICNAF,N_SPECIES,N_DELSTR,
  +  N_SETDEL,N_SELSTR,VESSELS_TO_BE_SELECTED,
  +  TRIPS_TO_BE_SELECTED,ICNAF_TO_BE_SELECTED,
  +  SPECIES_TO_BE_SELECTED,STRATUM_TO_BE_DELETED,
  +  SETS_TO_BE_DELETED,STRATUM_TO_BE_SELECTED,
  +  IRECS,IER,IAREA,N_SEX,N_MALE_LFS,N_FEMALE_LFS,
  +  N_UNSEXED_LFS)

  INTEGER N_VESSEL,N_TRIP,N_ICNAF,N_SPECIES,N_DELSTR,N_SETDEL(20)
  INTEGER N_SELSTR,IRECS,IER,IAREA,N_SEX,N_MALE_LFS,N_FEMALE_LFS
  INTEGER N_UNSEXED_LFS
  CHARACTER*97 INSDE  INTEGER VESSELS_TO_BE_SELECTED(20)
  INTEGER TRIPS_TO_BE_SELECTED(2,20)
  CHARACTER*2 ICNAF_TO_BE_SELECTED(20)
  INTEGER STRATUM_TO_BE_DELETED(20)
  INTEGER SETS_TO_BE_DELETED(100,20)
  INTEGER STRATUM_TO_BE_SELECTED(100)
  INTEGER SPECIES_TO_BE_SELECTED(2)
  INTEGER STRATUM_IN_USE(100),ISTRATUM
  REAL LFS_TEMP(100,3)
  REAL PROP
  INTEGER SPECIES_CHK, STAT, ii
  CHARACTER*3 STRING2

  INTEGER CARD_TYPE
  INTEGER VESSEL
  INTEGER TRIP_NO
  INTEGER SET_NO
  INTEGER YEAR
  INTEGER MONTH
  INTEGER DAY
  INTEGER SET_TYPE
  INTEGER STRATUM
  CHARACTER*2 DIVISION
  CHARACTER*3 UNIT_AREA
  INTEGER LIGHT_CONDITION
  INTEGER WIND_DIRECTION
  INTEGER WIND_FORCE
  INTEGER SEA
  INTEGER BOTTOM_TYPE
  INTEGER TIME
  INTEGER DURATION

  INTEGER DISTANCE
  INTEGER OPERATION
  INTEGER DEPTH_MEAN
  INTEGER DEPTH_MIN
  INTEGER DEPTH_MAX
  INTEGER DEPTH_BOTTOM

  INTEGER TEMPERATURE_SURFACE

  INTEGER TEMPERATURE_FISHED
  INTEGER LATITUDE_DEG

  INTEGER LATITUDE_MIN
  INTEGER LONGITUDE_DEG

  INTEGER LONGITUDE_MIN
  INTEGER POSITION_METHOD
  INTEGER GEAR
  INTEGER SPECIES_CODE
  INTEGER SPECIES_NUMBER

  INTEGER LF_VESSEL
  INTEGER LF_TRIP_NO
  INTEGER LF_STRATUM
  INTEGER LF_SET
  INTEGER LF_DAY
  INTEGER LF_MONTH
  INTEGER LF_YEAR
  CHARACTER*2 LF_ICNAF
  INTEGER LF_TYPE
  INTEGER LF_SPECIES
  INTEGER LF_NUMBER
  INTEGER LF_RATIO
  INTEGER LF_SEX

  CHARACTER*1 LF_GEAR
  INTEGER LF_DAY_NITE
  CHARACTER*1 LF_FILL01
  INTEGER LF_GROUPING
  INTEGER LF_START
  INTEGER LFS(100)

  CHARACTER*6 SET_OUT_FILL01
  INTEGER SET_OUT_SET_NO
  CHARACTER*6 SET_OUT_FILL02
  INTEGER SET_OUT_SET_TYPE
  INTEGER SET_OUT_STRATUM
  CHARACTER*19 SET_OUT_FILL03
  REAL SET_OUT_DISTANCE
  CHARACTER*1 SET_OUT_FILL04
  INTEGER SET_OUT_DEPTH
  CHARACTER*784 SET_OUT_FILL05  CHARACTER*5 LF_OUT_FILL01
  INTEGER LF_OUT_STRATUM
  INTEGER LF_OUT_SET
  CHARACTER*9 LF_OUT_FILL02
  INTEGER LF_OUT_SPECIES
  CHARACTER*7 LF_OUT_FILL03
  INTEGER LF_OUT_SEX
  REAL LFS_OUT(100)

  CHARACTER*80 TEMP_RECORD_TEXT

  CHARACTER*80 TITLE1_TEXT01  CHARACTER*20 TITLE2_TEXT01
  INTEGER TITLE2_TRIPNO(6)
  CHARACTER*3 TITLE2_TEXT02(6)
  INTEGER TITLE2_YEAR(6)
  CHARACTER*2 TITLE2_TEXT03(6)  CHARACTER*80 TITLE2_ALTERNATE_TEXT01  CHARACTER*20 TITLE3_TEXT01
  INTEGER TITLE3_VESSEL(6)
  CHARACTER*8 TITLE3_TEXT02(6)

  CHARACTER*80 TITLE3_ALTERNATE_TEXT01  CHARACTER*80 TITLE4_TEXT01

  INTEGER ISTNO
  CHARACTER*77 STRATUM_AREAS_FILL01

  CHARACTER*5 PRINT_LINE1_TEXT01
  INTEGER PRINT_LINE1_SET
  CHARACTER*7 PRINT_LINE1_TEXT02
  INTEGER PRINT_LINE1_TRIP
  CHARACTER*5 PRINT_LINE1_TEXT03
  INTEGER PRINT_LINE1_YEAR
  CHARACTER*9 PRINT_LINE1_TEXT04
  INTEGER PRINT_LINE1_VESSEL
  CHARACTER*93 PRINT_LINE1_TEXT05  CHARACTER*5 PRINT_LINE2_TEXT01
  INTEGER PRINT_LINE2_SET
  CHARACTER*7 PRINT_LINE2_TEXT02
  INTEGER PRINT_LINE2_TRIP
  CHARACTER*5 PRINT_LINE2_TEXT03
  INTEGER PRINT_LINE2_YEAR
  CHARACTER*9 PRINT_LINE2_TEXT04
  INTEGER PRINT_LINE2_VESSEL
  CHARACTER*93 PRINT_LINE2_TEXT05  CHARACTER*133 PRINT_LINE4_TEXT01  CHARACTER*14 PRINT_LINE5_TEXT01
  INTEGER PRINT_LINE5_STRATUM
  CHARACTER*115 PRINT_LINE5_TEXT02  CHARACTER*32 PRINT_LINE6_TEXT01
  INTEGER PRINT_LINE6_SET
  CHARACTER*7 PRINT_LINE6_TEXT03
  INTEGER PRINT_LINE6_TRIP
  CHARACTER*5 PRINT_LINE6_TEXT04
  INTEGER PRINT_LINE6_YEAR
  CHARACTER*7 PRINT_LINE6_TEXT05
  INTEGER PRINT_LINE6_VESSEL
  CHARACTER*16 PRINT_LINE6_TEXT06
  INTEGER PRINT_LINE6_STRATUM
  CHARACTER*48 PRINT_LINE6_TEXT07

  SET_OUT_STRATUM = 0
  SET_OUT_DEPTH = 0
  SET_OUT_FILL01 = ' '
  SET_OUT_FILL02 = ' '
  SET_OUT_FILL03 = ' '
  SET_OUT_FILL04 = ' '
  SET_OUT_FILL05 = ' '  LF_OUT_FILL01 = ' '
  LF_OUT_FILL02 = ' '
  LF_OUT_FILL03 = ' '

  TITLE2_TEXT01='ANALYSIS FOR TRIP'

  TITLE2_ALTERNATE_TEXT01='ANALYSIS FOR TRIP  (SEE ABOVE FOR '//
  +  'COMPLETE LIST)'

  TITLE3_TEXT01='  VESSEL'  TITLE3_ALTERNATE_TEXT01='  VESSEL (SEE ABOVE FOR '//
  +  'COMPLETE LIST)'
  TITLE4_TEXT01='  ICNAF'

  PRINT_LINE1_TEXT01='SET #'
  PRINT_LINE1_TEXT02=' TRIP #'
  PRINT_LINE1_TEXT04=' VESSEL #'
  PRINT_LINE1_TEXT05=' WAS UNSUCCESSFUL AND HAS BEEN DROPPED.'

  PRINT_LINE2_TEXT01='SET #'
  PRINT_LINE2_TEXT02=' TRIP #'
  PRINT_LINE2_TEXT03=' YEAR'
  PRINT_LINE2_TEXT04=' VESSEL #'
  PRINT_LINE2_TEXT05=' HAS ZERO/BLANK DISTANCE TOWED'

  PRINT_LINE4_TEXT01='MORE THAN 100 STRATUM IN THIS SELECION.'//
  +  'DIMENSIONS OF PROGRAM MUST BE CHANGED.'

  PRINT_LINE5_TEXT01='STRATUM NUMBER'
  PRINT_LINE5_TEXT02=' FOUND ON SET-CATCH FILE FOR THIS'//
  +  ' SELECTION HAS NO MATCH ON THE STRATUM AREAS FILE.'

  PRINT_LINE6_TEXT01='INVALID STRATUM NUMBER FOR SET #'
  PRINT_LINE6_TEXT03='TRIP #'
  PRINT_LINE6_TEXT04=' YEAR'
  PRINT_LINE6_TEXT05=' VESSEL'
  PRINT_LINE6_TEXT06=' . NUMBER CODED='
  PRINT_LINE6_TEXT07=' '

  GOTO 331

  OPEN(20,FILE="TEMP1")
  OPEN(6,FILE="PRINTER")
  PRINT *, "OPEN(20,FILE=TEMP1 LINE 332)"301  DO I=1, 1
  PRINT *, "DO LINE 336"

  IF (IER.EQ.0) THEN

  PRINT *, "IF (IER.EQ.0) THEN LINE 338)"

  OPEN(17,FILE="STAREA")
  OPEN(2,FILE="TEMP3")
  DO J=1, ISTRATUM
  PRINT *, "DO LINE 345"

311  READ(17,314,END=321) ISTNO,STRATUM_AREAS_FILL01
314  FORMAT(I3,A77)
  write(6,*) ISTNO,STRATUM_AREAS_FILL01,STRATUM_IN_USE(J)
  IF (ISTNO.NE.STRATUM_IN_USE(J)) GOTO 311

  WRITE(2,314) ISTNO,STRATUM_AREAS_FILL01
  END DO

  END IF

  REWIND(17)
  CLOSE(17)
  REWIND(2)
  CLOSE(2)
  REWIND(19)
  CLOSE(19)
  REWIND(20)
  CLOSE(20)
  REWIND(1)
  CLOSE(1)
  REWIND(4)
  CLOSE(4)
  REWIND(16)
  CLOSE(16)
  RETURN
  PRINT *, "END DO LINE 377"
  END DO
  PRINT *, "DO LINE 381"

321  PRINT_LINE5_STRATUM=STRATUM_IN_USE(J)

  WRITE(6,325) PRINT_LINE5_TEXT_01, PRINT_LINE5_STRATUM,
  +  PRINT_LINE5_TEXT02
325  FORMAT('0',A14,I4,A83,32X)
  IER=1

  REWIND(17)
  CLOSE(17)
  REWIND(2)
  CLOSE(2)
  REWIND(19)
  CLOSE(19)
  REWIND(20)
  CLOSE(20)
  REWIND(1)
  CLOSE(1)
  REWIND(4)
  CLOSE(4)
  REWIND(16)
  CLOSE(16)
  REWIND(15)
  CLOSE(15)
  RETURN

331  DO I=1, 6
  PRINT *, "DO LINE 418"
  TITLE2_TEXT02(I)=' 19'
  TITLE2_TEXT03(I)=' '
  TITLE3_TEXT02(I)=' '
  PRINT *, "END DO LINE 419"
  END DO
  MAX_STRATUM=100
  ISTRATUM=0
  STRATUM_IN_USE=9999
  IRECS=0
  N_MALE_LFS=0
  N_FEMALE_LFS=0
  N_UNSEXED_LFS=0
  IER=0
  OPERATION=0

  DISTANCE=0
  READ(20,335,END=341) TITLE1_TEXT01
335  FORMAT(A80)
  WRITE(6,335)TITLE1_TEXT01

  WRITE(1,335) TITLE1_TEXT01
  IF (N_TRIP.GT.6) THEN

  WRITE(1,336) TITLE2_ALTERNATE_TEXT01
  WRITE(6,336) TITLE2_ALTERNATE_TEXT01
336  FORMAT(A49,31X)
  ELSE
  DO I=1, 6
  PRINT *, "DO LINE 462"
  TITLE2_TRIPNO(I)=0
  TITLE2_TEXT02(I)=' '
  TITLE2_YEAR(I)=0
  TITLE2_TEXT03(I)=' '
  PRINT *, "END DO LINE 463"
  END DO
  DO I=1, N_TRIP
  PRINT *, "DO LINE 470"
  TITLE2_TRIPNO(I)=TRIPS_TO_BE_SELECTED(2,I)
  TITLE2_TEXT02(I)=' 19'
  TITLE2_YEAR(I)=TRIPS_TO_BE_SELECTED(1,I)
  PRINT *, "END DO LINE 469"
  END DO
  WRITE(1,337) TITLE2_TEXT01,(TITLE2_TRIPNO(I),TITLE2_TEXT02(I),
  +  TITLE2_YEAR(I),TITLE2_TEXT03(I), I=1,6)
337  FORMAT(A20,6(I3,A3,I2,A2))
  WRITE(6,337) TITLE2_TEXT01,(TITLE2_TRIPNO(I),TITLE2_TEXT02(I),
  +  TITLE2_YEAR(I),TITLE2_TEXT03(I), I=1,6)
  END IF
  IF (N_VESSEL.GT.6) THEN

  TITLE3_ALTERNATE_TEXT01(14:19)='VESSEL'

  WRITE(1,338) TITLE3_ALTERNATE_TEXT01
  WRITE(6,338) TITLE3_ALTERNATE_TEXT01
338  FORMAT(A49,31(' '))
  ELSE
  DO I=1, 6
  PRINT *, "DO LINE 492"
  TITLE3_VESSEL(I)=0
  TITLE3_TEXT02(I)=' '
  PRINT *, "END DO LINE 489"
  END DO
  DO I=1, N_VESSEL
  PRINT *, "DO LINE 498"
  TITLE3_VESSEL(I)=VESSELS_TO_BE_SELECTED(I)
  write(6,*) "VESS BE SEL=",VESSELS_TO_BE_SELECTED(I)
  PRINT *, "END DO LINE 494"
  END DO

  WRITE(1,305) TITLE3_TEXT01,(TITLE3_VESSEL(I),TITLE3_TEXT02(I),
  +  I=1,6)
305  FORMAT(A20,6(I2,8(' ')))
  WRITE(6,305) TITLE3_TEXT01,(TITLE3_VESSEL(I),TITLE3_TEXT02(I),
  +  I=1,6)
  END IF
  IF (N_ICNAF.GT.17) THEN

  TITLE3_ALTERNATE_TEXT01(14:19)='ICNAF '

  WRITE(1,307) TITLE3_ALTERNATE_TEXT01
307  FORMAT(A80)
  ELSE
  TITLE4_TEXT01='  ICNAF'
  DO I=1, N_ICNAF
  PRINT *, "DO LINE 519"

  TITLE4_TEXT01(18+(3*I):20+(3*I))=ICNAF_TO_BE_SELECTED(I)
  write(6,*) "ICNAF TO BE SEL=",ICNAF_TO_BE_SELECTED(I)
  PRINT *, "END DO LINE 516"
  END DO
  IF (N_ICNAF.GT.1)
  +  TITLE4_TEXT01(23+(N_ICNAF*3):31+(N_ICNAF*3))='COMBINED'

  WRITE(1,307) TITLE4_TEXT01
  WRITE(6,307) TITLE4_TEXT01
  END IF

  DO
  PRINT *, "DO LINE 535"

  READ(20,339,END=341,IOSTAT=STAT) TEMP_RECORD_TEXT
  WRITE(6,339) TEMP_RECORD_TEXT
339  FORMAT(A80)
  IF (STAT.NE.0) EXIT

  WRITE(1,339) TEMP_RECORD_TEXT
  PRINT *, "END DO LINE 534"
  END DO

341  OPEN(16,FILE="LENFQ")
  OPEN(15,FILE="LENFQ2")
C  DO WHILE ('1'B)
  PRINT *, "BEFORE DO LINE 548"
  DO
  PRINT *, "DO LINE 548"

351  READ(16,355,END=391,IOSTAT=STAT) LF_VESSEL,LF_TRIP_NO,
  +  LF_STRATUM,LF_SET,LF_DAY,LF_MONTH,LF_YEAR,LF_ICNAF,
  +  LF_TYPE,LF_SPECIES,LF_NUMBER,LF_RATIO1,LF_SEX,LF_GEAR,
  +  LF_DAY_NITE,LF_FILL01,LF_GROUPING,LF_START,
  +  (LFS(ii),ii=1,100),LF_RATIO
355  FORMAT(I2,I3,I3,I3,I2,I2,I2,A2,I1,I4,I4,I2,I1,A1,I1,A1,I1,I3,
  +  100(I3),I5)
  WRITE(6,355) LF_VESSEL,LF_TRIP_NO,
  +  LF_STRATUM,LF_SET,LF_DAY,LF_MONTH,LF_YEAR,LF_ICNAF,
  +  LF_TYPE,LF_SPECIES,LF_NUMBER,LF_RATIO1,LF_SEX,LF_GEAR,
  +  LF_DAY_NITE,LF_FILL01,LF_GROUPING,LF_START,
  +  (LFS(ii),ii=1,100),LF_RATIO
  write(6,*) "LF_SEX=",LF_SEX
  IF (STAT.NE.0) EXIT  WRITE (STRING2,'(I3)') LF_STRATUM
  ICHK = 0
  DO I = 1, 3
  PRINT *, "DO LINE 586"
  K = ICHAR(STRING2(I:1))
  IF ((K.LT.48).OR.(K.GT.57)) THEN
  ICHK = 1
  END IF
  IF (ICHK.GT.0) GOTO 351
  END DO  IF (LF_STRATUM.EQ.0) GOTO 351
  IF (N_VESSEL.GT.1) THEN
  DO I=1, N_VESSEL
  PRINT *, "DO LINE 597"
  IF ((LF_VESSEL.EQ.VESSELS_TO_BE_SELECTED(I)) .AND.
  +  (LF_YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (LF_TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 604"
  IF (LF_SET.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 351
  END DO
  END IF
  GOTO 361
  END IF
  END DO
  GOTO 351
  END IF
  IF (LF_VESSEL.NE.VESSELS_TO_BE_SELECTED(1)) GOTO 351
  DO I=1, N_TRIP
  PRINT *, "DO LINE 615"
  IF ((LF_YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (LF_TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 621"
  IF (LF_SET.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 351
  END DO
  END IF
  GOTO 361
  END IF
  END DO
  GOTO 351

361  DO I=1, N_ICNAF
  PRINT *, "DO LINE 631"
  IF (LF_ICNAF.EQ.ICNAF_TO_BE_SELECTED(I)) GOTO 371
  END DO
  GOTO 351

371  IF (N_DELSTR.NE.0) THEN
  DO I=1, N_DELSTR
  PRINT *, "DO LINE 638"
  IF (LF_STRATUM.EQ.STRATUM_TO_BE_DELETED(I)) GOTO 351
  END DO
  END IF
  IF (N_SELSTR.NE.0) THEN
  DO I=1, N_SELSTR
  PRINT *, "DO LINE 644"
  IF (LF_STRATUM.EQ.STRATUM_TO_BE_SELECTED(I)) GOTO 381
  END DO
  GOTO 351
  END IF381  WRITE(15,385) LF_VESSEL,LF_TRIP_NO,LF_STRATUM,LF_SET,LF_DAY,
  +  LF_MONTH,LF_YEAR,LF_ICNAF,LF_TYPE,LF_SPECIES,
  +  LF_NUMBER,LF_RATIO,LF_SEX,LF_GEAR,LF_DAY_NITE,
  +  LF_FILL01,LF_GROUPING,LF_START,(LFS(ii),ii=1,100)
385  FORMAT(I2,I3,I3,I3,I2,I2,I2,A2,I1,I4,I4,I2,I1,A1,I1,A1,I1,
  +  I3,100(I3))
  write(6,*)"LF_SEX 2=",LF_SEX
  GOTO 351
  END DO391  REWIND(15)
  CLOSE(15)

  OPEN(19,FILE="SETCAT",BLANK="NULL")
  OPEN(4,FILE="TEMP5")

  DO
  PRINT *, "DO LINE 685"

392  READ(19,390,END=301,IOSTAT=STAT) CARD_TYPE,VESSEL,TRIP_NO,
  +  SET_NO,YEAR,MONTH,DAY,SET_TYPE,STRATUM,DIVISION,UNIT_AREA,
  +  LIGHT_CONDITION,WIND_DIRECTION,WIND_FORCE,SEA,BOTTOM_TYPE,
  +  TIME,DURATION,DISTANCE,OPERATION,DEPTH_MEAN,DEPTH_MIN,
  +  DEPTH_MAX,DEPTH_BOTTOM,TEMPERATURE_SURFACE,
  +  TEMPERATURE_FISHED,LATITUDE_DEG,LATITUDE_MIN,LONGITUDE_DEG,
  +  LONGITUDE_MIN,POSITION_METHOD,GEAR,SPECIES_CODE,
  +  SPECIES_NUMBER,SPECIES_WT
  WRITE(6,390) CARD_TYPE,VESSEL,TRIP_NO,
  +  SET_NO,YEAR,MONTH,DAY,SET_TYPE,STRATUM,DIVISION,UNIT_AREA,
  +  LIGHT_CONDITION,WIND_DIRECTION,WIND_FORCE,SEA,BOTTOM_TYPE,
  +  TIME,DURATION,DISTANCE,OPERATION,DEPTH_MEAN,DEPTH_MIN,
  +  DEPTH_MAX,DEPTH_BOTTOM,TEMPERATURE_SURFACE,
  +  TEMPERATURE_FISHED,LATITUDE_DEG,LATITUDE_MIN,LONGITUDE_DEG,
  +  LONGITUDE_MIN,POSITION_METHOD,GEAR,SPECIES_CODE,
  +  SPECIES_NUMBER,SPECIES_WT
389  FORMAT(I1,I2,I3,I3,I2,I2,I2,I2,I3,A2,A3,I3,I1,I1,I1,I1,I4,I3,
  +  F4.1,I1,I4,I4,I4,I4,F4.1,F4.1,I2,F4.1,I2,F4.1,I1,I4,I4,I6,F8.2)
390  FORMAT(I1,I2,I3,I3,I2,I2,I2,I2,I3,A2,A3,I3,I1,I1,I1,I1,I4,I3,
  +  I3,I1,I4,I4,I4,I4,I3,I3,I2,I3,I2,I3,I1,I4,I4,I6,I7)

  IF (SET_TYPE.NE.1) GOTO 392
  IF (CARD_TYPE.EQ.5) THEN

  WRITE (STRING2,'(I3)') STRATUM
  ICHK = 0
  DO I = 1, 3
  PRINT *, "DO LINE 776"
  K = ICHAR(STRING2(I:1))
  IF ((K.LT.48).OR.(K.GT.57)) THEN
  ICHK = 1
  END IF
  write(6,*)"ICHK=",ICHK
  IF (ICHK.GT.0) GOTO 392
  END DO
  WRITE(6,*) "****** ",STAT,SET_TYPE,CARD_TYPE,ICHK,STRATUM  IF (STRATUM.EQ.0) GOTO 392

  IF (N_VESSEL.GT.1) THEN
  write(6,*)"N_VESSEL GT1",N_VESSEL
  DO I=1, N_VESSEL
  PRINT *, "DO LINE 793"
  write(6,*) I," ",VESSEL," ",VESSELS_TO_BE_SELECTED(I)
  write(6,*) "  ",YEAR," ",TRIPS_TO_BE_SELECTED(1,I)
  write(6,*) "  ",TRIP_NO," ",TRIPS_TO_BE_SELECTED(2,I)
  IF ((VESSEL.EQ.VESSELS_TO_BE_SELECTED(I)) .AND.
  +  (YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  write(6,*) "N_SETDEL=",(N_SETDEL(ii),ii=1,20)
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 804"
  write(6,*) "SET_NO=",J,I,SET_NO,SETS_TO_BE_DELETED(J,I)
  IF (SET_NO.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 392
  END DO
  END IF
  GOTO 393
  END IF
  END DO
  GOTO 392
  END IF
  IF (VESSEL.NE.VESSELS_TO_BE_SELECTED(1)) GOTO 392
  DO I=1, N_TRIP
  PRINT *, "DO LINE 816"
  IF ((YEAR.EQ.TRIPS_TO_BE_SELECTED(1,I)) .AND.
  +  (TRIP_NO.EQ.TRIPS_TO_BE_SELECTED(2,I))) THEN
  IF (N_SETDEL(I).NE.0) THEN
  N1=N_SETDEL(I)
  DO J=1, N1
  PRINT *, "DO LINE 822"
  IF (SET_NO.EQ.SETS_TO_BE_DELETED(J,I)) GOTO 392
  END DO
  END IF
  GOTO 393
  END IF
  END DO
  GOTO 392

393  DO I=1, N_ICNAF
  PRINT *, "DO LINE 832"
  write(6,*)"DIV=",I,DIVISION,ICNAF_TO_BE_SELECTED(I)
  IF (DIVISION.EQ.ICNAF_TO_BE_SELECTED(I)) GOTO 394
  END DO
  GOTO 392
394  write(6,*)"N_DELSTR=",N_DELSTR
  IF (N_DELSTR.NE.0) THEN
  DO I=1, N_DELSTR
  PRINT *, "DO LINE 541"
  write(6,*)"STRATUM=",I,STRATUM,STRATUM_TO_BE_DELETED(I)
  IF (STRATUM.EQ.STRATUM_TO_BE_DELETED(I)) GOTO 392
  END DO
  END IF  write(6,*)"N_SELSTR=",N_SELSTR
  IF (N_SELSTR.NE.0) THEN
  DO I=1, N_SELSTR
  PRINT *, "DO LINE 849"
  write(6,*)"STBSEL=",I,STRATUM,STRATUM_TO_BE_SELECTED(I)
  IF (STRATUM.EQ.STRATUM_TO_BE_SELECTED(I)) GOTO 395
  END DO
  GOTO 392
  END IF395  write(6,*)"OPERATION,DIST=",OPERATION,DISTANCE
  IF (OPERATION.GT.2) THEN
  PRINT_LINE1_SET=SET_NO
  PRINT_LINE1_TRIP=TRIP_NO
  PRINT_LINE1_YEAR=YEAR
  PRINT_LINE1_VESSEL=VESSEL

  WRITE(6,345) PRINT_LINE1_TEXT01,PRINT_LINE1_SET,
  +  PRINT_LINE1_TEXT02,PRINT_LINE1_TRIP,
  +  PRINT_LINE1_TEXT03,PRINT_LINE1_YEAR,
  +  PRINT_LINE1_TEXT04,PRINT_LINE1_VESSEL,
  +  PRINT_LINE1_TEXT05
345  FORMAT(A5,I4,A7,I4,A5,I3,A9,I3,A39,54(' '))
  GOTO 392
  END IF
  IF (DISTANCE.EQ.0) THEN
  PRINT_LINE2_SET=SET_NO
  PRINT_LINE2_TRIP=TRIP_NO
  PRINT_LINE2_YEAR=YEAR
  PRINT_LINE2_VESSEL=VESSEL

  WRITE(6,346) PRINT_LINE2_TEXT01,PRINT_LINE2_SET,
  +  PRINT_LINE2_TEXT02,PRINT_LINE2_TRIP,
  +  PRINT_LINE2_TEXT03,PRINT_LINE2_YEAR,
  +  PRINT_LINE2_TEXT04,PRINT_LINE2_VESSEL,
  +  PRINT_LINE2_TEXT05
346  FORMAT(A5,I4,A7,I4,A5,I3,A9,I3,A30,63(' '))
  GOTO 392
  END IF

  write(6,*)"IAREA,STRATUM=",IAREA,STRATUM
  IF (IAREA.EQ.0) THEN
  IF ((STRATUM.GE.201 .AND. STRATUM.LE.236) .OR.
  +  (STRATUM.GE.301 .AND. STRATUM.LE.392) .OR.
  +  (STRATUM.GE.401 .AND. STRATUM.LE.408) .OR.
  +  (STRATUM.GE.501 .AND. STRATUM.LE.519) .OR.
  +  (STRATUM.GE.620 .AND. STRATUM.LE.649) .OR.
  +  (STRATUM.GE.705 .AND. STRATUM.LE.736) .OR.
  +  (STRATUM.GE.801 .AND. STRATUM.LE.834)) GOTO 396
  PRINT_LINE6_SET=SET_NO
  PRINT_LINE6_TRIP=TRIP_NO
  PRINT_LINE6_YEAR=YEAR
  PRINT_LINE6_VESSEL=VESSEL
  PRINT_LINE6_STRATUM=STRATUM

  WRITE(6,347) PRINT_LINE6_TEXT01,PRINT_LINE6_SET,
  +  PRINT_LINE6_TEXT03,PRINT_LINE6_TRIP,
  +  PRINT_LINE6_TEXT04,PRINT_LINE6_YEAR,
  +  PRINT_LINE6_TEXT05,PRINT_LINE6_VESSEL,
  +  PRINT_LINE6_TEXT06,PRINT_LINE6_STRATUM,
  +  PRINT_LINE6_TEXT07
347  FORMAT(A32,I4,A7,I4,A5,I3,A7,I3,A16,I4,48(' '))
  IER=1
  GOTO 392
  END IF

396  DO J=1, MAX_STRATUM
  write(6,*)"MAX_STRAT=",J,MAX_STRATUM,STRATUM,STRATUM_IN_USE(J)
  IF (STRATUM.EQ.STRATUM_IN_USE(J)) THEN
  GOTO 397
  END IF
  END DO
  ISTRATUM=ISTRATUM+1
  write(6,*)"MAX_STRAT=",MAX_STRATUM,STRATUM,STRATUM_IN_USE(1)
  write(6,*)"IST,MAX_STRAT=",MAX_STRATUM,ISTRATUM,STRATUM_IN_USE(1)
  IF (ISTRATUM.GT.MAX_STRATUM) THEN

  WRITE(6,348) PRINT_LINE4_TEXT01
348  FORMAT(A79,54X)
  IER=1
  GOTO 392
  END IF
  DO J=1, MAX_STRATUM
  PRINT *, "DO LINE 934"
  IF (STRATUM.LT.STRATUM_IN_USE(J)) THEN
  J1=J+1
  DO K=MAX_STRATUM, J1, -1
  PRINT *, "DO LINE 938"
  STRATUM_IN_USE(K)=STRATUM_IN_USE(K-1)
  END DO
  STRATUM_IN_USE(J)=STRATUM
  write(6,*)"348 LOOP ",J,STRATUM,STRATUM_IN_USE(J)
  GOTO 397
  END IF
  END DO

397  SET_OUT_SET_NO=SET_NO
  SET_OUT_SET_TYPE=SET_TYPE
  SET_OUT_STRATUM=STRATUM
  SET_OUT_DISTANCE=DISTANCE
  SET_OUT_DEPTH=DEPTH_MEAN

  WRITE(4,387) SET_OUT_FILL01,SET_OUT_SET_NO,SET_OUT_FILL02,
  +  SET_OUT_SET_TYPE,SET_OUT_STRATUM,SET_OUT_FILL03,
  +  SET_OUT_DISTANCE,SET_OUT_FILL04,SET_OUT_DEPTH,
  +  SET_OUT_FILL05
387  FORMAT(A6,I3,A6,I2,I3,A19,F4.1,A1,I4,A784)
  IRECS=IRECS+1

  OPEN(15,FILE="LENFQ2")
  LF_OUT_STRATUM=STRATUM
  LF_OUT_SET=SET_NO
  do ii=1,100
  PRINT *, "DO LINE 978"
  LFS_TEMP(ii,1)=0.0
  LFS_TEMP(ii,2)=0.0
  LFS_TEMP(ii,3)=0.0
  end do
  DO IPASS=1, N_SPECIES
  PRINT *, "DO LINE 984"
  SPECIES_CHK=SPECIES_TO_BE_SELECTED(IPASS)
  LF_OUT_SPECIES=SPECIES_CHK

  DO
  PRINT *, "DO LINE 990"

398  READ(15,400,END=399,IOSTAT=STAT) LF_VESSEL,LF_TRIP_NO,
  +  LF_STRATUM,LF_SET,LF_DAY,LF_MONTH,LF_YEAR,LF_ICNAF,
  +  LF_TYPE,LF_SPECIES,LF_NUMBER,LF_RATIO1,LF_SEX,LF_GEAR,
  +  LF_DAY_NITE,LF_FILL01,LF_GROUPING,LF_START,
  +  (LFS(ii),ii=1,100),LF_RATIO
400  FORMAT(I2,I3,I3,I3,I2,I2,I2,A2,I1,I4,I4,I2,I1,I1,I1,A1,
  +  I1,I3,100(I3),I5)
  write(6,'(A14,I1,A1,I5)')"LF_SEX STAT 3=",LF_SEX," ",STAT  write(6,*)"LF_SPECIES,SPECIES_CHK=",LF_SPECIES,SPECIES_CHK
  IF (LF_SPECIES.NE.SPECIES_CHK) GOTO 398
  write(6,*)"LF_VESSEL,VESSEL=",LF_VESSEL,VESSEL

  IF (LF_VESSEL.NE.VESSEL) GOTO 398
  write(6,*)"LF_YEAR,YEAR=",LF_YEAR,YEAR  IF (LF_YEAR.NE.YEAR) GOTO 398
  write(6,*)"LF_TRIP_NO,TRIP_NO=",LF_TRIP_NO,TRIP_NO  IF (LF_TRIP_NO.NE.TRIP_NO) GOTO 398
  write(6,*)"LF_SET,SET_NO=",LF_SET,SET_NO  IF (LF_SET.NE.SET_NO) GOTO 398
  write(6,*)"LF_STRATUM,STRATUM=",LF_STRATUM,STRATUM  IF (LF_STRATUM.NE.STRATUM) GOTO 398
  write(6,*) "LF_RATIO=",LF_RATIO  IF (LF_RATIO.EQ.0) THEN
  PROP=1.0
  ELSE
  PROP=100.0/LF_RATIO
  END IF
  write(6,*) "LF_SEX 4=",LF_SEX,PROP
  IF (LF_SEX.EQ.1) THEN
  DO I=1, 100
  PRINT *, "DO LINE 1023"
  LFS_TEMP(I,1)=LFS_TEMP(I,1)+LFS(I)*PROP
  write(6,*)"LF_S1X,I,TEMP,LFS=",LF_SEX,I,
  +  LFS_TEMP(I,1),LFS(I)
  END DO
  GOTO 398
  END IF
  IF (LF_SEX.EQ.5) THEN
  DO I=1, 100
  PRINT *, "DO LINE 1032"
  LFS_TEMP(I,2)=LFS_TEMP(I,2)+LFS(I)*PROP
  write(6,*)"LF_S2X,I,TEMP,LFS=",LF_SEX,I,
  +  LFS_TEMP(I,2),LFS(I)
  END DO
  GOTO 398
  END IF
  DO I=1, 100
  PRINT *, "DO LINE 1040"
  LFS_TEMP(I,3)=LFS_TEMP(I,3)+LFS(I)*PROP
  write(6,*)"LF_S3X,I,TEMP,LFS=",LF_SEX,I,
  +  LFS_TEMP(I,3),LFS(I)
  END DO
  GOTO 398
  END DO

399  write(6,*)"N_SEX=",N_SEX
  IF ((N_SEX.EQ.1) .OR. (N_SEX.EQ.3) .OR. (N_SEX.EQ.4)) THEN
  LF_OUT_SEX=1
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1052"
  LFS_OUT(I)=LFS_TEMP(I,1)+0.005
  write(6,*)"LFS_OUT&TEMP=",I,LFS_OUT(I),LFS_TEMP(I,1)
  IF (LFS_TEMP(I,1).GT.0.0) ICHK2=1  END DO
  write(6,*)"ICHK2=",ICHK2

  WRITE(4,388) LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_SPECIES,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
388  FORMAT(1X,I3,I3,9X,I3,7X,I1,100(F8.2))
  IF (ICHK2.GT.0) N_MALE_LFS=N_MALE_LFS+1
  END IF
  IF ((N_SEX.EQ.2) .OR. (N_SEX.EQ.3) .OR. (N_SEX.EQ.4)) THEN
  LF_OUT_SEX=5
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1070"
  LFS_OUT(I)=LFS_TEMP(I,2)+0.005
  IF (LFS_TEMP(I,2).GT.0.0) ICHK2=1
  END DO
  WRITE(4,388) LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_SPECIES,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
  IF (ICHK2.GT.0) N_FEMALE_LFS=N_FEMALE_LFS+1
  END IF
  IF (N_SEX.EQ.4) THEN
  LF_OUT_SEX=0
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1084"
  LFS_OUT(I)=LFS_TEMP(I,3)+0.005
  IF (LFS_TEMP(I,3).GT.0.0) ICHK2=1
  END DO
C  WRITE FILE(TEMP5) FROM(LF_OUT_RECORD)
  WRITE(4,388) LF_OUT_FILL01,LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_FILL02,LF_OUT_SPECIES,LF_OUT_FILL03,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
  IF (ICHK2.GT.0) N_UNSEXED_LFS=N_UNSEXED_LFS+1
  END IF
  IF (N_SEX.EQ.5) THEN
  LF_OUT_SEX=0
  ICHK2=0
  DO I=1, 100
  PRINT *, "DO LINE 1098"
  LFS_OUT(I) = LFS_TEMP(I,1) + LFS_TEMP(I,2)
  +  + LFS_TEMP(I,3) + 0.005
  IF ((LFS_TEMP(I,1).GT.0.0) .OR. (LFS_TEMP(I,2).GT.0.0)
  +  .OR. (LFS_TEMP(I,3).GT.0.0)) ICHK2=1
  END DOC  WRITE FILE(TEMP5) FROM(LF_OUT_RECORD)
  WRITE(4,388) LF_OUT_FILL01,LF_OUT_STRATUM,LF_OUT_SET,
  +  LF_OUT_FILL02,LF_OUT_SPECIES,LF_OUT_FILL03,
  +  LF_OUT_SEX,(LFS_OUT(ii),ii=1,100)
  IF (ICHK2.GT.0) N_UNSEXED_LFS=N_UNSEXED_LFS+1
  END IFC  CLOSE FILE(LENFQ2) ENV(REWIND_ON_CLOSE)
  REWIND(15)
  CLOSE(15)
  END DO
  END IF
  END DO
C
  END SUBROUTINE MREAD3

Hi, Debbieanne:

I don't know what we can do for you about finding your problem. You have posted one subroutine MREAD3 from what is a larger program.

How do you know that the problem is in this particular subroutine and not some other part of the program? What other debugging have you done to trace where the program fails?

In any event, when posting code to the PF, please use {CODE} tags to enclose the source code so that any spacing is not lost when you post.

debbieanne · Sep 10, 2015

DavidSnider said:

Holy &#@*(@. Not sure what's broken, but you have my sympathy.
Have you run it through a debugger to identify the portions that are going through an infinite loop? Does it always do an infinite loop or just on certain parameters?

Hi David. Thanks for your response. I believe I have found the offending piece of code in a linked object file. I started learning GDB to debug yesterday ! The main program calls many linked subroutines. I'm not sure yet how to use GDB to step through an object file to see how the variables change. I'll research that as the day progresses.

When I run the code below I get STRATUM, SPECIES and SEX printing the same info multiple times. I have to use CTRL C to stop the run.
GO TO 74
70 write(6,*)"Not combining strata...I2,I3=",I2,I3
WRITE(6,203) (ISPC(I1),I1=I2,I3),KSTR
203 FORMAT('SPECIES:',3A4/'STRATUM:',I3)
74 WRITE(6,215) HD5(ISX),HD5(ISX+1)
215 FORMAT('SEX:',2A4)

The complete object file code is below (I apologize for the length):
SUBROUTINE ANAL1(ALPHA,K,IFRST)
C
C
C THIS ROUTINE READS IN AREAS
C THE DATA ARE READ IN FROM TEMP. STORAGE AND PREPARED FOR
C THE ESTIMATION ROUTINE
C
C SET DETAILS ARE PRINTED OUT
C
C
C
DIMENSION ALPHA(1),KCV(80,100),KSTS(100),KST2(100),IDUMMY(800)
DIMENSION SAREA(2,100)
DIMENSION N(100),NSET(150),SETD(81,150),AVG(81,100)
DIMENSION VAR(81,100),SSM(2)
CHARACTER*4 HD1(4), HD2(4), HD3(4), HD4(3), HD5(8), CODE(50)
COMMON/BLK1/ IND(16),ICOM(50,50),MXICOM
COMMON/BLK2/ ISPC(18),TITLE1(20),TITLE2(20),TITLE3(20),TITLE4(20)
COMMON/BLK3/ LGRP(2),SSUM(2,4,2,2),WVECT(2,4,80)
COMMON/BLK7/ IIM(2),IIF(2),IIU(2),IIC(2)

INTEGER IDUM,IDUM2,ISTRAT,JSTRAT,JSEX,ISEX,ICNT,NL2

HD1 = (/' ','AGE ',' LEN','GTH '/)
HD2 = (/'IN Y','EARS','IN C','MS. '/)
HD3 = (/'NUMB','ERS ','WEIG','HTS '/)
HD4 = (/' ',' ',' '/)
HD5 = (/' MAL','E ',' FEM','ALE ',' UNS','EXED','COMB','INED'/)
CODE = (/' A',' B',' C',' D',' E',' F',' G',' H',' I',' J',' K',
2 ' L',' M',' N',' O',' P',' Q',' R',' S',' T',' U',' V',
3 ' W',' X',' Y',' Z','AA','BB','CC','DD','EE','FF','GG',
4 'HH','II','JJ','KK','LL','MM','NN','OO','PP','QQ','RR',
5 'SS','TT','UU','VV','WW','XX'/)
MXM=0
IERROR=0
IB=1
C
write(6,*)"Into ANAL1,IIM,IIF,IIU=",IIM(1),IIF(1),IIU(1)
write(6,*)"Into ANAL1,IND 11 =",IND(11)
C
C INITIALIZE ARRAYS
C
OPEN(2,FILE="TEMP3")
C
DO 1 I1=1,80
DO 2 I2=1,150
SETD(I1,I2)=0.
NSET(I2)=0
2 CONTINUE
DO 1 I3=1,100
VAR(I1,I3)=0.
AVG(I1,I3)=0.
KCV(I1,I3)=0.0
1 CONTINUE
C
C FOLLOWING SECTION OF CODE USED ONLY ON FIRST PASS THRU
C THE DATA.
C
OPEN(9,FILE="TEMP9")

write(6,*)"IFRST=",IFRST
IF (IFRST.EQ.1) GOTO 10017
IFRST=1
C
C DETERMINE IF ANY STRATUM HAVE LESS THAN 2 SETS AND SET THESE
C UP FOR DELETION.
C
NL2=0
READ (9,101) IDUM,JSTRAT,IDUM2,JSEX
write(6,101) IDUM,JSTRAT,IDUM2,JSEX
C10088 FORMAT(I2,I3,I3,I2,32E14.7)
10088 FORMAT(I2,I3,I3,I2)
REWIND(9)
ICNT=0
10010 READ (9,101,END=10013) IDUM,ISTRAT,IDUM2,ISEX
C10010 READ (9,10088,END=10013) IDUM,ISTRAT,IDUM2,ISEX
write(6,*) ISTRAT,JSTRAT,ISEX,JSEX,ICNT,"10010",NL2
101 FORMAT(I2,I3,I3,I2,32E14.7)
IF (ISTRAT.NE.JSTRAT) GOTO 10011
IF (ISEX.NE.JSEX) GOTO 10014
ICNT=ICNT+1
GOTO 10010
10011 IF (ICNT.GE.2) GOTO 10012
write(6,*) "10011"
NL2=NL2+1
IDUMMY(NL2)=JSTRAT
10012 ICNT=1
write(6,*) "10012"
JSTRAT=ISTRAT
GOTO 10010
10013 write(6,*)"ICNT=",ICNT
write(6,*) "10013"
IF (ICNT.GE.2) GOTO 10014
NL2=NL2+1
IDUMMY(NL2)=JSTRAT
10014 CONTINUE
write(6,*) "10014"
REWIND 9
C
C READ STRATUM AREAS ADJUSTING IF NECESSARY BY USE OF AREA
C ROUTINES.
C
do ii=1,16
write(6,*)"IND(",ii,")", IND(ii)
end do
ATOT=0.0
ICM=0
IF (IND(6).GT.0) GOTO 10000
IF (IND(7).EQ.0) GOTO 10001
ICM=1
10000 write(6,*)"Calling AREA..."
CALL AREA (ICM,SAREA,ATOT,IDUMMY,NL2)
GOTO 10003
10001 CONTINUE
C REWIND 2
CLOSE(9)
OPEN(9,FILE="TEMP9")
ISN=1
10002 READ(2,100,END=10004) (SAREA(IB,ISN),IB=1,2)
write(6,*)"IB,ISN=",IB,ISN
write(6,*)"SAREA=",(SAREA(IB,ISN),IB=1,2),NL2
100 FORMAT (F3.0,F4.0)
IF (NL2.EQ.0) GOTO 10015
DO 10016 IB=1,NL2
ST=IDUMMY(IB)
write(6,*)"ST,SAREA(1,ISN)=",ST,SAREA(1,ISN)
IF (ST.EQ.SAREA(1,ISN)) GOTO 10002
10016 CONTINUE
10015 CONTINUE
SAREA(2,ISN)=SAREA(2,ISN)/((IND(13)/1000./6080.2)*IND(12)/1000.0)
ATOT=ATOT+SAREA(2,ISN)
write(6,*)"ATOT=",ATOT
ISN=ISN+1
GOTO 10002
10003 ISN=ICM
10004 CONTINUE
ISN=ISN-1
C
C
C DETERMINE IF LENGTH ONLY
C
write(6,*)"ISN,K=",ISN,K
C
10017 CONTINUE
IF(K.EQ.0) GO TO 23
C
C
C READ IN AND PREPARE AGED DATA
C
C
C
MXM=0
LL=32
IST=0
NST=1
KST=1
ISXX=0
39 READ(9,101,END=3535) I,LSTR,NSET(KST),ISEX,(SETD(L1,KST),L1=1,32)
write(6,*) I,LSTR,NSET(KST),ISEX,(SETD(L1,KST),L1=1,2)
C101 FORMAT(I2,I3,I3,I2,32E14.7)
C
C SUMMARIZE AGES/LENGTHS IF REQUESTED
C
IF(IND(16).EQ.0) GO TO 8
DO 4 ISM=1,2
SSM(ISM)=0.
IS1=SSUM(I,ISEX,ISM,1)
IS2=SSUM(I,ISEX,ISM,2)
IF(IS2.EQ.0) GO TO 4
DO 5 IY1=IS1,IS2
SSM(ISM)=SSM(ISM)+SETD(IY1,KST)
5 CONTINUE
4 CONTINUE
IID=0
DO 6 ISM=1,2
IS1=SSUM(I,ISEX,ISM,1)
IS2=SSUM(I,ISEX,ISM,2)
IF(IS2.EQ.0) GO TO 6
SETD(IS2,KST)=SSM(ISM)
IS2=IS2-1
DO 7 IY1=IS1,IS2
IF(IY1.EQ.IID) GO TO 7
SETD(IY1,KST)=0.0
7 CONTINUE
IID=IS2+1
6 CONTINUE
8 INC=1
write(6,*)"KST=",KST,ISXX,ISEX,LSTR,KSTR
IF(KST.EQ.1) GO TO 30
IF (ISXX.NE.ISEX) GOTO 30
IF(LSTR.NE.KSTR) GO TO 31
30 KSTR=LSTR
ISXX=ISEX
C
C
C CHECK COUNTERS
C
C
C
write(6,*)"Counters...K,NST,M,F,U=",K,NST,IIM(I),IIF(I),IIU(I)
IF(K-2) 32,33,34
32 IF(NST.EQ.IIM(I)) GO TO 35
GO TO 36
33 IF(NST.EQ.IIF(I)) GO TO 35
GO TO 36
34 IF(K-3) 36,37,38
37 IF(NST.EQ.IIC(I)) GO TO 35
GO TO 36
38 IF(NST.EQ.IIU(I)) GO TO 35
36 NST=NST+1
KST=KST+1
GO TO 39
C
C
C END OF STRATUM- CALL ESTIMATION ROUTINE
C
C
C
31 write(6,*)"End of stratum- calling EST1 routine...",KST
KST=KST-1
IF (KST.GT.1) GOTO 3131
MX=1
IERROR=1
GOTO 41
3131 IST=IST+1
KSTS(IST)=KSTR
write(6,*)"Calling EST1..."
CALL EST1(SETD,NSET,KST,KSTR,AVG,VAR,MXM,LL,HD4,MX,N,IST,IERROR,
2 KCV)
GO TO 41
C
C
C END OF DATA SET,I.E. LAST STRATUM CALL EST1
C
C
C
3535 KST=KST-1
35 INC=0
IF (KST.LE.1) IERROR=1
IF (KST.LE.1) GOTO 41
IST=IST+1
KSTS(IST)=KSTR
write(6,*)"Calling EST1..."
CALL EST1(SETD,NSET,KST,KSTR,AVG,VAR,MXM,LL,HD4,MX,N,IST,IERROR,
2 KCV)
C
C
C PRINT OUT SET DETAILS
C
C
C
GO TO 41
C
C
C LENGTH ONLY
C
C
C
23 II=IND(14)
DO 48 I=1,II
IGRP=0
IG1=0
C
C
C DETERMINE NUMBER OF ANALYSISES REQUIRED
C
C
C
write(6,*)"IIM,IIF,IIU=",IIM(I),IIF(I),IIU(I)
IF(IIM(I).GT.0) IGRP=IGRP+1
IF(IIF(I).GT.0) IGRP=IGRP+1
IF(IIU(I).GT.0) IGRP=IGRP+1
IF(IND(4).EQ.1.OR.IND(2).NE.-1) IGRP=IGRP+1
64 NST=1
IST=0
IG1=IG1+1
KST=1
LL=81
C
C
C READ AND PREPARE LENGTH DATA
C
C
C
52 READ(9,102,END=4747) LSTR,NSET(KST),ISEX,(SETD(L1,KST),L1=1,81)
write(6,*) LSTR,NSET(KST),ISEX
102 FORMAT(2X,I3,I3,I2,81E14.7)
INC=1
IF(KST.EQ.1) GO TO 42
IF(LSTR.NE.KSTR) GO TO 43
42 KSTR=LSTR
C
C
C CHECK COUNTERS
C
C
C
IF(ISEX-2) 44,45,46
44 IF(NST.EQ.IIM(I)) GO TO 47
GO TO 49
45 IF(NST.EQ.IIF(I)) GO TO 47
GO TO 49
46 IF(ISEX-3) 49,50,51
50 IF(NST.EQ.IIC(I)) GO TO 47
GO TO 49
51 IF(NST.EQ.IIU(I)) GO TO 47
49 NST=NST+1
KST=KST+1
GO TO 52
C
C END OF STRATUM-CALL EST1
C
43 KST=KST-1
IF (KST.GT.1) GOTO 4343
MX=1
IERROR=1
GOTO 41
4343 IST=IST+1
KSTS(IST)=KSTR
CALL EST1(SETD,NSET,KST,KSTR,AVG,VAR,MXM,LL,HD4,MX,N,IST,IERROR,
2 KCV)
GO TO 41
C
C END OF DATA-LAST STRATUM, CALL EST1
C
4747 KST=KST-1
47 INC=0
IF (KST.LE.1) IERROR=1
IF (KST.LE.1) GOTO 41
IST=IST+1
KSTS(IST)=KSTR
write(6,*)"Calling EST1..."
CALL EST1(SETD,NSET,KST,KSTR,AVG,VAR,MXM,LL,HD4,MX,N,IST,IERROR,
2 KCV)
C
C
C PRINT OUT SET DETAILS
C
C
C
41 CONTINUE
C
C
C SET POSITIONS FOR TITLES
C
C
C
IF(IND(5).EQ.1) GO TO 53
L2=1
L3=2
GO TO 54
53 L2=3
L3=4
54 IF(IND(15).EQ.0) GO TO 55
L4=3
L5=4
GO TO 56
55 L4=1
L5=2
56 write(6,*) "IF(ISEX-2)=",ISEX-2
IF(ISEX-2) 80,81,82
80 ISX=1
GO TO 85
81 ISX=3
GO TO 85
82 IF(ISEX-3) 85,83,84
83 ISX=5
GO TO 85
84 ISX=7
C
C
C PRINT HEADERS
C
C
C
85 CONTINUE
KKST=KST
INT=1
IPU=KST/10
IF (IPU*10.NE.KST) IPU=IPU+1
KST=10
KST=MIN0(KST,KKST)
DO 7475 IPT=1,IPU
WRITE(6,200) (HD1(L1),L1=L2,L3),HD3(L4),HD3(L5)
200 FORMAT(46X,2A4,'COMPOSITION-',2A4,'PER STANDARD TOW')
WRITE(6,201) TITLE1
201 FORMAT(20A4)
WRITE(6,202) TITLE2,TITLE3,TITLE4
202 FORMAT(20A4/' ',20A4/' ',20A4)
C There's one species
I2=1
I3=3
write(6,*)"I,I2,I3=",I,I2,I3
IF(I.EQ.1) GO TO 57
C There's a second species
I2=4
I3=6
write(6,*)"I2,I3=",I2,I3
57 write(6,*)"IND7 = ",IND(7)
IF(IND(7).NE.1) GO TO 70
C
C
C CHECK FOR COMBINED STRATA
C
C
C
write(6,*)"Checking for combined strata..."
M=0
NGRP=IND(8)
DO 71 IL=1,NGRP
IF(KSTR.NE.ICOM(IL,1)) GO TO 71
M=IL
GO TO 72
71 CONTINUE
72 CONTINUE
write(6,*)"M,I2,I3=",M,I2,I3
IF(M) 70,70,73
73 CONTINUE
DO 10005 JJ1=1,MXICOM
IF (ICOM(M,JJ1).EQ.0) GOTO 10006
LLY=JJ1
10005 CONTINUE
10006 CONTINUE
WRITE(6,207) (ISPC(I1),I1=I2,I3),CODE(M),(ICOM(M,LY),LY=1,LLY)
207 FORMAT('SPECIES:',3A4/'STRATUM:',A4,5X,'I.E. STRATA ',
2 25I4/' ',25X,25I4)
GO TO 74
70 write(6,*)"Not combining strata...I2,I3=",I2,I3
WRITE(6,203) (ISPC(I1),I1=I2,I3),KSTR
203 FORMAT('SPECIES:',3A4/'STRATUM:',I3)
74 WRITE(6,215) HD5(ISX),HD5(ISX+1)
215 FORMAT('SEX:',2A4)
C
C
C WRITE COLUMN HEADINGS
C
C
C
write(6,*)"IPT,IPU=",IPT,IPU
IF (IPT.EQ.IPU) WRITE(6,204) HD1(L2),HD1(L3)
204 FORMAT(2A4,43X,'SET DETAILS',46X,'SET STATISTICS',4X,'TOTAL'/
2 124X,'ABUNDANCE')
IF (IPT.NE.IPU) WRITE (6,2041) HD1(L2),HD1(L3)
2041 FORMAT(2A4,43X,'SET DETAILS')
WRITE(6,205) HD2(L2),HD2(L3),(NSET(L1),L1=INT,KST)
205 FORMAT(2A4,3X,11I8/13X,7I8)
IF (IPT.EQ.IPU) WRITE(6,212)
212 FORMAT(107X,'AVG.',6X,'VAR.',3X,'(1000''S)')
IF (IERROR.LE.0) GOTO 8888
WRITE (6,2001)
2001 FORMAT (////' ONLY ONE SET IN THIS STRATUM'/
2 ' NO CALCULATIONS WERE DONE')
IERROR=0
GOTO 7475
8888 CONTINUE
C
C
C DETERMINE AGE(LENGTH) INCREMENTS
C
C
C
GN=1.0
IF(IND(5).NE.1) GO TO 76
IF(LGRP(I).EQ.2) GN=0.5
C
C
C PRINT OUT SET DETAILS
C
C
C
76 CONTINUE
IF (MX.GT.0) GOTO 7676
WRITE (6,2000)
2000 FORMAT (////' NO NON-ZERO SET DETAILS FOR THIS STRATUM')
GOTO 6565
7676 CONTINUE
IY1=1
DO 60 L1=1,MX
TOT=(AVG(L1,IST)*SAREA(2,IST))/1000.0
IF (IND(16).EQ.0) GOTO 2061
IS2=SSUM(I,ISEX,IY1,2)
IF (IS2.EQ.0) GOTO 2061
IS1=SSUM(I,ISEX,IY1,1)
IF (GN.NE.IS2) GOTO 58
WRITE (6,2063) IS1,IS2,(SETD(L1,N2),N2=1,KST)
2063 FORMAT (' ',1X,I3,'-',I3,4X,11F8.2)
IY1=IY1+1
GOTO 2062
2061 WRITE(6,206) GN,(SETD(L1,N2),N2=INT,KST)
206 FORMAT(1X,F5.1,6X,11F8.2/14X,7F8.2)
2062 IF (IPT.EQ.IPU) WRITE(6,211) AVG(L1,IST),VAR(L1,IST),TOT
211 FORMAT(104X,F8.2,2F10.2)
IF (IY1.GT.2) GOTO 6060
IF(IND(5)) 58,58,59
58 GN=GN+1.0
GO TO 60
59 GN=GN+LGRP(I)
60 CONTINUE
6060 CONTINUE
C
C
C PRINT UNKNOWN AND TOTAL IF AGED
C
C
C
IF (IND(16).EQ.1) GOTO 7475
IF(IND(5).EQ.1) GO TO 75
TOT=(AVG(31,IST)*SAREA(2,IST))/1000.0
WRITE(6,208) (SETD(31,N2),N2=INT,KST)
IF (IPT.EQ.IPU) WRITE(6,211) AVG(31,IST),VAR(31,IST),TOT
TOT=(AVG(32,IST)*SAREA(2,IST))/1000.0
WRITE(6,209) (SETD(32,N2),N2=INT,KST)
IF (IPT.EQ.IPU) WRITE(6,211) AVG(32,IST),VAR(32,IST),TOT
208 FORMAT(' ','UNKNOWN',5X,11F8.2/14X,7F8.2)
209 FORMAT(' ',' TOTAL ',5X,11F8.2/14X,7F8.2)
GO TO 77
75 WRITE(6,209) (SETD(81,N2),N2=INT,KST)
TOT=(AVG(81,IST)*SAREA(2,IST))/1000.0
IF (IPT.EQ.IPU) WRITE(6,211) AVG(81,IST),VAR(81,IST),TOT
77 WRITE(6,210) HD4
210 FORMAT('0','ESTIMATION TYPE:',2A4,3X,'TRANSFORMATION TYPE:',A4)
6565 CONTINUE
INT=INT+10
KST10=KST+10
KST=MIN0(KST10,KKST)
7475 CONTINUE
KST=KKST
66 IF(INC.EQ.0) GO TO 61
C
C
C ZERO SETD AND NSET ARRAYS
C
C
C
DO 62 L1=1,KST
NSET(L1)=0
DO 62 N2=1,MX
SETD(N2,L1)=0.0
62 CONTINUE
KST=KST+1
DO 63 L1=1,LL
63 SETD(L1,1)=SETD(L1,KST)
NSET(1)=NSET(KST)
KST=1
IF(IND(5).EQ.1) GO TO 42
GO TO 30
C
C
C CALL SUMMARY ROUTINE
C
C
61 CONTINUE
write(6,*)"IND 11 =",IND(11)
IF (IND(11).NE.-1) GOTO 6161
C
C W3MIX OPTION (SE SMITH,1981)
C
write(6,*)"Calling EST11..."
CALL EST11 (SETD,NSET,KST,KSTR,AVG,VAR,MXM,LL,HD4,MX,N,
+ IST,IERROR,KCV)
GN=1.0
IF (IND(5).NE.1) GOTO 10007
IF (LGRP(I).EQ.2) GN=0.5
10007 KIT=0
WRITE (6,61610)
61610 FORMAT ('1AGE/LENGTH STRATA WHICH HAVE BEEN ADJUSTED',
2 ' THROUGH THE USE OF THE W3MIX OPTION:')
DO 10008 II1=1,MXM
KKT=0
DO 61612 J=1,IST
IF (KCV(II1,J).LE.0.0) GOTO 61612
KIT=1
KKT=KKT+1
KST2(KKT)=KSTS(J)
61612 CONTINUE
IF (KKT.EQ.0) GOTO 61611
WRITE (6,61615) GN,(KST2(JJ),JJ=1,KKT)
61615 FORMAT ('0',F4.1,' : ',20I4/' ',8X,20I4/' ',8X,20I4)
61611 CONTINUE
IF (IND(5).EQ.0) GOTO 10009
GN=GN+LGRP(I)
GOTO 10008
10009 GN=GN+1.0
10008 CONTINUE
write(6,*)"KIT=",KIT
IF (KIT.EQ.1) GOTO 6161
WRITE (6,61616)
61616 FORMAT ('-NO STRAT AFFECTED BY W3MIX OPTION')
6161 CALL SUMRY(AVG,VAR,N,HD1(L2),HD1(L3),HD2(L2),HD2(L3),HD3(L4),HD3(L
*5),HD5(ISX),HD5(ISX+1),HD4,MXM,ALPHA,SAREA,IST,I,ATOT)
IF(IND(5).LT.1) RETURN
IF(IG1.EQ.IGRP) GO TO 48
GO TO 64
48 CONTINUE
RETURN
END SUBROUTINE ANAL1

debbieanne · Sep 10, 2015

SteamKing said:

Hi, Debbieanne:

I don't know what we can do for you about finding your problem. You have posted one subroutine MREAD3 from what is a larger program.

How do you know that the problem is in this particular subroutine and not some other part of the program? What other debugging have you done to trace where the program fails?

In any event, when posting code to the PF, please use {CODE} tags to enclose the source code so that any spacing is not lost when you post.

Hi,

I've made some progress. Issue resolved. The code block should have only printed the information for either MALES or FEMALES. But in fact it was printing duplicate information. If the species was female, for instance, it should have just printed out female and the associated stats. Instead it would print out females and the associated stats, then it would print out males and the same stats again. Thanks so much for your patience and help.

Side Note: When I posted my code I used the + (plus sign) in this editor. I got a drop down menu. I selected Fortran and posted my code but it hung indefinitely. I had to log out of the post and log back into send it. After logging back in the code was pasted in but the Fortran intel wasn't there. Maybe I did something wrong.

Vanadium 50 · Sep 12, 2015

Glad it's working for you.

Some advice - given that you've needed our help twice in the last year, you should think about rewriting this code to be more maintainable. It can still be FORTRAN - although it doesn't have to be - but it should have more structure (vs. "goto hopscotch") and more comments. It will take some time, but at the end of the process you'll understand it better, and someone who looks at the code later will understand it better.

DEvens · Sep 14, 2015

Vanadium 50 said:

Glad it's working for you.

Some advice - given that you've needed our help twice in the last year, you should think about rewriting this code to be more maintainable. It can still be FORTRAN - although it doesn't have to be - but it should have more structure (vs. "goto hopscotch") and more comments. It will take some time, but at the end of the process you'll understand it better, and someone who looks at the code later will understand it better.

What he said. That is excellent advice. Can't tell you the degree of frustration I experience when somebody brings me 1000 lines of Fortran and expects me to be able to fix it in 20 minutes because it has "just one small problem." And it looks like a plate of pasta.

One or two good books on the subject would not be a bad idea. One of my favorites:

https://www.amazon.com/dp/0735619670/?tag=pfamazon01-20

The ideas and examples in this book will show you what Vanadium is talking about.

Edit: Ok, I don't know what's up with the link that was there. I had intended to point at Amazon. But it wound up pointing at something else. I have re-edited it.

Mark44 · Sep 14, 2015

DEvens said:

One or two good books on the subject would not be a bad idea. One of my favorites:

http://www.walmart.com/ip/2617080

The ideas and examples in this book will show you what Vanadium is talking about.

The book referred to above is "Code Complete, 2nd Ed.", by Steve McConnell. It's one of my favorites as well.

Why Does This Fortran Code Result in an Infinite Loop?

1. What is a Fortran infinite loop?

2. How do I know if my program has an infinite loop in Fortran?

3. What are the consequences of an infinite loop in Fortran?

4. How can I prevent an infinite loop in Fortran?

5. Are there any tools or techniques for detecting and fixing infinite loops in Fortran?

Similar threads

Hot Threads

Recent Insights