C SccsID = "@(#)usng_set.f 1.7 07/23/04" SUBROUTINE UTM2USNG(GZD, NORTH, EAST, IZ, DATUM, * USNG_VALUE) REAL*8 NORTH, EAST INTEGER IZ CHARACTER*2 DATUM CHARACTER*25 USNG_VALUE CHARACTER*2 SET1(20,8) CHARACTER*2 SET2(20,8) CHARACTER*2 SET3(20,8) CHARACTER*2 SET4(20,8) CHARACTER*2 SET5(20,8) CHARACTER*2 SET6(20,8) CHARACTER*2 GRID_ID CHARACTER*1 GZD INTEGER NORTH_1M, EAST_1M INTEGER PCODE COMMON/SETS/SET1,SET2,SET3,SET4,SET5,SET6 COMMON/PRECISE/PCODE CALL GET_100_LEVEL(IZ, NORTH, EAST, *GRID_ID, NORTH_1M, EAST_1M) IF (PCODE .EQ. 3) THEN WRITE(USNG_VALUE, 1000) IZ, GZD, * GRID_ID, EAST_1M, NORTH_1M, * DATUM 1000 FORMAT(I2, A1, A2, I3.3, I3.3, '(NAD ', A2,')') ELSEIF (PCODE .EQ. 2) THEN WRITE(USNG_VALUE, 1001) IZ, GZD, * GRID_ID, EAST_1M, NORTH_1M, * DATUM 1001 FORMAT(I2, A1, A2, I4.4, I4.4, '(NAD ', A2,')') ELSE WRITE(USNG_VALUE, 1002) IZ, GZD, * GRID_ID, EAST_1M, NORTH_1M, * DATUM 1002 FORMAT(I2, A1, A2, I5.5, I5.5, '(NAD ', A2,')') ENDIF RETURN END C------------------------------------------------------------- SUBROUTINE GET_100_LEVEL(IZ, NORTH, EAST, * GRID_ID, NORTH_1M, EAST_1M) INTEGER IZ REAL*8 NORTH, EAST CHARACTER*2 GRID_ID INTEGER NORTH_1M, EAST_1M INTEGER ROW, COL CHARACTER*2 SET1(20,8) CHARACTER*2 SET2(20,8) CHARACTER*2 SET3(20,8) CHARACTER*2 SET4(20,8) CHARACTER*2 SET5(20,8) CHARACTER*2 SET6(20,8) INTEGER SET_NO REAL*8 RN, RE INTEGER PCODE COMMON/SETS/SET1,SET2,SET3,SET4,SET5,SET6 COMMON/PRECISE/PCODE ROW = 0 NORTH_1M = DABS(DNINT(NORTH)) DO WHILE (NORTH_1M .GE. 100000) NORTH_1M = NORTH_1M - 100000 ROW = ROW + 1 END DO ROW = ROW + 1 DO WHILE (ROW .GT. 20) ROW = ROW - 20 END DO COL = 0 EAST_1M = DNINT(EAST) DO WHILE (EAST_1M .GE. 100000) EAST_1M = EAST_1M - 100000 COL = COL + 1 END DO DO WHILE (COL .GT. 8) COL = COL - 8 END DO SET_NO = 0 CALL FIND_SET(IZ, SET_NO) IF (SET_NO .EQ. 1) THEN GRID_ID = SET1(ROW, COL) ELSEIF (SET_NO .EQ. 2) THEN GRID_ID = SET2(ROW, COL) ELSEIF (SET_NO .EQ. 3) THEN GRID_ID = SET3(ROW, COL) ELSEIF (SET_NO .EQ. 4) THEN GRID_ID = SET4(ROW, COL) ELSEIF (SET_NO .EQ. 5) THEN GRID_ID = SET5(ROW, COL) ELSEIF (SET_NO .EQ. 6) THEN GRID_ID = SET6(ROW, COL) ENDIF C -------------------------------------------------------- C Store to either 1Meter, 10Meter or 100Meter accuracy C -------------------------------------------------------- IF (PCODE .EQ. 1) THEN RN = NORTH_1M ELSEIF (PCODE .EQ. 2) THEN RN = NORTH_1M / 10 ELSE RN = NORTH_1M / 100 ENDIF NORTH_1M = DNINT(RN) IF (PCODE .EQ. 1) THEN RE = EAST_1M ELSEIF (PCODE .EQ. 2) THEN RE = EAST_1M / 10 ELSE RE = EAST_1M / 100 ENDIF EAST_1M = DNINT(RE) RETURN END SUBROUTINE USNG2UTM(NORTH, EAST, IZ, DATUM, * USNG_VALUE) REAL*8 FALSE_NORTH REAL*8 FALSE_SOUTH PARAMETER (FALSE_NORTH = 2000000) PARAMETER (FALSE_SOUTH = 6000000) REAL*8 NORTH, EAST INTEGER IZ CHARACTER*2 DATUM CHARACTER*25 USNG_VALUE CHARACTER*2 SET1(20,8) CHARACTER*2 SET2(20,8) CHARACTER*2 SET3(20,8) CHARACTER*2 SET4(20,8) CHARACTER*2 SET5(20,8) CHARACTER*2 SET6(20,8) CHARACTER*2 GRID_ID INTEGER NORTH_1M, EAST_1M CHARACTER*10 CEAST_NORTH CHARACTER*5 CEAST_1M CHARACTER*5 CNORTH_1M INTEGER COUNT INTEGER IS_NUMBER INTEGER LOC INTEGER SET_NO INTEGER OFFSET CHARACTER*1 GZD INTEGER PCODE LOGICAL IS_SOUTH COMMON/SETS/SET1,SET2,SET3,SET4,SET5,SET6 COMMON/PRECISE/PCODE IF (INDEX('0123456789', USNG_VALUE(2:2)) .GT. 0) THEN READ(USNG_VALUE, 100) IZ,GZD, GRID_ID 100 FORMAT(I2, A1, A2) ELSE READ(USNG_VALUE, 110) IZ,GZD, GRID_ID 110 FORMAT(I1, A1, A2) ENDIF IF (INDEX("CDEFGHJKLM", GZD) .GT. 0) THEN IS_SOUTH = .TRUE. ELSE IS_SOUTH = .FALSE. ENDIF COUNT=1 LOC=5 IS_NUMBER=1 DO WHILE(IS_NUMBER .EQ. 1) IF ((USNG_VALUE(LOC:LOC) .EQ. '') .OR. * (USNG_VALUE(LOC:LOC) .EQ. ' ') .OR. * (USNG_VALUE(LOC:LOC) .EQ. '(')) THEN IS_NUMBER=0 ELSE IF (INDEX('0123456789', USNG_VALUE(LOC:LOC)) .GT. 0) THEN CEAST_NORTH(COUNT:COUNT) = USNG_VALUE(LOC:LOC) COUNT = COUNT + 1 LOC = LOC + 1 ELSE LOC = LOC + 1 ENDIF END DO COUNT = COUNT - 1 IF (COUNT .EQ. 10) THEN CEAST_1M(1:5) = CEAST_NORTH(1:5) CNORTH_1M(1:5) = CEAST_NORTH(6:10) READ(CEAST_1M, 200) EAST_1M READ(CNORTH_1M, 200) NORTH_1M 200 FORMAT(I5.5) PCODE = 1 ELSEIF (COUNT .EQ. 8) THEN CEAST_1M(1:4) = CEAST_NORTH(1:4) CEAST_1M(5:5) = '0' CNORTH_1M(1:4) = CEAST_NORTH(5:8) CNORTH_1M(5:5) = '0' READ(CEAST_1M, 201) EAST_1M READ(CNORTH_1M, 201) NORTH_1M 201 FORMAT(I5.5) PCODE = 2 ELSEIF (COUNT .EQ. 6) THEN CEAST_1M(1:3) = CEAST_NORTH(1:3) CEAST_1M(4:5) = '00' CNORTH_1M(1:3) = CEAST_NORTH(4:6) CNORTH_1M(4:5) = '00' READ(CEAST_1M, 202) EAST_1M READ(CNORTH_1M, 202) NORTH_1M 202 FORMAT(I5.5) PCODE = 3 ELSEIF (COUNT .EQ. 4) THEN C Do not allow 10000 meter USNG yet STOP CEAST_1M(1:2) = CEAST_NORTH(1:2) CEAST_1M(3:5) = '000' CNORTH_1M(1:2) = CEAST_NORTH(3:4) CNORTH_1M(3:5) = '000' READ(CEAST_1M, 204) EAST_1M READ(CNORTH_1M, 204) NORTH_1M 204 FORMAT(I5.5) PCODE = 4 ELSE WRITE(6, 300) CEAST_NORTH 300 FORMAT('ERROR - Cannot convert coordinate ', A10,/, * ' Number of digits must be 10, 8, or 6', /, * ' EXAMPLE:', /, *' 18SUJ2348306479 ( 1-meter accuracy)',/, *' 18SUJ23430647 ( 10-meter accuracy)',/, *' 18SUJ234064 (100-meter accuracy)',/) STOP ENDIF CALL PUT_100_LEVEL(IZ, NORTH, EAST, *GRID_ID, NORTH_1M, EAST_1M) SET_NO = 0 CALL FIND_SET(IZ, SET_NO) OFFSET = 0 IF (IS_SOUTH .EQV. .TRUE.) THEN CALL FIND_OFFSET_SOUTH(GZD, SET_NO, GRID_ID, OFFSET) NORTH = NORTH + FALSE_SOUTH - OFFSET C NORTH = 20000000.D0 - NORTH ELSE CALL FIND_OFFSET_NORTH(GZD, SET_NO, GRID_ID, OFFSET) NORTH = NORTH + FALSE_NORTH + OFFSET ENDIF IF ((NORTH .EQ. 10000000.D0) .AND. (GZD .EQ. 'N')) THEN NORTH = 0.D0 ENDIF RETURN END C------------------------------------------------------------- SUBROUTINE PUT_100_LEVEL(IZ, NORTH, EAST, * GRID_ID, NORTH_1M, EAST_1M) INTEGER IZ REAL*8 NORTH, EAST CHARACTER*2 GRID_ID INTEGER NORTH_1M, EAST_1M INTEGER ROW, COL CHARACTER*2 SET1(20,8) CHARACTER*2 SET2(20,8) CHARACTER*2 SET3(20,8) CHARACTER*2 SET4(20,8) CHARACTER*2 SET5(20,8) CHARACTER*2 SET6(20,8) COMMON/SETS/SET1,SET2,SET3,SET4,SET5,SET6 ROW=0 COL=0 IF ((IZ .EQ. 1) .OR. (IZ .EQ. 7) .OR. (IZ .EQ. 13) .OR. * (IZ .EQ. 19) .OR. (IZ .EQ. 25) .OR. (IZ .EQ. 31) .OR. * (IZ .EQ. 37) .OR. (IZ .EQ. 43) .OR. (IZ .EQ. 49) .OR. * (IZ .EQ. 55)) THEN DO I=1,20 DO J=1,8 IF (SET1(I, J) .EQ. GRID_ID) THEN ROW = I COL = J ENDIF END DO END DO ELSEIF ((IZ .EQ. 2) .OR. (IZ .EQ. 8) .OR. (IZ .EQ. 14) .OR. * (IZ .EQ. 20) .OR. (IZ .EQ. 26) .OR. (IZ .EQ. 32) .OR. * (IZ .EQ. 38) .OR. (IZ .EQ. 44) .OR. (IZ .EQ. 50) .OR. * (IZ .EQ. 56)) THEN DO I=1,20 DO J=1,8 IF (SET2(I, J) .EQ. GRID_ID) THEN ROW = I COL = J ENDIF END DO END DO ELSEIF ((IZ .EQ. 3) .OR. (IZ .EQ. 9) .OR. (IZ .EQ. 15) .OR. * (IZ .EQ. 21) .OR. (IZ .EQ. 27) .OR. (IZ .EQ. 33) .OR. * (IZ .EQ. 39) .OR. (IZ .EQ. 45) .OR. (IZ .EQ. 51) .OR. * (IZ .EQ. 57)) THEN DO I=1,20 DO J=1,8 IF (SET3(I, J) .EQ. GRID_ID) THEN ROW = I COL = J ENDIF END DO END DO ELSEIF ((IZ .EQ. 4) .OR. (IZ .EQ. 10) .OR. (IZ .EQ. 16) .OR. * (IZ .EQ. 22) .OR. (IZ .EQ. 28) .OR. (IZ .EQ. 34) .OR. * (IZ .EQ. 40) .OR. (IZ .EQ. 46) .OR. (IZ .EQ. 52) .OR. * (IZ .EQ. 58)) THEN DO I=1,20 DO J=1,8 IF (SET4(I, J) .EQ. GRID_ID) THEN ROW = I COL = J ENDIF END DO END DO ELSEIF ((IZ .EQ. 5) .OR. (IZ .EQ. 11) .OR. (IZ .EQ. 17) .OR. * (IZ .EQ. 23) .OR. (IZ .EQ. 29) .OR. (IZ .EQ. 35) .OR. * (IZ .EQ. 41) .OR. (IZ .EQ. 47) .OR. (IZ .EQ. 53) .OR. * (IZ .EQ. 59)) THEN DO I=1,20 DO J=1,8 IF (SET5(I, J) .EQ. GRID_ID) THEN ROW = I COL = J ENDIF END DO END DO ELSEIF ((IZ .EQ. 6) .OR. (IZ .EQ. 12) .OR. (IZ .EQ. 18) .OR. * (IZ .EQ. 24) .OR. (IZ .EQ. 30) .OR. (IZ .EQ. 36) .OR. * (IZ .EQ. 42) .OR. (IZ .EQ. 48) .OR. (IZ .EQ. 54) .OR. * (IZ .EQ. 60)) THEN DO I=1,20 DO J=1,8 IF (SET6(I, J) .EQ. GRID_ID) THEN ROW = I COL = J ENDIF END DO END DO ENDIF NORTH = NORTH_1M + (100000 * (ROW - 1)) EAST = EAST_1M + (100000 * COL) RETURN END C ------------------------------------------------------------ SUBROUTINE FIND_GZD (NORS, DLAT, GZD) CHARACTER*1 NORS REAL*8 DLAT CHARACTER*1 GZD IF ((DLAT .EQ. 0.D0) .AND. (NORS .EQ. 'S')) THEN GZD = 'M' ELSE IF (DLAT .EQ. 0.D0) THEN GZD = 'N' ELSEIF (DLAT .LT. -80.0) THEN WRITE(6, 10) 10 FORMAT ('ERROR - USNG will not compute south of 80 degrees',/) STOP ELSE IF (DLAT .LE. -72.0) THEN GZD = 'C' ELSEIF (DLAT .LE. -64.0) THEN GZD = 'D' ELSEIF (DLAT .LE. -56.0) THEN GZD = 'E' ELSEIF (DLAT .LE. -48.0) THEN GZD = 'F' ELSEIF (DLAT .LE. -40.0) THEN GZD = 'G' ELSEIF (DLAT .LE. -32.0) THEN GZD = 'H' ELSEIF (DLAT .LE. -24.0) THEN GZD = 'J' ELSEIF (DLAT .LE. -16.0) THEN GZD = 'K' ELSEIF (DLAT .LE. -8.0) THEN GZD = 'L' ELSEIF (DLAT .LE. -0.0) THEN GZD = 'M' ELSEIF (DLAT .GT. 84.0) THEN WRITE(6, 20) 20 FORMAT ('ERROR - USNG will not compute north of 84 degrees',/) STOP ELSEIF (DLAT .GE. 72.0) THEN GZD = 'X' ELSEIF (DLAT .GE. 64.0) THEN GZD = 'W' ELSEIF (DLAT .GE. 56.0) THEN GZD = 'V' ELSEIF (DLAT .GE. 48.0) THEN GZD = 'U' ELSEIF (DLAT .GE. 40.0) THEN GZD = 'T' ELSEIF (DLAT .GE. 32.0) THEN GZD = 'S' ELSEIF (DLAT .GE. 24.0) THEN GZD = 'R' ELSEIF (DLAT .GE. 16.0) THEN GZD = 'Q' ELSEIF (DLAT .GE. 8.0) THEN GZD = 'P' ELSEIF (DLAT .GE. 0.0) THEN GZD = 'N' ENDIF RETURN END C------------------------------------------------------------ SUBROUTINE FIND_SET (IZ, SET) INTEGER IZ INTEGER SET IF ((IZ .EQ. 1) .OR. (IZ .EQ. 7) .OR. (IZ .EQ. 13) .OR. * (IZ .EQ. 19) .OR. (IZ .EQ. 25) .OR. (IZ .EQ. 31) .OR. * (IZ .EQ. 37) .OR. (IZ .EQ. 43) .OR. (IZ .EQ. 49) .OR. * (IZ .EQ. 55)) THEN SET = 1 ELSEIF ((IZ .EQ. 2) .OR. (IZ .EQ. 8) .OR. (IZ .EQ. 14) .OR. * (IZ .EQ. 20) .OR. (IZ .EQ. 26) .OR. (IZ .EQ. 32) .OR. * (IZ .EQ. 38) .OR. (IZ .EQ. 44) .OR. (IZ .EQ. 50) .OR. * (IZ .EQ. 56)) THEN SET = 2 ELSEIF ((IZ .EQ. 3) .OR. (IZ .EQ. 9) .OR. (IZ .EQ. 15) .OR. * (IZ .EQ. 21) .OR. (IZ .EQ. 27) .OR. (IZ .EQ. 33) .OR. * (IZ .EQ. 39) .OR. (IZ .EQ. 45) .OR. (IZ .EQ. 51) .OR. * (IZ .EQ. 57)) THEN SET = 3 ELSEIF ((IZ .EQ. 4) .OR. (IZ .EQ. 10) .OR. (IZ .EQ. 16) .OR. * (IZ .EQ. 22) .OR. (IZ .EQ. 28) .OR. (IZ .EQ. 34) .OR. * (IZ .EQ. 40) .OR. (IZ .EQ. 46) .OR. (IZ .EQ. 52) .OR. * (IZ .EQ. 58)) THEN SET = 4 ELSEIF ((IZ .EQ. 5) .OR. (IZ .EQ. 11) .OR. (IZ .EQ. 17) .OR. * (IZ .EQ. 23) .OR. (IZ .EQ. 29) .OR. (IZ .EQ. 35) .OR. * (IZ .EQ. 41) .OR. (IZ .EQ. 47) .OR. (IZ .EQ. 53) .OR. * (IZ .EQ. 59)) THEN SET = 5 ELSEIF ((IZ .EQ. 6) .OR. (IZ .EQ. 12) .OR. (IZ .EQ. 18) .OR. * (IZ .EQ. 24) .OR. (IZ .EQ. 30) .OR. (IZ .EQ. 36) .OR. * (IZ .EQ. 42) .OR. (IZ .EQ. 48) .OR. (IZ .EQ. 54) .OR. * (IZ .EQ. 60)) THEN SET = 6 ENDIF RETURN END C------------------------------------------------------------ SUBROUTINE FIND_OFFSET_NORTH(GZD, SET_NO, GRID_ID, OFFSET) CHARACTER*1 GZD CHARACTER*2 GRID_ID INTEGER SET_NO INTEGER OFFSET OFFSET = 0 C WRITE (6, 9) GRID_ID C 9 FORMAT ('*** grid_id = ', A2, /) IF (GZD .EQ. 'N') THEN OFFSET = -2000000 ELSEIF (GZD .EQ. 'P') THEN OFFSET = -2000000 ELSEIF (GZD .EQ. 'Q') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSE OFFSET = -2000000 ENDIF ELSEIF (GZD .EQ. 'R') THEN OFFSET = 0 ELSEIF (GZD .EQ. 'S') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 2000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 2000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 2000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 2000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 2000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 2000000 ELSE OFFSET = 0 ENDIF ELSE IF (GZD .EQ. 'T') THEN OFFSET = 2000000. ELSEIF (GZD .EQ. 'U') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('ABC', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('FGH', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('ABC', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('FGH', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('ABC', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('FGH', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSE OFFSET = 2000000 ENDIF ELSEIF (GZD .EQ. 'V') THEN OFFSET = 4000000 ELSEIF (GZD .EQ. 'W') THEN OFFSET = 4000000 ELSEIF (GZD .EQ. 'X') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('V', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('E', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('V', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('E', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('V', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('E', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 1) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 6000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 6000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 6000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 6000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 6000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 6000000 ELSE OFFSET = 6000000 ENDIF ENDIF RETURN END C------------------------------------------------------------ SUBROUTINE FIND_OFFSET_SOUTH(GZD, SET_NO, GRID_ID, OFFSET) CHARACTER*1 GZD CHARACTER*2 GRID_ID INTEGER SET_NO INTEGER OFFSET OFFSET = 0 C WRITE (6, 9) GRID_ID C 9 FORMAT ('*** grid_id = ', A2, /) IF (GZD .EQ. 'M') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('A', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -4000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('F', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -4000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('A', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -4000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('F', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -4000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('A', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -4000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('F', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -4000000 ELSE OFFSET = -2000000 ENDIF ELSEIF (GZD .EQ. 'L') THEN OFFSET = -2000000 ELSEIF (GZD .EQ. 'K') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -2000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -2000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -2000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -2000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -2000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = -2000000 ELSE OFFSET = 0 ENDIF ELSEIF (GZD .EQ. 'J') THEN OFFSET = 0 ELSEIF (GZD .EQ. 'H') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('ABCDEFGHJK', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('FGHJKLMNPQ', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 0 ELSE OFFSET = 2000000 ENDIF ELSE IF (GZD .EQ. 'G') THEN OFFSET = 2000000. ELSEIF (GZD .EQ. 'F') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('TUV', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('CDE', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('TUV', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('CDE', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('TUV', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('CDE', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSE OFFSET = 2000000 ENDIF ELSEIF (GZD .EQ. 'E') THEN OFFSET = 4000000 ELSEIF (GZD .EQ. 'D') THEN OFFSET = 4000000 ELSEIF (GZD .EQ. 'C') THEN IF ((SET_NO .EQ. 1) .AND. * (INDEX('A', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 2) .AND. * (INDEX('F', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 3) .AND. * (INDEX('A', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 4) .AND. * (INDEX('F', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 5) .AND. * (INDEX('A', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSEIF ((SET_NO .EQ. 6) .AND. * (INDEX('F', GRID_ID(2:2)) .GT. 0)) THEN OFFSET = 4000000 ELSE OFFSET = 6000000 ENDIF ENDIF RETURN END