aboutsummaryrefslogtreecommitdiff
path: root/sys/gio/ncarutil/tests/ezmapt.f
diff options
context:
space:
mode:
Diffstat (limited to 'sys/gio/ncarutil/tests/ezmapt.f')
-rw-r--r--sys/gio/ncarutil/tests/ezmapt.f300
1 files changed, 300 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/tests/ezmapt.f b/sys/gio/ncarutil/tests/ezmapt.f
new file mode 100644
index 00000000..330fe6e2
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezmapt.f
@@ -0,0 +1,300 @@
+ 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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 10
+C
+C SUPMAP TEST UNSUCCESSFUL
+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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 20
+C
+C SUPMAP TEST UNSUCCESSFUL
+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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 30
+C
+C SUPMAP TEST UNSUCCESSFUL
+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 = 0
+ 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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 40
+C
+C SUPMAP TEST UNSUCCESSFUL
+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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 50
+C
+C SUPMAP TEST UNSUCCESSFUL
+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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 60
+C
+C SUPMAP TEST UNSUCCESSFUL
+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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 70
+C
+C SUPMAP TEST UNSUCCESSFUL
+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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 80
+C
+C SUPMAP TEST UNSUCCESSFUL
+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)
+ CALL FRAME
+ IF (IER .EQ. 0) GO TO 90
+C
+C SUPMAP TEST UNSUCCESSFUL
+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
+ CALL FRAME
+C
+C
+ IF (IERROR .EQ. 0) WRITE (6,1002)
+ IF (IERROR .EQ. 1) WRITE (6,1003)
+ RETURN
+C
+C
+ 1001 FORMAT (' SUPMAP RETURNED ERROR FLAG',' IPROJ=',I4/)
+ 1002 FORMAT(' SUPMAP TEST SUCCESSFUL',24X,
+ 1 'SEE PLOT TO VERIFY PERFORMANCE')
+ 1003 FORMAT (' SUPMAP TEST UNSUCCESSFUL')
+C
+ END
generated by cgit (git 2.34.1) at 2025-09-20 05:09:53 -0400