SUBROUTINE TSUPMA (IERROR) C C LATEST REVISION AUGUST 1984 C C C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF THE C SUPMAP AND MAPDRW ENTRYS OF EZMAPG. C C USAGE CALL TSUPMA (IERROR) C C ARGUMENTS C C ON OUTPUT IERROR C AN INTEGER VARIABLE C = 0 IF THE TEST WAS SUCCESSFUL C = 1 OTHERWISE C C I/O IF EACH CALL TO ROUTINE SUPMAP RESULTS IN C A NORMAL SUPMAP EXIT, THE MESSAGE C SUPMAP TEST SUCCESSFUL . . SEE PLOT TO C VERIFY PERFORMANCE C IS PRINTED ON UNIT 6. C C TEN CONTINENTAL OUTLINE PLOTS, EACH C RESULTING FROM A DIFFERENT SPECIFIED C PROJECTION, ARE PRODUCED ON THE MACHINE C GRAPHICS DEVICE. C TO DETERMINE IF THE TEST WAS SUCCESSFUL, C IT IS NECESSARY TO EXAMINE THESE PLOTS. C C PRECISION SINGLE C C REQUIRED LIBRARY EZMAPG C FILES C C LANGUAGE FORTRAN C C ALGORITHM SUBROUTINE TSUPMA CALLS ROUTINE SUPMAP ONCE C FOR EACH OF THE NINE PROJECTION TYPES C IN SUPMAP. SPECIFICALLY, THESE ARE C STEREOGRAPHIC C ORTHOGRAPHIC C LAMBERT CONFORMAL CONIC WITH TWO C STANDARD PARALLELS C LAMBERT EQUAL AREA C GNOMONIC C AZIMUTHAL EQUIDISTANT C CYLINDRICAL EQUIDISTANT C MERCATOR C MOLLWEIDE TYPE C THE ROUTINE THEN DEMONSTRATES THE SATELLITE VIEW C PROJECTION. C C HISTORY WRITTEN OCTOBER, 1976 C C PORTABILITY ANSI FORTRAN 77 C C C COMMON BLOCK FOR SATELLITE VIEW PROJECTION C COMMON /SATMAP/ SL C C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT PLOTTER GRID C WHERE THE COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX C AND TY DEFINE THE CENTER OF THE TITLE STRING. C DATA TX/0.5/, TY/0.9765/ C C INITIALIZE ERROR FLAG C IERROR = 0 C C CHECK PERFORMANCE CRITERION C SPECIFY PARAMETERS BEFORE EACH SUPMAP CALL C IPROJ = 1 POLAT = 80. POLONG = -160. ROT = 0. PL1 = 0. PL2 = 0. PL3 = 0. PL4 = 0. JLTS = 1 JGRID = 10 IUSOUT = -1 IDOT = 0 C C SELECT NORMALIZATION TRANS 0 TO WRITE TITLE C CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: STEREOGRAPHIC PROJECTION', 2 2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c CALL NEWFM IF (IER .EQ. 0) GO TO 10 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 10 CONTINUE C C IPROJ = 2 POLAT = 60. POLONG = -120. CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: ORTHOGRAPHIC PROJECTION', 2 2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance handled by calling routine c CALL NEWFM c -noao IF (IER .EQ. 0) GO TO 20 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 20 CONTINUE C C IPROJ = -3 POLAT = 45. POLONG = -100. ROT = 45. PL1 = 50. PL2 = -130. PL3 = 20. PL4 = -75. JLTS = 2 JGRID = 10 IUSOUT = 1 IDOT = 0 CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: LAMBERT CONFORMAL CONIC PROJECTION' 2 ,2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance is handled by calling routine c CALL NEWFM c -noao IF (IER .EQ. 0) GO TO 30 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 30 CONTINUE C C IPROJ = 4 POLAT = 20. POLONG = -40. ROT = 0. PL1 = 0. PL2 = 0. PL3 = 0. PL4 = 0. JLTS = 1 JGRID = 10 IUSOUT = -1 IDOT = 0 CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: LAMBERT EQUAL AREA PROJECTION', 2 2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance is handled by calling routine c CALL NEWFM c -nooa IF (IER .EQ. 0) GO TO 40 C C SUPMAP TEST UNSUCCESSFUL C C WRITE (6,1001) IPROJ IERROR = 1 40 CONTINUE C C IPROJ = 5 POLAT = 0. POLONG = 0. CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: GNOMONIC PROJECTION', 2 2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance handled by calling routine c CALL NEWFM c -noao IF (IER .EQ. 0) GO TO 50 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 50 CONTINUE C C IPROJ = 6 POLAT = -20. POLONG = 40. JGRID = 5 CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: AZIMUTHAL EQUIDISTANT PROJECTION', 2 2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance handled by calling routine c CALL NEWFM c -noao IF (IER .EQ. 0) GO TO 60 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 60 CONTINUE C C IPROJ = 8 POLAT = -40. POLONG = 80. CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: CYLINDRICAL EQUIDISTANT PROJECTION' 2 ,2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance handled by calling routine c CALL NEWFM c -noao IF (IER .EQ. 0) GO TO 70 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 70 CONTINUE C C IPROJ = 9 POLAT = -60. POLONG = 120. CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: MERCATOR PROJECTION', 2 2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance handled by calling routine c CALL NEWFM c -noao IF (IER .EQ. 0) GO TO 80 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 80 CONTINUE C C IPROJ = 10 POLAT = -80. POLONG = 160. CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'SUPMAP DEMONSTRATION: MOLLWEIDE TYPE PROJECTION', 2 2,0,0) CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, 1 IUSOUT,IDOT,IER) c +noao: frame advance handled by calling routine c CALL NEWFM c -noao IF (IER .EQ. 0) GO TO 90 C C SUPMAP TEST UNSUCCESSFUL C c WRITE (6,1001) IPROJ IERROR = 1 90 CONTINUE C C DEMONSTRATION OF SATELLITE VIEW PROJECTION C SL = 6.5 CALL GSELNT (0) CALL WTSTR(TX,TY, 1 'EZMAPG DEMONSTRATION: SATELLITE VIEW PROJECTION', 2 2,0,0) CALL MAPROJ('OR',0.0,-135.0,0.0) CALL MAPSET('MA',0.0,0.0,0.0,0.0) CALL MAPDRW c +noao: frame advance handled by calling routine c CALL NEWFM c -noao C C c IF (IERROR .EQ. 0) WRITE (6,1002) c IF (IERROR .EQ. 1) WRITE (6,1003) RETURN C C c1001 FORMAT (' SUPMAP RETURNED ERROR FLAG',' IPROJ=',I4/) c1002 FORMAT(' SUPMAP TEST SUCCESSFUL',24X, c 1 'SEE PLOT TO VERIFY PERFORMANCE') c1003 FORMAT (' SUPMAP TEST UNSUCCESSFUL') C END