diff options
author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
---|---|---|
committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
tree | 4464880c571602d54f6ae114729bf62a89518057 /sys/gio/ncarutil/tests/conraqt.f | |
download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'sys/gio/ncarutil/tests/conraqt.f')
-rw-r--r-- | sys/gio/ncarutil/tests/conraqt.f | 139 |
1 files changed, 139 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/tests/conraqt.f b/sys/gio/ncarutil/tests/conraqt.f new file mode 100644 index 00000000..dbf211aa --- /dev/null +++ b/sys/gio/ncarutil/tests/conraqt.f @@ -0,0 +1,139 @@ + SUBROUTINE TCONAQ (IERROR) +C +C LATEST REVISION JULY 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONRAQ, THE QUICK ENTRY POINT OF THE +C CONRAN PACKAGE. +C +C USAGE CALL TCONAQ (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C .EQ. 0, IF THE TEST WAS SUCCESSFUL, +C .NE. 0, OTHERWISE. +C IF NOT ZERO THE NUMBER PRODUCED WILL +C CORRESPOND TO THE ERROR NUMBERS IN +C THE CONRAQ LISTING. +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONRAQ TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT AND TRIANGULATION OF THE DATA ARE PRODUCED +C ON THE DEFAULT GRAPHICS DEVICE UNLESS THE USER +C SPECIFIES OTHERWISE VIA JCL. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY CONRAQ +C FILES CONTERP +C +C LANGUAGE FORTRAN77 +C +C ALGORITHM A SPARSE DATA SET IS DEFINED VIA DATA +C STATEMENTS. OPTIONS ARE SET TO PRODUCE A +C TITLE AND DISPLAY THE TRIANGULATION GENERATED +C BY THE INTERPOLATING ROUTINES. BY DEFAULT +C A MESSAGE AT THE BOTTEM OF THE PLOT AND A +C PERIMETER ARE ALSO PRODUCED. THIS ROUTINE +C TAKES ADVANTAGE OF THE PORT ERROR HANDLING +C ROUTINES TO DETERMINE IF CONRAQ TERMINATED +C NORMALLY. +C + COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX +C +C SET UP THE SCRATCH SPACES REQUIRED BY CONRAQ +C + DIMENSION WK(221),IWK(744) +C +C SET UP THE ARRAYS TO DEFINE THE DATA SET +C + DIMENSION XD(17),YD(17),ZD(17) +C +C DEFINE THE DATA SET +C + DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8), + 1 XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15), + 2 XD(16),XD(17) + 3 /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20., + 4 5.,15.,10.,7.,13.,16./ +C + DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8), + 1 YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15), + 2 YD(16),YD(17) + 3 /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10., + 4 15.,15.,15.,20.,20.,8./ +C + DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8), + 1 ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15), + 2 ZD(16),ZD(17) + 3 /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1., + 4 1.,1.,1.,1.,1.,25./ +C +C SET UP PARAMETER FOR NUMBER OF INPUT POINTS +C + DATA NDP/17/ +C +C SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE +C + CALL ENTSR(IROLD,1) +C +C SET UP TITLE FOR PLOT +C + CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAQ',29) +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C SET OPTION TO DISPLAY THE TRIANGULATION +C + CALL CONOP1('TRI=ON') +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C CALL CONRAQ TO CONTOUR DATA +C + CALL CONRAQ(XD,YD,ZD,NDP,WK,IWK) +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C +C CALL FRAME, CONRAQ WILL NOT DO THIS +C +cCALL NEWFM +C +C PRINT MESSAGE EVERYTHING OK +C +c WRITE(6,10) +c10 FORMAT(1X,'CONRAQ TEST SUCCESSFUL, SEE PLOT TO VERIFY', +c 1' PERFORMANCE') +C +C + RETURN +C +C IF ERROR CALL THE PORT ERROR PRINT ROUTINE. +C THIS CALL IS NOT NECESSARY UNLESS YOU ARE IN RECOVER MODE. +C IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL BE PRINTED +C AUTOMATICALLY. +C + 100 CALL EPRIN + RETURN +C + END |