Dismiss Notice
Join Physics Forums Today!
The friendliest, high quality science and math community on the planet! Everyone who loves science is here!

Fortran infinite loop

  1. Sep 9, 2015 #1
    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 (Text):
    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 IF


    381  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 DO


    391  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 IF


    395  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 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


    C  CLOSE FILE(LENFQ2) ENV(REWIND_ON_CLOSE)
      REWIND(15)
      CLOSE(15)
      END DO
      END IF
      END DO
    C
      END SUBROUTINE MREAD3
     
    Last edited by a moderator: Sep 9, 2015
  2. jcsd
  3. Sep 9, 2015 #2

    DavidSnider

    User Avatar
    Gold Member

    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?
     
  4. Sep 9, 2015 #3

    DEvens

    User Avatar
    Education Advisor
    Gold Member

    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."
     
  5. Sep 9, 2015 #4

    DavidSnider

    User Avatar
    Gold Member

    If you are paying $150 an hour to debug code like this you are paying 3 times too much.
     
  6. Sep 9, 2015 #5

    DEvens

    User Avatar
    Education Advisor
    Gold Member

    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.
     
  7. Sep 9, 2015 #6

    SteamKing

    User Avatar
    Staff Emeritus
    Science Advisor
    Homework Helper

    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.
     
  8. Sep 10, 2015 #7
    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
     
  9. Sep 10, 2015 #8
    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 in to send it. After logging back in the code was pasted in but the Fortran intel wasn't there. Maybe I did something wrong.
     
  10. Sep 12, 2015 #9

    Vanadium 50

    User Avatar
    Staff Emeritus
    Science Advisor
    Education Advisor

    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.
     
  11. Sep 14, 2015 #10

    DEvens

    User Avatar
    Education Advisor
    Gold Member

    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/Code-Complete-Practical-Handbook-Construction/dp/0735619670/

    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.
     
    Last edited: Sep 14, 2015
  12. Sep 14, 2015 #11

    Mark44

    Staff: Mentor

    The book referred to above is "Code Complete, 2nd Ed.", by Steve McConnell. It's one of my favorites as well.
     
Know someone interested in this topic? Share this thread via Reddit, Google+, Twitter, or Facebook




Similar Discussions: Fortran infinite loop
  1. Infinite Loop (Replies: 0)

  2. Fortran Help (Do Loop) (Replies: 3)

Loading...