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/ezmap.f | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'sys/gio/ncarutil/ezmap.f')
| -rw-r--r-- | sys/gio/ncarutil/ezmap.f | 4598 |
1 files changed, 4598 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/ezmap.f b/sys/gio/ncarutil/ezmap.f new file mode 100644 index 00000000..8d87a4d7 --- /dev/null +++ b/sys/gio/ncarutil/ezmap.f @@ -0,0 +1,4598 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C*********************************************************************** +C P A C K A G E E Z M A P - I N T R O D U C T I O N +C*********************************************************************** +C +C THIS FILE CONTAINS IMPLEMENTATION INSTRUCTIONS, A WRITE-UP, AND THE +C CODE FOR THE PACKAGE EZMAP. BANNERS LIKE THE ONE ABOVE DELIMIT THE +C MAJOR SECTIONS OF THE FILE. THE CODE ITSELF IS SEPARATED INTO THREE +C SECTIONS: USER-LEVEL ROUTINES, INTERNAL ROUTINES, AND THE BLOCK DATA +C ROUTINE WHICH DETERMINES THE DEFAULT VALUES OF INTERNAL PARAMETERS. +C WITHIN EACH SECTION, ROUTINES APPEAR IN ALPHABETICAL ORDER. +C +C*********************************************************************** +C P A C K A G E E Z M A P - I M P L E M E N T A T I O N +C*********************************************************************** +C +C THE EZMAP PACKAGE IS WRITTEN IN FORTRAN-77 AND SHOULD BE RELATIVELY +C EASY TO IMPLEMENT. THE OUTLINE DATA REQUIRED MAY BE GENERATED BY +C RUNNING THE PROGRAM +C +C PROGRAM CONVRT +C DIMENSION FLIM(4),PNTS(200) +C 1 READ (1,3,END=2) NPTS,IGID,(FLIM(I),I=1,4) +C IF (NPTS.GT.1) READ (1,4,END=2) (PNTS(I),I=1,NPTS) +C WRITE (2) NPTS,IGID,(FLIM(I),I=1,4),(PNTS(I),I=1,NPTS) +C GO TO 1 +C 2 STOP +C 3 FORMAT (2I8,4F8.3) +C 4 FORMAT (10F8.3) +C END +C +C WITH THE FILE EZMAPDAT ASSIGNED TO UNIT 1. THE OUTPUT FILE, ON UNIT +C 2, CONTAINS THE BINARY OUTLINE DATA TO BE USED BY EZMAP. THE EZMAP +C ROUTINE MAPIO (WHICH SEE) MUST THEN BE MODIFIED TO ACCESS THIS FILE. +C +C THE ROUTINE MAPCHI CONTAINS THE STATEMENTS +C +C CALL GETUSV ('IN',INTO) +C CALL SETUSV ('IN',IFIX(10000.*FLOAT(INTS(IPRT))/255.)) +C +C (TO BE EXECUTED FOR A POSITIVE VALUE OF IPRT) AND THE STATEMENT +C +C CALL SETUSV ('IN',INTO) +C +C (TO BE EXECUTED FOR A NEGATIVE VALUE OF IPRT). THESE STATEMENTS +C SET/RESET THE INTENSITY FOR VARIOUS PORTIONS OF THE MAP. IF COLOR +C IS AVAILABLE ON THE DEVICE(S) BEING DRIVEN, THESE STATEMENTS SHOULD +C BE OMITTED AND THE IMPLEMENTOR SHOULD PROVIDE A DEFAULT VERSION OF +C MAPUSR WHICH SETS/RESETS THE INTENSITY AND COLOR AS DESIRED. THIS +C DEFAULT VERSION OF MAPUSR SHOULD DECLARE THE LABELLED COMMON BLOCK +C MAPNTS AND MAKE USE OF THE CURRENT VALUES IN THE ARRAY INTS TO SET +C THE INTENSITY; IT SHOULD ALSO BE PUBLISHED TO AID USERS IN SETTING +C UP THEIR OWN VERSIONS. +C +C +C*********************************************************************** +C P A C K A G E E Z M A P - U S E R ' S G U I D E +C*********************************************************************** +C +C LATEST REVISION AUGUST, 1985 +C +C PURPOSE TO PLOT MAPS OF THE EARTH ACCORDING TO ANY +C ONE OF TEN DIFFERENT PROJECTIONS, SHOWING +C CONTINENTAL, INTERNATIONAL, AND/OR U.S. STATE +C OUTLINES, PARALLELS, AND MERIDIANS. THE +C ORIGIN AND ORIENTATION OF THE PROJECTION ARE +C SELECTED BY THE USER. POINTS ON THE EARTH +C DEFINED BY LATITUDE AND LONGITUDE ARE MAPPED +C TO POINTS IN THE PLANE OF PROJECTION - THE +C U/V PLANE. THE U AND V AXES ARE PARALLEL TO +C THE X AND Y AXES OF THE PLOTTER, RESPECTIVELY. +C A RECTANGULAR FRAME WHOSE SIDES ARE PARALLEL +C TO THE U AND V AXES IS CHOSEN AND MATERIAL +C WITHIN THAT FRAME (OR AN INSCRIBED ELLIPTICAL +C FRAME) IS PLOTTED. +C +C USAGE THE ROUTINE MAPDRW DRAWS A COMPLETE MAP, AS +C DIRECTED BY THE CURRENT VALUES OF PARAMETERS +C IN THE EZMAP PACKAGE. TO CHANGE THE VALUES +C OF THOSE PARAMETERS, AND THUS THE APPEARANCE +C OF THE MAP, ONE MAY FIRST CALL ONE OF THE +C ROUTINES MAPROJ (TO CHANGE THE PROJECTION TO +C BE USED), MAPSET (TO CHANGE WHAT PORTION OF +C THE U/V PLANE IS TO BE VIEWED), MAPPOS (TO +C CHANGE WHAT PORTION OF THE PLOTTER FRAME IS +C TO BE USED), OR ONE OF THE PARAMETER-SETTING +C ROUTINES MAPSTC, MAPSTI, MAPSTL, AND MAPSTR +C (TO CHANGE VARIOUS OTHER PARAMETERS, OF TYPES +C CHARACTER, INTEGER, LOGICAL, AND REAL). THE +C PARAMETER-RETRIEVAL ROUTINES MAPGTC, MAPGTI, +C MAPGTL, AND MAPGTR ALLOW THE USER TO RETRIEVE +C THE VALUES OF EZMAP PARAMETERS. +C +C THE ROUTINE MAPSAV ALLOWS ONE TO SAVE THE +C CURRENT STATE OF EZMAP, THE ROUTINE MAPRST TO +C RESTORE A SAVED STATE. +C +C USERS WITH SPECIAL NEEDS MAY WISH TO CALL THE +C LOWER-LEVEL ROUTINES MAPINT (TO INITIALIZE +C THE PACKAGE - IT MUST BE CALLED INITIALLY AND +C AGAIN WHENEVER CERTAIN PARAMETERS ARE CHANGED), +C MAPGRD (TO DRAW PARALLELS AND MERIDIANS), +C MAPLBL (TO LABEL THE INTERNATIONAL DATE LINE, +C THE EQUATOR, THE GREENWICH MERIDIAN, AND THE +C POLES, AND TO DRAW THE PERIMETER), AND MAPLOT +C (TO DRAW THE SELECTED GEOGRAPHIC OUTLINES). +C THESE ROUTINES ARE NORMALLY CALLED BY MAPDRW. +C +C INTENSITIES OF VARIOUS MAP PORTIONS MAY BE SET +C BY CALLS TO THE ROUTINE MAPSTI. THE ROUTINE +C MAPUSR IS CALLED BY EZMAP JUST BEFORE/AFTER +C DRAWING VARIOUS PORTIONS OF THE MAP; THE +C DEFAULT VERSION, WHICH DOES NOTHING, MAY BE +C REPLACED BY A USER VERSION WHICH SETS/RESTORES +C COLOR, SPOT SIZE, INTENSITY, DASH PATTERN, ETC. +C +C THE ROUTINE MAPEOS IS CALLED BY EZMAP ONCE FOR +C EACH OUTLINE SEGMENT. THE USER MAY SUPPLY A +C VERSION WHICH EXAMINES THE SEGMENT TO SEE IF +C IT OUGHT TO BE PLOTTED AND, IF NOT, TO DELETE +C IT. THIS MAY BE USED, FOR EXAMPLE, TO REDUCE +C THE CLUTTER IN NORTHERN CANADA. +C +C TO OVERLAY OBJECTS OF ONE'S OWN ON THE MAP +C DRAWN BY MAPDRW, ONE MAY USE ONE OR MORE OF +C THE ROUTINES MAPTRN (TO COMPUTE THE U/V +C COORDINATES OF A POINT, GIVEN ITS LATITUDE +C AND LONGITUDE), MAPIT (TO DO "PEN-UP/DOWN" +C MOVES), MAPFST (TO DO "PEN-UP" MOVES), AND +C MAPVEC (TO DO "PEN-DOWN" MOVES). +C +C THE ROUTINE SUPMAP, FROM WHICH EZMAP GREW, IS +C IMPLEMENTED WITHIN IT AND ALLOWS ONE TO DRAW +C A COMPLETE MAP WITH A SINGLE, RATHER LENGTHY, +C CALL. THE ROUTINE SUPCON, WHICH IS THE OLD +C ANALOGUE OF MAPTRN, IS ALSO IMPLEMENTED. +C +C THE OLD ROUTINE EZMAP, WHICH WAS IMPLEMENTED +C IN SUCH A WAY AS TO CAUSE PORTABILITY PROBLEMS, +C HAS BEEN REMOVED. STATISTICS INDICATED THAT +C IT WAS NOT BEING USED, ANYWAY. +C +C SEE THE WRITE-UPS OF INDIVIDUAL ROUTINES BELOW. +C +C I/O GRAPHICAL OUTPUT IS GENERATED. OUTLINE DATA +C IS READ FROM A "TAPE UNIT". +C +C ERROR CONDITIONS WHEN AN ERROR OCCURS DURING A CALL TO AN EZMAP +C ROUTINE, AN ERROR MESSAGE IS LOGGED, USING THE +C NCAR VERSION OF THE PORT ERROR ROUTINE SETERR +C (CALLED SETER); BY DEFAULT, THE PROGRAM IS THEN +C ABORTED. ERROR RECOVERY IS POSSIBLE, HOWEVER. +C INSERT THE CALL +C +C CALL ENTSR (IOLD,1) +C +C AT THE BEGINNING OF YOUR PROGRAM. THIS MAKES +C ERROR RECOVERY POSSIBLE. THEN, FOLLOWING EACH +C CALL TO AN EZMAP ROUTINE WHICH COULD CAUSE AN +C ERROR, INSERT CODE LIKE THE FOLLOWING: +C +C IF (NERRO(IERR).NE.0) THEN +C CALL EPRIN +C CALL ERROF +C END IF +C +C THE VALUE OF THE FUNCTION NERRO IS NON-ZERO IF +C SETER HAS BEEN CALLED. THE CALL TO EPRIN DUMPS +C OUT THE ERROR MESSAGE (WHICH HAS NOT YET BEEN +C PRINTED) AND THE CALL TO ERROF TURNS OFF THE +C ERROR CONDITION IN SETER. THIS DOES NOT CLEAR +C EZMAP'S ERROR FLAG, HOWEVER; IT REMAINS SET +C UNTIL AFTER THE NEXT SUCCESSFUL CALL TO MAPINT, +C PREVENTING OTHER EZMAP ROUTINES FROM TRYING TO +C EXECUTE (AND POSSIBLY BOMBING AS A RESULT). +C POSSIBLE ERROR FLAGS ARE AS FOLLOWS: +C +C 1 MAPGTC - UNKNOWN PARAMETER NAME XX +C 2 MAPGTI - UNKNOWN PARAMETER NAME XX +C 3 MAPGTL - UNKNOWN PARAMETER NAME XX +C 4 MAPGTR - UNKNOWN PARAMETER NAME XX +C 5 MAPINT - ATTEMPT TO USE NON-EXISTENT +C PROJECTION +C 6 MAPINT - ANGULAR LIMITS TOO GREAT +C 7 MAPINT - MAP HAS ZERO AREA +C 8 MAPINT - MAP LIMITS INAPPROPIATE +C 9 MAPROJ - UNKNOWN PROJECTION NAME XX +C 10 MAPSET - UNKNOWN MAP AREA SPECIFIER XX +C 11 MAPSTC - UNKNOWN OUTLINE NAME XX +C 12 MAPSTC - UNKNOWN PARAMETER NAME XX +C 13 MAPSTI - UNKNOWN PARAMETER NAME XX +C 14 MAPSTL - UNKNOWN PARAMETER NAME XX +C 15 MAPSTR - UNKNOWN PARAMETER NAME XX +C 16 MAPTRN - ATTEMPT TO USE NON-EXISTENT +C PROJECTION +C 17 MAPIO - OUTLINE DATASET IS UNREADABLE +C 18 MAPIO - EOF ENCOUNTERED IN OUTLINE +C DATASET +C 19 MAPPOS - ARGUMENTS ARE INCORRECT +C 20 MAPRST - ERROR ON READ +C 21 MAPRST - EOF ON READ +C 22 MAPSAV - ERROR ON WRITE +C +C PRECISION SINGLE. +C +C LANGUAGE FORTRAN. +C +C HISTORY IN ABOUT 1963, R. L. PARKER OF UCSD WROTE THE +C ORIGINAL CODE CALLED SUPERMAP, USING OUTLINE +C DATA GENERATED BY HERSHEY. THIS WAS ADAPTED +C FOR USE AT NCAR BY LEE, IN 1968. REVISIONS +C OCCURRED IN JANUARY OF 1969 AND MAY OF 1971. +C THE CODE WAS PUT IN STANDARD NSSL FORMAT IN +C OCTOBER OF 1973. FURTHER REVISIONS OCCURRED +C IN JULY, 1974, IN AUGUST, 1976, AND IN JULY, +C 1978. IN LATE 1984 AND EARLY 1985, THE CODE +C WAS HEAVILY REVISED TO ACHIEVE FORTRAN-77 AND +C GKS COMPATIBILITY, TO REMOVE ERRORS, AND TO +C EXPAND THE OUTLINE DATASETS. CICELY RIDLEY, +C JAY CHALMERS, AND DAVE KENNISON (THE CURRENT +C CURATOR) HAVE ALL HAD A HAND IN THE CREATION +C OF THIS PACKAGE. +C +C REFERENCES HERSHEY, A.V., "THE PLOTTING OF MAPS ON A +C CRT PRINTER." NWL REPORT NO. 1844, 1963. +C +C LEE, TSO-HWA, "STUDENTS' SUMMARY REPORTS, +C WORK-STUDY PROGRAM IN SCIENTIFIC COMPUTING". +C NCAR, 1968. +C +C PARKER, R.L., "2UCSD SUPERMAP: WORLD +C PLOTTING PACKAGE". +C +C STEERS, J.A., "AN INTRODUCTION TO THE STUDY +C OF MAP PROJECTIONS". UNIVERSITY OF LONDON +C PRESS, 1962. +C +C ACCURACY THE DEFINITION OF THE MAP PRODUCED IS LIMITED +C BY TWO FACTORS: THE RESOLUTION OF THE OUTLINE +C DATA AND THE RESOLUTION OF THE GRAPHICS +C DEVICE. +C +C DATA POINTS IN THE CONTINENTAL OUTLINES ARE +C ABOUT ONE DEGREE APART AND THE COORDINATES +C ARE ACCURATE TO .01 DEGREE. DATA POINTS IN +C U.S. STATE OUTLINES ARE ABOUT .05 DEGREES +C APART AND THE COORDINATES ARE ACCURATE TO +C .001 DEGREE. BOTH THE SPACING AND THE +C ACCURACY OT THE INTERNATIONAL BOUNDARIES +C FALLS SOMEWHERE BETWEEN THESE TWO EXTREMES. +C +C THE DICOMED HAS 15-BIT COORDINATE REGISTERS, +C BUT AN EFFECTIVE RESOLUTION OF AT MOST 1 IN +C 4096 IN BOTH X AND Y. +C +C TIMING THE MARCH, 1985, UPDATE HAS MADE EZMAP RUN +C SIGNIFICANTLY SLOWER. THIS IS MOSTLY BECAUSE +C THE DEFAULT RESOLUTION HAS BEEN INCREASED TO +C A VALUE SUITABLE FOR THE DICOMED, RATHER THAN +C THE DD80. USERS WHO ARE CONCERNED ABOUT THIS +C MAY INCREASE THE VALUES OF THE PARAMETERS 'MV' +C AND/OR 'DD' (SEE THE DESCRIPTION OF MAPSTX) +C TO DECREASE THE TIMING (AT THE EXPENSE OF PLOT +C QUALITY, OF COURSE). +C +C PORTABILITY THE CODE IS WRITTEN IN FORTRAN-77 AND SHOULD +C BE VERY PORTABLE. A BINARY DATASET CONTAINING +C OUTLINE DATA MUST BE GENERATED AND THE ROUTINE +C MAPIO MUST BE MODIFIED TO READ THAT DATASET. +C SEE THE IMPLEMENTATION INSTRUCTIONS AT THE +C BEGINNING OF THIS FILE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P D R W - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO DRAW THE COMPLETE MAP DESCRIBED BY THE +C CURRENT VALUES OF THE EZMAP PARAMETERS. +C +C MAPDRW CALLS MAPINT (IF REQUIRED), MAPGRD, +C MAPLBL, AND MAPLOT, IN THAT ORDER. THE USER +C MAY WISH TO CALL THESE ROUTINES DIRECTLY. +C +C USAGE CALL MAPDRW +C +C ARGUMENTS NONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P E O S - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE MAPEOS IS CALLED BY EZMAP TO EXAMINE EACH +C SEGMENT IN THE OUTLINE DATASETS. THE DEFAULT +C VERSION DOES NOTHING. A USER-SUPPLIED VERSION +C MAY CAUSE SELECTED SEGMENTS TO BE DELETED (TO +C REDUCE THE CLUTTER IN NORTHERN CANADA, FOR +C EXAMPLE). +C +C USAGE (BY EZMAP) CALL MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS) +C +C ARGUMENTS NOUT IS THE NUMBER OF THE OUTLINE DATASET FROM +C WHICH THE SEGMENT COMES, AS FOLLOWS: +C +C NOUT DATASET TO WHICH SEGMENT BELONGS. +C ---- ------------------------------------ +C 1 'CO' - CONTINENTAL OUTLINES ONLY. +C 2 'US' - U.S STATE OUTLINES ONLY. +C 3 'PS' - CONTINENTAL, U.S STATE, AND +C INTERNATIONAL OUTLINES. +C 4 'PO' - CONTINENTAL AND INTERNATIONAL +C OUTLINES. +C +C NSEG IS THE NUMBER OF THE SEGMENT WITHIN THE +C OUTLINE DATASET. +C +C IGID IDENTIFIES THE GROUP TO WHICH THE SEGMENT +C BELONGS, AS FOLLOWS: +C +C IGID GROUP TO WHICH SEGMENT BELONGS. +C ---- ------------------------------------ +C 1 CONTINENTAL OUTLINES. +C 2 U.S. STATE BOUNDARIES. +C 3 INTERNATIONAL BOUNDARIES. +C +C NPTS IS THE NUMBER OF POINTS DEFINING THE +C OUTLINE SEGMENT. NPTS MAY BE ZEROED TO +C SUPPRESS PLOTTING OF THE SEGMENT. +C +C PNTS IS AN ARRAY OF COORDINATES. PNTS(1) +C AND PNTS(2) ARE THE LATITUDE AND LONGITUDE +C OF THE FIRST POINT, PNTS(3) AND PNTS(4) THE +C LATITUDE AND LONGITUDE OF THE SECOND POINT, ... +C PNTS(2*NPTS-1) AND PNTS(2*NPTS) THE LATITUDE +C AND LONGITUDE OF THE LAST POINT. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P F S T - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO DRAW LINES ON THE MAP PRODUCED BY A CALL TO +C MAPDRW - USED IN CONJUNCTION WITH MAPVEC. +C +C USAGE CALL MAPFST (RLAT,RLON) +C +C THIS CALL IS EXACTLY EQUIVALENT TO THE CALL +C +C CALL MAPIT (RLAT,RLON,0) +C +C ARGUMENTS RLAT AND RLON ARE DEFINED AS FOR MAPIT. SEE +C THE DESCRIPTION OF MAPIT. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P G R D - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO DRAW A GRID MADE UP OF LINES OF LATITUDE AND +C LONGITUDE. IF EZMAP NEEDS INITIALIZATION OR IF +C THE ERROR FLAG 'ER' IS NON-ZERO, MAPGRD DOES +C NOTHING. +C +C USAGE CALL MAPGRD +C +C ARGUMENTS NONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P G T X - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO GET THE VALUES OF EZMAP PARAMETERS. +C +C USAGE CALL MAPGTC (WHCH,CVAL) +C CALL MAPGTI (WHCH,IVAL) +C CALL MAPGTL (WHCH,LVAL) +C CALL MAPGTR (WHCH,RVAL) +C +C ARGUMENTS WHCH IS A CHARACTER STRING SPECIFYING THE +C PARAMETER TO GET. +C +C CVAL, IVAL, LVAL, OR RVAL IS A VARIABLE TO +C RECEIVE THE VALUE OF THE PARAMETER SPECIFIED +C BY WHCH - OF TYPE CHARACTER, INTEGER, LOGICAL, +C OR REAL, RESPECTIVELY. +C +C ALL OF THE PARAMETERS LISTED IN THE DISCUSSION +C OF MAPSTX MAY BE RETRIEVED. THE FOLLOWING MAY +C ALSO BE RETRIEVED: +C +C WHCH TYPE MEANING +C ---- ---- ------- +C +C AREA C THE VALUE OF THE MAP LIMITS +C SPECIFIER JLTS FROM THE LAST +C CALL TO MAPSET. THE DEFAULT +C VALUE IS 'MA'. +C +C ERROR I THE CURRENT VALUE OF THE ERROR +C FLAG. DEFAULT IS ZERO. +C +C INITIALIZE I,L INITIALIZATION FLAG. IF TRUE +C (NON-ZERO), EZMAP IS IN NEED +C OF INITIALIZATION (BY MEANS OF +C A CALL MAPINT). THE DEFAULT +C VALUE IS TRUE (NON-ZERO). +C +C PROJECTION C THE VALUE OF THE PROJECTION +C SPECIFIER JPRJ FROM THE LAST +C CALL TO MAPROJ. THE DEFAULT +C VALUE IS 'CE'. +C +C PN I,R THE VALUE OF PLON FROM THE +C LAST CALL TO MAPROJ. THE +C DEFAULT VALUE IS ZERO. +C +C PT I,R THE VALUE OF PLAT FROM THE +C LAST CALL TO MAPROJ. THE +C DEFAULT VALUE IS ZERO. +C +C PN I,R "N" IS AN INTEGER BETWEEN 1 +C AND 8. RETRIEVES VALUES FROM +C THE LAST CALL TO MAPSET. P1 +C THROUGH P4 GET YOU PLM1(1), +C PLM2(1), PLM3(1), AND PLM4(1), +C WHILE P5 THROUGH P8 GET YOU +C PLM1(2), PLM2(2), PLM3(2), AND +C PLM4(2). THE DEFAULT VALUES +C ARE ALL ZERO. +C +C ROTATION I,R THE VALUE OF ROTA FROM THE +C LAST CALL TO MAPROJ. THE +C DEFAULT VALUE IS ZERO. +C +C XLEFT R THE PARAMETERS XLOW, XROW, +C XRIGHT R YBOW, AND YTOW FROM THE LAST +C YBOTTOM R CALL TO MAPPOS. DEFAULTS +C YTOP R ARE .05, .95, .05, AND .95. +C +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P I N T - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO INITIALIZE THE PACKAGE AFTER THE VALUES OF +C SOME PARAMETERS HAVE BEEN CHANGED. THE FLAG +C 'IN', WHICH MAY BE RETRIEVED BY A CALL TO +C MAPGTI OR MAPGTL, INDICATES WHETHER OR NOT +C INITIALIZATION IS REQUIRED AT A GIVEN TIME. +C (SOME PARAMETERS MAY BE RESET AT ANY TIME AND +C DO NOT REQUIRE MAPINT TO BE CALLED AGAIN.) +C +C USAGE CALL MAPINT +C +C ARGUMENTS NONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P I T - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO DRAW LINES ON THE MAP PRODUCED BY A CALL +C TO MAPDRW. MAPIT ATTEMPTS TO OMIT NON-VISIBLE +C PORTIONS AND TO HANDLE "CROSS-OVER" - A JUMP +C FROM ONE END OF THE MAP TO THE OTHER CAUSED +C BY THE PROJECTION'S HAVING SLIT THE GLOBE +C ALONG SOME HALF OF A GREAT CIRCLE AND LAID IT +C OPEN WITH THE TWO SIDES OF THE SLIT AT OPPOSITE +C ENDS OF THE MAP. CROSS-OVER CAN OCCUR ON +C CYLINDRICAL AND CONICAL PROJECTIONS; MAPIT +C HANDLES IT VERY WELL ON THE FORMER AND NOT SO +C WELL ON THE LATTER. +C +C THE EZMAP PARAMETER 'DL' DETERMINES WHETHER +C MAPIT DRAWS SOLID LINES OR DOTTED LINES. THE +C PARAMETERS 'DD' AND 'MV' ALSO AFFECT MAPIT'S +C BEHAVIOR. SEE THE DESCRIPTION OF THE ROUTINE +C MAPSTX, BELOW. +C +C A SEQUENCE OF CALLS TO MAPIT SHOULD BE FOLLOWED +C BY A CALL TO MAPIQ (WHICH SEE, ABOVE) TO FLUSH +C ITS BUFFERS. +C +C POINTS IN TWO CONTIGUOUS PEN-DOWN CALLS TO +C MAPIT SHOULD NOT BE FAR APART ON THE GLOBE. +C +C USAGE CALL MAPIT (RLAT,RLON,IFST) +C +C ARGUMENTS RLAT AND RLON ARE THE LATITUDE AND LONGITUDE +C OF A POINT TO WHICH THE "PEN" IS TO BE MOVED. +C BOTH ARE GIVEN IN DEGREES. RLAT MUST BE +C BETWEEN -90. AND +90., INCLUSIVE; RLON MUST BE +C BETWEEN -540. AND +540., INCLUSIVE. +C +C IFST IS 0 TO DO A "PEN-UP" MOVE, 1 TO DO A +C "PEN-DOWN" MOVE IF THE DISTANCE FROM THE LAST +C POINT TO THE NEW POINT IS GREATER THAN 'MV' +C PLOTTER UNITS, 2 OR GREATER TO DO THE MOVE +C REGARDLESS OF THE DISTANCE FROM THE LAST POINT +C TO THE NEW ONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P I Q - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO FLUSH MAPIT'S BUFFERS. THIS IS PARTICULARLY +C IMPORTANT BEFORE A STOP OR A CALL FRAME AND +C BEFORE CHANGING INTENSITY, DASH PATTERN, COLOR, +C ETC. +C +C USAGE CALL MAPIQ +C +C ARGUMENTS NONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P L B L - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO LABEL THE INTERNATIONAL DATE LINE (ID), THE +C EQUATOR (EQ), THE GREENWICH MERIDIAN (GM), AND +C THE POLES (NP AND SP), AND TO DRAW THE BORDER +C AROUND THE MAP. IF EZMAP NEEDS INITIALIZATION +C OR IF THE ERROR FLAG 'ER' IS SET, MAPLBL DOES +C NOTHING. +C +C USAGE CALL MAPLBL +C +C ARGUMENTS NONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P L O T - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO DRAW THE CONTINENTAL AND/OR INTERNATIONAL +C AND/OR U.S. STATE OUTLINES SELECTED BY THE +C PARAMETER 'OU'. IF EZMAP CURRENTLY NEEDS +C INITIALIZATION OR IF THE ERROR FLAG 'ER' IS +C SET, MAPLOT DOES NOTHING. +C +C USAGE CALL MAPLOT +C +C ARGUMENTS NONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P P O S - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO SPECIFY THE POSITION OF THE MAP ON THE +C PLOTTER FRAME. +C +C USAGE CALL MAPPOS (XLOW,XROW,YBOW,YTOW) +C +C ARGUMENTS THE ARGUMENTS ARE FRACTIONS BETWEEN 0 AND 1 +C DETERMINING THE POSITION OF A WINDOW IN THE +C PLOTTER FRAME WITHIN WHICH THE MAP IS TO BE +C DRAWN. XLOW AND XROW POSITION THE LEFT AND +C RIGHT EDGES AND ARE STATED AS FRACTIONS OF THE +C DISTANCE FROM LEFT TO RIGHT IN THE PLOTTER +C FRAME. YBOW AND YTOW POSITION THE BOTTOM AND +C TOP EDGES AND ARE STATED AS FRACTIONS OF THE +C DISTANCE FROM BOTTOM TO TOP IN THE PLOTTER +C FRAME. THE MAP IS CENTERED IN THE SPECIFIED +C WINDOW AND MADE AS LARGE AS POSSIBLE WHILE +C MAINTAINING ITS PROPER SHAPE. +C +C THE DEFAULT VALUES OF THE INTERNAL PARAMETERS +C CHANGED BY THIS ROUTINE ARE .05, .95, .05, AND +C .95, RESPECTIVELY. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P R O J - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO SPECIFY THE PROJECTION TO BE USED. +C +C USAGE CALL MAPROJ (JPRJ,PLAT,PLON,ROTA) +C +C ARGUMENTS JPRJ IS A CHARACTER VARIABLE DEFINING THE +C DESIRED PROJECTION TYPE, AS FOLLOWS: +C +C THE CONIC PROJECTION: +C +C 'LC' - LAMBERT CONFORMAL CONIC WITH TWO +C STANDARD PARALLELS. +C +C THE AZIMUTHAL PROJECTIONS: +C +C 'ST' - STEREOGRAPHIC. +C +C 'OR' - ORTHOGRAPHIC. CAUSES THE PARAMETER +C 'SA' (WHICH SEE, IN THE DESCRIPTION +C OF THE ROUTINE MAPSTX) TO BE ZEROED. +C +C 'LE' - LAMBERT EQUAL AREA. +C +C 'GN' - GNOMONIC. +C +C 'AE' - AZIMUTHAL EQUIDISTANT. +C +C 'SV' - SATELLITE-VIEW. IF THE PARAMETER +C 'SA' (WHICH SEE, IN THE DESCRIPTION +C OF THE ROUTINE MAPSTX) IS GREATER +C THAN 1 OR LESS THAN -1, IT IS LEFT +C ALONE; OTHERWISE, IT IS GIVEN THE +C VALUE 6.631. +C +C THE CYLINDRICAL PROJECTIONS: +C +C 'CE' - CYLINDRICAL EQUIDISTANT. +C +C 'ME' - MERCATOR. +C +C 'MO' - MOLLWEIDE. THE PROJECTION USED IS +C NOT ACTUALLY A TRUE MOLLWEIDE. +C +C PLAT, PLON, AND ROTA ARE REALS SPECIFYING THE +C VALUES OF ANGULAR QUANTITIES, IN DEGREES. HOW +C THEY ARE USED DEPENDS ON THE VALUE OF JPRJ, AS +C FOLLOWS: +C +C IF JPRJ IS NOT EQUAL TO 'LC': PLAT AND PLON +C DEFINE THE LATITUDE AND LONGITUDE OF THE POLE +C OF THE PROJECTION - THE POINT ON THE GLOBE +C WHICH IS TO BE PROJECTED TO THE ORIGIN OF THE +C U/V PLANE. PLAT MUST BE BETWEEN -90. AND +90., +C INCLUSIVE, POSITIVE IN THE NORTHERN HEMISPHERE, +C NEGATIVE IN THE SOUTHERN. PLON MUST BE BETWEEN +C -180. AND +180., INCLUSIVE, POSITIVE TO THE +C EAST, AND NEGATIVE TO THE WEST, OF GREENWICH. +C ROTA IS THE ANGLE BETWEEN THE V AXIS AND NORTH +C AT THE ORIGIN. IT IS TAKEN TO BE POSITIVE IF +C THE ANGULAR MOVEMENT FROM NORTH TO THE V AXIS +C IS COUNTER-CLOCKWISE, NEGATIVE OTHERWISE. IF +C THE ORIGIN IS AT THE NORTH POLE, "NORTH" IS +C CONSIDERED TO BE IN THE DIRECTION OF PLON+180. +C IF THE ORIGIN IS AT THE SOUTH POLE, "NORTH" IS +C CONSIDERED TO BE IN THE DIRECTION OF PLON. +C FOR THE CYLINDRICAL PROJECTIONS, THE AXIS OF +C THE PROJECTION IS PARALLEL TO THE V AXIS. +C +C IF JPRJ IS EQUAL TO 'LC' (LAMBERT CONFORMAL +C CONIC WITH TWO STANDARD PARALLELS): PLON +C DEFINES THE CENTRAL MERIDIAN OF THE PROJECTION, +C WHILE PLAT AND ROTA DEFINE THE TWO STANDARD +C PARALLELS. IF PLAT AND ROTA ARE EQUAL, A +C CONIC PROJECTION WITH ONE STANDARD PARALLEL +C IS USED. +C +C MORE DETAILED DESCRIPTIONS OF THE PROJECTIONS +C MAY BE FOUND IN THE GRAPHICS MANUAL, TOGETHER +C WITH HELPFUL DIAGRAMS, BUT A FEW WORDS MAY BE +C HELPFUL HERE: +C +C THE CONICAL PROJECTION MAPS THE SURFACE OF THE +C EARTH ONTO THE SURFACE OF A CONE INTERSECTING +C THE EARTH ALONG THE TWO STANDARD PARALLELS. +C THE CONE IS THEN SLIT ALONG A LINE OPPOSITE +C THE CENTRAL MERIDIAN AND OPENED UP (WITH SOME +C STRETCHING) ONTO A FLAT SURFACE. +C +C THE AZIMUTHAL PROJECTIONS MAP THE SURFACE OF +C THE EARTH (OR OF ONE HEMISPHERE OF THE EARTH) +C ONTO A PLANE WHOSE ORIGIN IS TANGENT TO IT AT +C THE POINT (PLAT,PLON). THE SEVERAL AZIMUTHAL +C PROJECTIONS DIFFER ONLY IN THE FUNCTION USED +C TO MAP THE GREAT-CIRCLE DISTANCE OF A POINT +C FROM THE POLE (PLAT,PLON) TO A LINEAR DISTANCE +C OF THE PROJECTED POINT FROM THE ORIGIN (0,0). +C THE PROJECTED IMAGE MAY BE ROTATED USING THE +C PARAMETER ROTA. +C +C THE CYLINDRICAL PROJECTIONS MAP THE SURFACE OF +C THE EARTH ONTO A CYLINDER WHICH IS TANGENT TO +C IT ALONG A GREAT CIRCLE PASSING THROUGH THE +C POINT (PLAT,PLON) AT AN ANGLE DETERMINED BY +C ROTA. THE CYLINDER IS THEN SLIT ALONG ITS +C LENGTH THROUGH THE POINT OPPOSITE (PLAT,PLON) +C AND OPENED UP ONTO THE PLANE. THE SEVERAL +C CYLINDRICAL PROJECTIONS DIFFER PRINCIPALLY IN +C THE FUNCTION USED TO MAP THE DISTANCE FROM THE +C GREAT CIRCLE OF TANGENCY TO A DISTANCE ALONG +C THE CYLINDER. IF PLAT IS ZERO AND ROTA IS +C EITHER 0. OR 180., THE CYLINDRICAL PROJECTIONS +C ARE PARTICULARLY SIMPLE TO DO AND A FASTER PATH +C THROUGH THE CODE IS USED. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P R S - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE RECALLS SET. INTENDED TO BE USED WHEN DATA +C IS TO BE PLOTTED OVER A MAP GENERATED IN A +C DIFFERENT OVERLAY (E.G., USING A FLASH BUFFER), +C AND WHEN THE SYSTEM PLOT PACKAGE DOES NOT +C RESIDE IN AN OUTER OVERLAY. +C +C USAGE CALL MAPRS +C +C ARGUMENTS NONE. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P R S T - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE RESTORES A SAVED STATE OF EZMAP. THIS IS DONE +C BY READING SAVED PARAMETER VALUES FROM A USER +C UNIT AND THEN CALLING MAPINT. SEE MAPSAV. +C +C USAGE CALL MAPRST (IFNO) +C +C ARGUMENTS IFNO IS THE NUMBER OF A UNIT FROM WHICH A +C SINGLE UNFORMATTED RECORD IS TO BE READ. IT +C IS THE USER'S RESPONSIBILITY TO POSITION THIS +C UNIT. MAPRST DOES NOT REWIND IT, EITHER BEFORE +C OR AFTER READING THE RECORD. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P S A V - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE SAVES THE CURRENT STATE OF EZMAP BY WRITING +C PARAMETER VALUES ONTO A USER UNIT. SEE MAPRST. +C +C USAGE CALL MAPSAV (IFNO) +C +C ARGUMENTS IFNO IS THE NUMBER OF A UNIT TO WHICH A SINGLE +C UNFORMATTED RECORD IS TO BE WRITTEN. IT IS THE +C USER'S RESPONSIBILITY TO POSITION THIS UNIT. +C MAPSAV DOES NOT REWIND IT, EITHER BEFORE OR +C AFTER WRITING THE RECORD. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P S E T - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO SPECIFY THE RECTANGULAR PORTION OF THE U/V +C PLANE TO BE DRAWN. +C +C USAGE CALL MAPSET (JLTS,PLM1,PLM2,PLM3,PLM4) +C +C ARGUMENTS JLTS CAN HAVE THE FOLLOWING CHARACTER VALUES. +C IT SPECIFIES ONE OF FIVE WAYS IN WHICH THE +C LIMITS OF THE MAP ARE DEFINED BY THE PARAMETERS +C PLM1, PLM2, PLM3, AND PLM4. +C +C JLTS='MA' (MAXIMUM). THE MAXIMUM USEFUL AREA +C PRODUCED BY THE PROJECTION IS PLOTTED. PLM1, +C PLM2, PLM3, AND PLM4 ARE NOT USED. +C +C JLTS='CO' (CORNERS). THE POINTS (PLM1,PLM2) +C AND (PLM3,PLM4) ARE TO BE AT OPPOSITE CORNERS +C OF THE MAP. PLM1 AND PLM3 ARE LATITUDES, IN +C DEGREES. PLM2 AND PLM4 ARE LONGITUDES, IN +C DEGREES. IF A CYLINDRICAL PROJECTION IS BEING +C USED, THE FIRST POINT SHOULD BE ON THE LEFT +C EDGE OF THE MAP AND THE SECOND POINT ON THE +C RIGHT EDGE; OTHERWISE, THE ORDER MAKES NO +C DIFFERENCE. +C +C JLTS='PO' (POINTS). PLM1, PLM2, PLM3, AND PLM4 +C ARE TWO-ELEMENT ARRAYS GIVING THE LATITUDES +C AND LONGITUDES, IN DEGREES, OF FOUR POINTS +C WHICH ARE TO BE ON THE EDGES OF THE RECTANGULAR +C MAP. IF A CYLINDRICAL PROJECTION IS BEING +C USED, THE FIRST POINT SHOULD BE ON THE LEFT +C EDGE AND THE SECOND POINT ON THE RIGHT EDGE; +C OTHERWISE, THE ORDER MAKES NO DIFFERENCE. +C NOTE THAT THE CALLING PROGRAM SHOULD INCLUDE +C THE FOLLOWING STATEMENT: +C +C DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2) +C +C (IN FACT, STRICT ADHERENCE TO THE FORTRAN-77 +C STANDARD REQUIRES THIS, NO MATTER WHAT THE +C VALUE OF JLTS.) +C +C JLTS='AN' (ANGLES). PLM1, PLM2, PLM3, AND PLM4 +C ARE POSITIVE ANGLES, IN DEGREES, REPRESENTING +C ANGULAR DISTANCES FROM A POINT ON THE MAP TO +C THE LEFT, RIGHT, BOTTOM, AND TOP EDGES OF THE +C MAP. FOR MOST PROJECTIONS, THESE ANGLES ARE +C MEASURED WITH THE CENTER OF THE EARTH AT THE +C VERTEX AND REPRESENT ANGULAR DISTANCES FROM THE +C POINT WHICH PROJECTS TO THE ORIGIN OF THE U/V +C PLANE; ON A SATELLITE-VIEW PROJECTION, THEY ARE +C MEASURED WITH THE SATELLITE AT THE VERTEX AND +C REPRESENT ANGULAR DEVIATIONS FROM THE LINE OF +C SIGHT. ANGULAR LIMITS ARE PARTICULARLY USEFUL +C FOR POLAR PROJECTIONS AND THE SATELLITE-VIEW +C PROJECTION; THEY ARE NOT APPROPRIATE FOR THE +C LAMBERT CONFORMAL CONIC AND AN ERROR WILL +C RESULT IF ONE ATTEMPTS TO USE JLTS='AN' WITH +C JPRJ='LC'. +C +C JLTS='LI' (LIMITS). PLM1, PLM2, PLM3, AND PLM4 +C SPECIFY THE MINIMUM VALUE OF U, THE MAXIMUM +C VALUE OF U, THE MINIMUM VALUE OF V, AND THE +C MAXIMUM VALUE OF V, RESPECTIVELY. KNOWLEDGE +C OF THE PROJECTION EQUATIONS IS NECESSARY IN +C ORDER TO USE THIS OPTION CORRECTLY. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P S T X - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO SET THE VALUES OF EZMAP PARAMETERS. +C +C USAGE CALL MAPSTC (WHCH,CVAL) +C CALL MAPSTI (WHCH,IVAL) +C CALL MAPSTL (WHCH,LVAL) +C CALL MAPSTR (WHCH,RVAL) +C +C ARGUMENTS WHCH IS A CHARACTER STRING SPECIFYING THE +C PARAMETER TO BE SET. +C +C CVAL, IVAL, LVAL, OR RVAL IS THE VALUE TO BE +C GIVEN TO THE PARAMETER SPECIFIED BY WHCH - OF +C TYPE CHARACTER, INTEGER, LOGICAL, OR REAL, +C RESPECTIVELY. +C +C SOME PARAMETERS MAY BE SET IN MORE THAN ONE +C WAY. FOR EXAMPLE, THE PARAMETER 'GR' (GRID), +C WHICH SPECIFIES THE GRID SPACING, MAY BE GIVEN +C THE VALUE 10.0 IN EITHER OF TWO WAYS: +C +C CALL MAPSTI ('GR',10) +C CALL MAPSTR ('GR',10.) +C +C THE FLAG WHICH CONTROLS DOTTING OF OUTLINES +C MAY BE TURNED ON USING EITHER OF THESE CALLS: +C +C CALL MAPSTI ('DO',1) +C CALL MAPSTL ('DO',.TRUE.) +C +C THE IMPORTANT POINT TO REMEMBER IS THAT THE +C LAST CHARACTER OF THE ROUTINE NAME IMPLIES +C THE TYPE OF THE ARGUMENT. +C +C ONLY THE FIRST TWO CHARACTERS OF WHCH ARE +C EXAMINED. FOR THE SAKE OF CODE READABILITY, +C A LONGER CHARACTER STRING MAY BE USED. +C +C BELOW IS A LIST OF ALL THE PARAMETERS WHICH +C MAY BE SET USING THESE ROUTINES. +C +C WHCH TYPE MEANING +C ---- ---- ------- +C +C DASHPATTERN I DASHED-LINE PATTERN FOR THE +C GRIDS. A 16-BIT QUANTITY. +C DEFAULT IS 21845 (OCTAL 52525 +C OR BINARY 0101010101010101). +C +C DD I,R DISTANCE BETWEEN DOTS ALONG A +C DOTTED LINE DRAWN BY MAPIT. +C THE DEFAULT VALUE IS 12 (OUT +C OF 4096; SEE 'RE', BELOW). +C +C DL I,L IF TRUE (NON-ZERO), USER CALLS +C TO MAPIT DRAW DOTTED LINES. +C DEFAULT IS FALSE (ZERO); LINES +C DRAWN BY MAPIT ARE SOLID OR +C DASHED, DEPENDING ON THE +C CURRENT STATE OF THE DASHCHAR +C PACKAGE. +C +C DOT I,L IF TRUE (NON-ZERO), OUTLINES +C ARE DOTTED. DEFAULT IS FALSE +C (ZERO); OUTLINES ARE SOLID. +C +C ELLIPTICAL I,L IF TRUE (NON-ZERO), ONLY THAT +C PART OF THE MAP WHICH FALLS +C INSIDE AN ELLIPSE INSCRIBED +C WITHIN THE NORMAL RECTANGULAR +C PERIMETER IS DRAWN. THIS IS +C PARTICULARLY APPROPRIATE FOR +C USE WITH AZIMUTHAL PROJECTIONS +C AND ANGULAR LIMITS SPECIFYING +C A SQUARE, IN WHICH CASE THE +C ELLIPSE BECOMES A CIRCLE, BUT +C IT WILL WORK FOR ANY MAP. THE +C DEFAULT VALUE IS ZERO. +C +C GD R THE DISTANCE BETWEEN POINTS +C USED TO DRAW THE GRID, IN +C DEGREES. THE DEFAULT VALUE +C IS 1.; USER VALUES MUST FALL +C BETWEEN .001 AND 10. +C +C GRID I,R THE DESIRED GRID SPACING. A +C ZERO SUPPRESSES THE GRID. THE +C DEFAULT IS 10 DEGREES. +C +C IN I "N" IS AN INTEGER BETWEEN 1 +C AND 7. EACH "IN" SPECIFIES +C THE INTENSITY OF SOME PORTION +C OF THE MAP. VALUES ARE IN THE +C RANGE 0-255. DEFAULTS ARE: +C +C N USE DEFAULT +C - ----------- ------- +C 1 PERIMETER 240 +C 2 GRID 150 +C 3 LABELS 210 +C 4 LIMBS 240 +C 5 CONTINENTS 240 +C 6 U.S. STATES 180 +C 7 COUNTRIES 210 +C +C LABEL I,L IF TRUE (NON-ZERO), LABEL THE +C MERIDIANS AND POLES. DEFAULT +C IS TRUE (NON-ZERO). +C +C LS I CONTROLS LABEL SIZE. A +C CHARACTER WIDTH, TO BE USED +C IN CALLING PWRIT. THE DEFAULT +C VALUE IS 1, WHICH GIVES A +C CHARACTER WIDTH OF 12 PLOTTER +C UNITS. +C +C MV I,R MINIMUM VECTOR LENGTH FOR +C OUTLINES. A POINT CLOSER TO +C THE PREVIOUS POINT THAN THIS +C IS OMITTED. DEFAULT VALUE IS +C 4 (OUT OF 4096; SEE 'RE', +C BELOW). +C +C OUTLINE C SAYS WHICH SET OF OUTLINE DATA +C TO USE. POSSIBLE VALUES ARE +C 'NO', FOR NO OUTLINES, 'CO', +C FOR THE CONTINENTAL OUTLINES +C (THE DEFAULT), 'US', FOR U.S. +C STATE OUTLINES, 'PS', FOR +C CONTINENTAL OUTLINES PLUS +C INTERNATIONAL OUTLINES PLUS +C U.S. STATE OUTLINES, AND 'PO', +C FOR CONTINENTAL OUTLINES PLUS +C INTERNATIONAL OUTLINES. +C DEFAULT IS 'CO'. +C +C PERIM I,L IF TRUE (NON-ZERO), DRAW THE +C PERIMETER. DEFAULT IS TRUE +C (NON-ZERO). +C +C RESOLUTION I,R THE WIDTH OF THE TARGET +C PLOTTER, IN PLOTTER UNITS. +C DEFAULT VALUE IS 4096. +C +C SATELLITE I,R IF LESS THAN -1 OR GREATER +C THAN 1, CHANGES ORTHOGRAPHIC +C PROJECTION TO SATELLITE-VIEW. +C ABSOLUTE VALUE IS THE DISTANCE +C OF SATELLITE FROM THE CENTER +C OF THE EARTH, IN MULTIPLES OF +C THE EARTH'S RADIUS. THE SIGN +C INDICATES WHETHER A NORMAL +C PROJECTION (POSITIVE) OR AN +C EXTENDED PROJECTION (NEGATIVE) +C IS TO BE USED. THE EXTENDED +C PROJECTION IS USEFUL WHEN ONE +C IS OVERLAYING CONREC OUTPUT ON +C A MAP. THE DEFAULT VALUE OF +C 'SA' IS ZERO. SEE ALSO 'S1' +C AND 'S2', BELOW. +C +C S1 AND S2 I,R USED ONLY WHEN 'SA' IS OUTSIDE +C [-1,1]. BOTH ARE ANGLES, IN +C DEGREES. 'S1' MEASURES THE +C ANGLE BETWEEN THE CENTER OF +C THE EARTH AND THE AIM POINT +C OF THE SATELLITE'S CAMERA, AS +C SEEN FROM THE SATELLITE. IF +C 'S1' IS ZERO, THE PROJECTION +C SHOWS THE EARTH AS SEEN BY A +C SATELLITE LOOKING STRAIGHT +C DOWN; CALL THIS THE "BASIC +C VIEW". IF 'S1' IS NON-ZERO, +C 'S2' MEASURES THE ANGLE FROM +C THE POSITIVE U AXIS OF THE +C BASIC VIEW TO THE LINE OP, +C WHERE O IS THE ORIGIN OF THE +C BASIC VIEW AND P IS THE +C PROJECTION OF THE DESIRED LINE +C OF SIGHT ON THE BASIC VIEW, +C POSITIVE IF MEASURED COUNTER- +C CLOCKWISE. +C +C SR R A SEARCH RADIUS, IN DEGREES. +C USED BY MAPINT IN FINDING THE +C LATITUDE/LONGITUDE RANGE OF +C THE MAP. THE DEFAULT VALUE +C IS 1.; USER VALUES MUST FALL +C BETWEEN .001 AND 10. THIS +C PARAMETER SHOULD PROBABLY NOT +C BE CHANGED EXCEPT BY ADVICE +C OF A KNOWLEDGEABLE CONSULTANT. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P T R N - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO FIND THE PROJECTION IN THE U/V PLANE OF A +C POINT WHOSE LATITUDE AND LONGITUDE ARE KNOWN. +C MAY BE CALLED AT ANY TIME AFTER EZMAP HAS BEEN +C INITIALIZED (BY CALLING MAPINT OR OTHERWISE). +C +C USAGE CALL MAPTRN (RLAT,RLON,UVAL,VVAL) +C +C ARGUMENTS RLAT AND RLON ARE THE LATITUDE AND LONGITUDE, +C RESPECTIVELY, OF A POINT ON THE GLOBE. RLAT +C MUST BE BETWEEN -90. AND +90., INCLUSIVE; RLON +C MUST BE BETWEEN -540. AND +540., INCLUSIVE. +C +C (UVAL,VVAL) IS THE PROJECTION IN THE U/V PLANE +C OF (RLAT,RLON). THE UNITS OF UVAL AND VVAL +C DEPEND ON THE PROJECTION. +C +C IF THE POINT IS NOT PROJECTABLE, UVAL IS +C RETURNED EQUAL TO 1.E12. NOTE THAT, IF +C THE POINT IS PROJECTABLE, BUT OUTSIDE THE +C BOUNDARY OF THE MAP, AS DEFINED BY THE LAST +C CALL TO MAPSET, ITS U AND V COORDINATES ARE +C STILL RETURNED BY MAPTRN. THE USER MUST DO +C THE TEST REQUIRED TO DETERMINE IF THE POINT +C IS WITHIN LIMITS, IF THAT IS NECESSARY. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P U S R - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE THE ROUTINE MAPUSR IS CALLED BY EZMAP JUST +C BEFORE AND JUST AFTER PORTIONS OF THE MAP +C ARE DRAWN. THE DEFAULT VERSION DOES NOTHING. +C (ACTUALLY, THAT'S NOT QUITE TRUE; FOR THE SAKE +C OF EFFICIENCY, THE NON-GKS VERSIONS RESETS THE +C DASH PATTERN FOR GRID LINES TO "SOLID" AND +C THEN DOES AN OPTN CALL TO MAKE THE TRANSLATOR +C GENERATE THE DESIRED PATTERN.) A USER-SUPPLIED +C VERSION MAY SET/RESET THE DOTTING PARAMETER +C 'DL', THE DASHCHAR DASH PATTERN, THE INTENSITY, +C THE COLOR, ETC., SO AS TO ACHIEVE A DESIRED +C EFFECT. +C +C USAGE (BY EZMAP) CALL MAPUSR (IPRT) +C +C ARGUMENTS IPRT, IF POSITIVE, SAYS THAT A PARTICULAR PART +C OF THE MAP IS ABOUT TO BE DRAWN, AS FOLLOWS: +C +C IPRT PART +C ---- ----------------------- +C 1 PERIMETER. +C 2 GRID. +C 3 LABELS. +C 4 LIMB LINES. +C 5 CONTINENTAL OUTLINES. +C 6 U.S. STATE OUTLINES. +C 7 INTERNATIONAL OUTLINES. +C +C IF IPRT IS NEGATIVE, IT SAYS THAT DRAWING OF +C THE LAST PART IS COMPLETE. THE ABSOLUTE VALUE +C OF IPRT WILL BE ONE OF THE ABOVE VALUES. +C CHANGED QUANTITIES SHOULD BE RESTORED. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E M A P V E C - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO DRAW LINES ON THE MAP PRODUCED BY A CALL TO +C MAPDRW - USED IN CONJUNCTION WITH MAPFST. +C +C USAGE CALL MAPVEC (RLAT,RLON) +C +C THIS CALL IS EXACTLY EQUIVALENT TO THE CALL +C +C CALL MAPIT (RLAT,RLON,1) +C +C ARGUMENTS RLAT AND RLON ARE DEFINED AS FOR MAPIT. SEE +C THE DESCRIPTION OF MAPIT. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E S U P C O N - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE TO FIND THE PROJECTION IN THE U/V PLANE OF A +C POINT WHOSE LATITUDE AND LONGITUDE ARE KNOWN. +C THIS ROUTINE IS PROVIDED FOR COMPATIBILITY +C WITH EARLIER VERSIONS OF THE PACKAGE. IF +C EFFICIENCY IS A CONSIDERATION, THE USER SHOULD +C BY-PASS THIS ROUTINE AND CALL MAPTRN DIRECTLY. +C +C USAGE CALL SUPCON (RLAT,RLON,UVAL,VVAL) +C +C THIS CALL IS EXACTLY EQUIVALENT TO THE CALL +C +C CALL MAPTRN (RLAT,RLON,UVAL,VVAL) +C +C ARGUMENTS RLAT, RLON, UVAL, AND VVAL ARE DEFINED AS FOR +C THE ROUTINE MAPTRN. SEE THE DESCRIPTION OF +C MAPTRN. +C +C----------------------------------------------------------------------- +C S U B R O U T I N E S U P M A P - D E S C R I P T I O N +C----------------------------------------------------------------------- +C +C PURPOSE AN IMPLEMENTATION OF THE ROUTINE FROM WHICH +C EZMAP GREW. A SINGLE CALL TO SUPMAP CREATES +C A MAP OF A DESIRED PORTION OF THE GLOBE, +C ACCORDING TO A DESIRED PROJECTION, WITH DESIRED +C OUTLINES DRAWN IN, AND WITH LINES OF LATITUDE +C AND LONGITUDE AT DESIRED INTERVALS. AN +C APPROPRIATE CALL TO THE ROUTINE SET IS +C PERFORMED, AND THE ROUTINE SUPCON (WHICH SEE) +C IS INITIALIZED SO THAT THE USER MAY MAP POINTS +C OF KNOWN LATITUDE AND LONGITUDE TO POINTS IN +C THE U/V PLANE AND USE THE U/V COORDINATES TO +C DRAW OBJECTS ON THE MAP PRODUCED BY SUPMAP. +C +C USAGE CALL SUPMAP (JPRJ,PLAT,PLON,ROTA,PLM1,PLM2, +C PLM3,PLM4,JLTS,JGRD,IOUT,IDOT, +C IERR) +C +C ARGUMENTS IABS(JPRJ) DEFINES THE PROJECTION TYPE, AS +C FOLLOWS (VALUES LESS THAN 1 OR GREATER THAN +C 10 ARE TREATED AS 1 OR 10, RESPECTIVELY): +C +C 1 STEREOGRAPHIC. +C 2 ORTHOGRAPHIC. +C 3 LAMBERT CONFORMAL CONIC. +C 4 LAMBERT EQUAL AREA. +C 5 GNOMONIC. +C 6 AZIMUTHAL EQUIDISTANT. +C 7 SATELLITE VIEW. +C 8 CYLINDRICAL EQUIDISTANT. +C 9 MERCATOR. +C 10 MOLLWEIDE. +C +C USING THE VALUE 2 CAUSES THE PARAMETER 'SA' TO +C BE ZEROED. USING THE VALUE 7 CAUSES 'SA' TO +C BE EXAMINED. IF IT HAS A NON-ZERO VALUE, THE +C VALUE IS LEFT ALONE. IF IT HAS A ZERO VALUE, +C ITS VALUE IS RESET TO 6.631, WHICH IS ABOUT +C RIGHT FOR A SATELLITE IN A GEOSYNCHRONOUS +C EQUATORIAL ORBIT (FOR WHATEVER THAT'S WORTH). +C +C THE SIGN OF JPRJ, WHEN IOUT IS -1, 0, OR 1, +C INDICATES WHETHER THE CONTINENTAL OUTLINES ARE +C TO BE PLOTTED OR NOT. SEE IOUT, BELOW. +C +C PLAT, PLON, AND ROTA DEFINE THE ORIGIN OF THE +C PROJECTION AND ITS ROTATION ANGLE AND ARE USED +C IN THE SAME WAY AS THEY WOULD BE IN A CALL TO +C THE ROUTINE MAPROJ (WHICH SEE). +C +C JLTS, PLM1, PLM2, PLM3, AND PLM4 SPECIFY THE +C RECTANGULAR LIMITS OF THE MAP. THESE ARGUMENTS +C ARE USED IN THE SAME WAY AS THEY WOULD BE IN +C A CALL TO MAPSET (WHICH SEE), EXCEPT THAT JLTS +C IS AN INTEGER INSTEAD OF A CHARACTER STRING. +C IABS(JLTS) MAY TAKE ON THE VALUES 1 THROUGH 5, +C AS FOLLOWS: +C +C 1 LIKE JLTS='MA' IN A CALL TO MAPSET. +C 2 LIKE JLTS='CO' IN A CALL TO MAPSET. +C 3 LIKE JLTS='LI' IN A CALL TO MAPSET. +C 4 LIKE JLTS='AN' IN A CALL TO MAPSET. +C 5 LIKE JLTS='PO' IN A CALL TO MAPSET. +C +C AT ONE TIME, THE SIGN OF JLTS SPECIFIED WHETHER +C OR NOT A LINE OF TEXT WAS TO BE WRITTEN AT THE +C BOTTOM OF THE PLOT PRODUCED. THIS LINE MAY NO +C LONGER BE WRITTEN AND THE SIGN OF JLTS IS +C THEREFORE IGNORED. +C +C MOD(IABS(JGRD),1000) IS THE VALUE, IN DEGREES, +C OF THE INTERVAL AT WHICH LINES OF LATITUDE AND +C LONGITUDE ARE TO BE PLOTTED. IF THE GIVEN +C INTERVAL IS ZERO, GRID LINES AND LABELS ARE +C NOT PLOTTED. IF JGRD IS LESS THAN ZERO, THE +C PERIMETER IS NOT PLOTTED. SET JGRD TO -1000 TO +C SUPPRESS BOTH GRID LINES AND PERIMETER AND TO +C +1000 TO SUPPRESS THE GRID LINES, BUT LEAVE THE +C PERIMETER. THE VALUE -0 MAY HAVE A MEANING ON +C ONES' COMPLEMENT MACHINES, BUT SHOULD BE +C AVOIDED; USE -1000 INSTEAD. +C +C IF IOUT HAS THE VALUE 0, U.S. STATE OUTLINES +C ARE OMITTED. IF IT HAS THE ABSOLUTE VALUE 1, +C THEY ARE PLOTTED. IN BOTH OF THESE CASES, THE +C SIGN OF JPRJ INDICATES WHETHER CONTINENTAL +C OUTLINES ARE TO BE PLOTTED (JPRJ POSITIVE) +C OR NOT (JPRJ NEGATIVE). ORIGINALLY, SUPMAP +C RECOGNIZED ONLY THESE VALUES OF IOUT; NOW, IF +C IOUT IS LESS THAN -1 OR GREATER THAN 1, THE +C SIGN OF JPRJ IS IGNORED, AND IOUT SELECTS AN +C OUTLINE GROUP, AS FOLLOWS: +C +C -2 OR LESS 'NO' (NO OUTLINES). +C 2 'CO' (CONTINENTAL OUTLINES). +C 3 'US' (U.S. STATE OUTLINES). +C 4 'PS' (CONTINENTAL OUTLINES +C PLUS INTERNATIONAL +C OUTLINES PLUS U.S. +C STATE OUTLINES). +C 5 OR GREATER 'PO' (CONTINENTAL OUTLINES +C PLUS INTERNATIONAL +C OUTLINES, BUT NO U.S. +C STATE OUTLINES). +C +C AT ONE TIME, THE SIGN OF IOUT SPECIFIED WHETHER +C OR NOT A LINE OF TEXT WAS TO BE WRITTEN ON THE +C PRINT OUTPUT. THIS MAY NO LONGER BE DONE. +C +C IDOT=0 TO GET CONTINUOUS OUTLINES, 1 TO GET +C DOTTED OUTLINES. +C +C IERR IS AN OUTPUT PARAMETER. A NON-ZERO VALUE +C INDICATES THAT AN ERROR HAS OCCURRED. +C +C*********************************************************************** +C T H E C O D E - U S E R - L E V E L R O U T I N E S +C*********************************************************************** +C + SUBROUTINE MAPDRW +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPDRW','VERSION 1') +C +C INITIALIZE THE PACKAGE, DRAW AND LABEL THE GRID, AND DRAW OUTLINES. +C + IF (INTF) CALL MAPINT + CALL MAPGRD + CALL MAPLBL + CALL MAPLOT +C + RETURN + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS) + DIMENSION PNTS(*) + RETURN + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPFST (XLAT,XLON) + CALL MAPIT (XLAT,XLON,0) + RETURN + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPGRD +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMB/ IIER +C +C DEFINE LOCAL LOGICAL FLAGS. +C + LOGICAL IMF,IPF +C +C DEFINE REQUIRED CONSTANTS. +C + DATA DTOR / .017453292519943 / +C +C THE ARITHMETIC STATEMENT FUNCTIONS FLOOR AND CLING GIVE, RESPECTIVELY, +C THE "FLOOR" OF X - THE LARGEST INTEGER LESS THAN OR EQUAL TO X - AND +C THE "CEILING" OF X - THE SMALLEST INTEGER GREATER THAN OR EQUAL TO X. +C + FLOOR(X)=AINT(X+1.E4)-1.E4 + CLING(X)=-FLOOR(-X) +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPGRD','VERSION 1') +C +C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE +C LAST INITIALIZATION, DO NOTHING. +C + IF (INTF) RETURN + IF (IIER.NE.0) RETURN +C +C IF THE GRID IS SUPPRESSED, DO NOTHING. +C + IF (GRID.LE.0.) RETURN +C +C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR THE GRID. +C + CALL MAPCHI (2,0,IDSH) +C +C SET THE FLAGS IMF AND IPF, WHICH ARE TRUE IF AND ONLY IF MERIDIANS AND +C PARALLELS, RESPECTIVELY, ARE STRAIGHT LINES AND IT IS "SAFE" TO DRAW +C THEM USING LONG LINE SEGMENTS. WHAT WE HAVE TO BE SURE OF IS THAT AT +C LEAST ONE OF THE TWO ENDPOINTS OF EACH MERIDIAN, OR ITS MIDPOINT, WILL +C BE VISIBLE. (IF TWO POINTS ARE INVISIBLE, MAPIT DRAWS NOTHING, EVEN +C THOUGH THE LINE JOINING THEM MAY BE VISIBLE ALONG PART OF ITS LENGTH.) +C + IF (IPRJ.GE.1.AND.IPRJ.LE.6) THEN + IF (ELPF) THEN + IMF=(UCEN/URNG)**2+(VCEN/VRNG)**2.LT.1. + ELSE + IMF=UMIN*UMAX.LT.0..AND.VMIN*VMAX.LT.0. + END IF + IF (IPRJ.NE.1) IMF=IMF.AND.ABS(PHIA).GE.89.9999 + ELSE IF (IPRJ.EQ.10) THEN + IMF=.TRUE. + ELSE IF (IPRJ.EQ.11.AND.(.75*(VMAX-VMIN)).LE.VEPS) THEN + IMF=.TRUE. + ELSE + IMF=.FALSE. + END IF +C + IPF=IPRJ.EQ.10.OR.IPRJ.EQ.11.OR.(IPRJ.EQ.12.AND.ILTS.EQ.1) +C +C TRANSFER THE LATITUDE/LONGITUDE LIMITS COMPUTED BY MAPINT TO LOCAL, +C MODIFIABLE VARIABLES. +C + SLAT=SLAM + BLAT=BLAM + SLON=SLOM + BLON=BLOM +C +C FOR CERTAIN AZIMUTHAL PROJECTIONS CENTERED AT A POLE, THE LATITUDE +C LIMIT FURTHEST FROM THE POLE NEEDS ADJUSTMENT TO MAKE IT PROJECTABLE +C AND VISIBLE. OTHERWISE, WE HAVE TROUBLE WITH PORTIONS OF MERIDIANS +C DISAPPEARING. +C + IF (IPRJ.EQ.3.OR.IPRJ.EQ.4.OR.IPRJ.EQ.6) THEN + IF (PHIA.GT.+89.9999) THEN + SLAT=SLAT+SRCH + IF (IPRJ.EQ.3) SLAT=SLAT+SRCH + END IF + IF (PHIA.LT.-89.9999) THEN + BLAT=BLAT-SRCH + IF (IPRJ.EQ.3) BLAT=BLAT-SRCH + END IF + END IF +C +C RLON IS THE SMALLEST LONGITUDE FOR WHICH A MERIDIAN IS TO BE DRAWN, +C XLON THE BIGGEST. AVOID DRAWING A GIVEN MERIDIAN TWICE. +C + RLON=GRID*FLOOR(SLON/GRID) + XLON=GRID*CLING(BLON/GRID) + IF (XLON-RLON.GT.359.9999) THEN + IF (IPRJ.EQ.1) THEN + RLON=GRID*CLING((PHIO-179.9999)/GRID) + XLON=GRID*FLOOR((PHIO+179.9999)/GRID) + ELSE IF (IPRJ.GE.2.AND.IPRJ.LE.9) THEN + XLON=XLON-GRID + IF (XLON-RLON.GT.359.9999) XLON=XLON-GRID + END IF + END IF +C +C OLAT IS THE LATITUDE AT WHICH MERIDIANS WHICH ARE NOT MULTIPLES OF 90 +C ARE TO STOP. (EXCEPT ON CERTAIN FAST-PATH CYLINDRICAL PROJECTIONS, +C ONLY THE MERIDIANS AT LONGITUDES WHICH ARE MULTIPLES OF 90 RUN ALL +C THE WAY TO THE POLES. THIS AVOIDS A LOT OF CLUTTER.) +C + IF (IPRJ.EQ.10.OR.IPRJ.EQ.11) THEN + OLAT=90. + ELSE + OLAT=GRID*FLOOR(89.9999/GRID) + END IF +C +C DRAW THE MERIDIANS. +C + RLON=RLON-GRID + 101 RLON=RLON+GRID + XLAT=OLAT + IF (AMOD(RLON,90.).EQ.0.) XLAT=90. + RLAT=AMAX1(SLAT,-XLAT) + XLAT=AMIN1(BLAT,XLAT) + IF (IMF) THEN + DLAT=.5*(XLAT-RLAT) + ELSE + DLAT=(XLAT-RLAT)/CLING((XLAT-RLAT)/GRDR) + END IF + CALL MAPIT (RLAT,RLON,0) + 102 RLAT=RLAT+DLAT + CALL MAPIT (RLAT,RLON,1) + IF (RLAT.LT.XLAT-.9999) GO TO 102 + IF (RLON.LT.XLON-.9999) GO TO 101 +C +C ROUND THE LATITUDE LIMITS TO APPROPRIATE MULTIPLES OF GRID. +C + SLAT=GRID*FLOOR(SLAT/GRID) + IF (SLAT.LE.-90.) SLAT=SLAT+GRID + BLAT=GRID*CLING(BLAT/GRID) + IF (BLAT.GE.90.) BLAT=BLAT-GRID +C +C IF A FAST-PATH CYLINDRICAL EQUIDISTANT PROJECTION IS IN USE AND EITHER +C OR BOTH OF THE POLES IS WITHIN THE (RECTANGULAR) PERIMETER, ARRANGE +C FOR THE PARALLELS AT -90 AND/OR +90 TO BE DRAWN. +C + IF (IPRJ.EQ.10) THEN + CALL MAPTRN (-90.,PHIO,U,V) + IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX) + + SLAT=SLAT-GRID + CALL MAPTRN (90.,PHIO,U,V) + IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX) + + BLAT=BLAT+GRID + END IF +C +C DRAW THE PARALLELS. +C + XLAT=SLAT-GRID + 103 XLAT=XLAT+GRID + RLAT=AMAX1(-90.,AMIN1(90.,XLAT)) + RLON=FLOOR(SLON) + XLON=AMIN1(CLING(BLON),RLON+360.) + IF (IPF) THEN + DLON=.5*(XLON-RLON) + ELSE + DLON=(XLON-RLON)/CLING((XLON-RLON)/GRDR) + END IF + CALL MAPIT (RLAT,RLON,0) + 104 RLON=RLON+DLON + CALL MAPIT (RLAT,RLON,1) + IF (RLON.LT.XLON-.9999) GO TO 104 + IF (XLAT.LT.BLAT-.9999) GO TO 103 +C +C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN. +C + CALL MAPCHI (-2,0,0) +C +C DRAW THE LIMB LINES. +C + CALL MAPLMB +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPGTC (WHCH,CVAL) +C + CHARACTER*(*) WHCH,CVAL +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10) + CHARACTER*2 DDCT,LDCT,PDCT + COMMON /MAPCMB/ IIER + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTC','VERSION 1') +C + IF (WHCH(1:2).EQ.'AR') THEN + CVAL=LDCT(ILTS) + ELSE IF (WHCH(1:2).EQ.'OU') THEN + CVAL=DDCT(NOUT+1) + ELSE IF (WHCH(1:2).EQ.'PR') THEN + CVAL=PDCT(JPRJ) + IF (JPRJ.EQ.3.AND.ABS(SALT).GT.1.) CVAL=PDCT(10) + ELSE + GO TO 901 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=1 + CALL MAPCEM (' MAPGTC - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + CVAL=' ' + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPGTI (WHCH,IVAL) +C + CHARACTER*(*) WHCH +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER + COMMON /MAPNTS/ INTS(7) + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTI','VERSION 1') +C + IF (WHCH(1:2).EQ.'DA') THEN + IVAL=IDSH + ELSE IF (WHCH(1:2).EQ.'DD') THEN + IVAL=DDTS + ELSE IF (WHCH(1:2).EQ.'DL') THEN + IVAL=IDTL + ELSE IF (WHCH(1:2).EQ.'DO') THEN + IVAL=IDOT + ELSE IF (WHCH(1:2).EQ.'EL') THEN + IVAL=0 + IF (ELPF) IVAL=1 + ELSE IF (WHCH(1:2).EQ.'ER') THEN + IVAL=IIER + ELSE IF (WHCH(1:2).EQ.'GR') THEN + IVAL=GRID + ELSE IF (WHCH(1:2).EQ.'IN') THEN + IVAL=0 + IF (INTF) IVAL=1 + ELSE IF (WHCH(1:2).EQ.'I1') THEN + IVAL=INTS(1) + ELSE IF (WHCH(1:2).EQ.'I2') THEN + IVAL=INTS(2) + ELSE IF (WHCH(1:2).EQ.'I3') THEN + IVAL=INTS(3) + ELSE IF (WHCH(1:2).EQ.'I4') THEN + IVAL=INTS(4) + ELSE IF (WHCH(1:2).EQ.'I5') THEN + IVAL=INTS(5) + ELSE IF (WHCH(1:2).EQ.'I6') THEN + IVAL=INTS(6) + ELSE IF (WHCH(1:2).EQ.'I7') THEN + IVAL=INTS(7) + ELSE IF (WHCH(1:2).EQ.'LA') THEN + IVAL=0 + IF (LBLF) IVAL=1 + ELSE IF (WHCH(1:2).EQ.'LS') THEN + IVAL=ILCW + ELSE IF (WHCH(1:2).EQ.'MV') THEN + IVAL=DPLT + ELSE IF (WHCH(1:2).EQ.'PE') THEN + IVAL=0 + IF (PRMF) IVAL=1 + ELSE IF (WHCH(1:2).EQ.'PN') THEN + IVAL=PHIO + ELSE IF (WHCH(1:2).EQ.'PT') THEN + IVAL=PHIA + ELSE IF (WHCH(1:2).EQ.'P1') THEN + IVAL=PLA1 + ELSE IF (WHCH(1:2).EQ.'P2') THEN + IVAL=PLA2 + ELSE IF (WHCH(1:2).EQ.'P3') THEN + IVAL=PLA3 + ELSE IF (WHCH(1:2).EQ.'P4') THEN + IVAL=PLA4 + ELSE IF (WHCH(1:2).EQ.'P5') THEN + IVAL=PLB1 + ELSE IF (WHCH(1:2).EQ.'P6') THEN + IVAL=PLB2 + ELSE IF (WHCH(1:2).EQ.'P7') THEN + IVAL=PLB3 + ELSE IF (WHCH(1:2).EQ.'P8') THEN + IVAL=PLB4 + ELSE IF (WHCH(1:2).EQ.'RE') THEN + IVAL=PLTR + ELSE IF (WHCH(1:2).EQ.'RO') THEN + IVAL=ROTA + ELSE IF (WHCH(1:2).EQ.'SA') THEN + IVAL=SALT + ELSE IF (WHCH(1:2).EQ.'S1') THEN + IVAL=ALFA + ELSE IF (WHCH(1:2).EQ.'S2') THEN + IVAL=BETA + ELSE + GO TO 901 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=2 + CALL MAPCEM (' MAPGTI - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + IVAL=0 + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPGTL (WHCH,LVAL) +C + CHARACTER*(*) WHCH + LOGICAL LVAL +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMB/ IIER +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTL','VERSION 1') +C + IF (WHCH(1:2).EQ.'DL') THEN + LVAL=IDTL.NE.0 + ELSE IF (WHCH(1:2).EQ.'DO') THEN + LVAL=IDOT.NE.0 + ELSE IF (WHCH(1:2).EQ.'EL') THEN + LVAL=ELPF + ELSE IF (WHCH(1:2).EQ.'IN') THEN + LVAL=INTF + ELSE IF (WHCH(1:2).EQ.'LA') THEN + LVAL=LBLF + ELSE IF (WHCH(1:2).EQ.'PE') THEN + LVAL=PRMF + ELSE + GO TO 901 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=3 + CALL MAPCEM (' MAPGTL - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + LVAL=.FALSE. + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPGTR (WHCH,RVAL) +C + CHARACTER*(*) WHCH +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTR','VERSION 1') +C + IF (WHCH(1:2).EQ.'DD') THEN + RVAL=DDTS + ELSE IF (WHCH(1:2).EQ.'GD') THEN + RVAL=GRDR + ELSE IF (WHCH(1:2).EQ.'GR') THEN + RVAL=GRID + ELSE IF (WHCH(1:2).EQ.'MV') THEN + RVAL=DPLT + ELSE IF (WHCH(1:2).EQ.'PN') THEN + RVAL=PHIO + ELSE IF (WHCH(1:2).EQ.'PT') THEN + RVAL=PHIA + ELSE IF (WHCH(1:2).EQ.'P1') THEN + RVAL=PLA1 + ELSE IF (WHCH(1:2).EQ.'P2') THEN + RVAL=PLA2 + ELSE IF (WHCH(1:2).EQ.'P3') THEN + RVAL=PLA3 + ELSE IF (WHCH(1:2).EQ.'P4') THEN + RVAL=PLA4 + ELSE IF (WHCH(1:2).EQ.'P5') THEN + RVAL=PLB1 + ELSE IF (WHCH(1:2).EQ.'P6') THEN + RVAL=PLB2 + ELSE IF (WHCH(1:2).EQ.'P7') THEN + RVAL=PLB3 + ELSE IF (WHCH(1:2).EQ.'P8') THEN + RVAL=PLB4 + ELSE IF (WHCH(1:2).EQ.'RE') THEN + RVAL=PLTR + ELSE IF (WHCH(1:2).EQ.'RO') THEN + RVAL=ROTA + ELSE IF (WHCH(1:2).EQ.'SA') THEN + RVAL=SALT + ELSE IF (WHCH(1:2).EQ.'S1') THEN + RVAL=ALFA + ELSE IF (WHCH(1:2).EQ.'S2') THEN + RVAL=BETA + ELSE IF (WHCH(1:2).EQ.'SR') THEN + RVAL=SRCH + ELSE IF (WHCH(1:2).EQ.'XL') THEN + RVAL=XLOW + ELSE IF (WHCH(1:2).EQ.'XR') THEN + RVAL=XROW + ELSE IF (WHCH(1:2).EQ.'YB') THEN + RVAL=YBOW + ELSE IF (WHCH(1:2).EQ.'YT') THEN + RVAL=YTOW + ELSE + GO TO 901 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=4 + CALL MAPCEM (' MAPGTR - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + RVAL=0. + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPINT +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C SET UP ALTERNATE NAMES FOR SOME OF THE VARIABLES IN COMMON. +C + EQUIVALENCE (PHIA,FLT1),(ROTA,FLT2) +C + EQUIVALENCE (PLA1,AUMN),(PLA2,AUMX), + + (PLA3,AVMN),(PLA4,AVMX) +C +C ENSURE THAT THE BLOCK DATA ROUTINE WILL LOAD, SO THAT VARIABLES WILL +C HAVE THE PROPER DEFAULT VALUES. +C + EXTERNAL MAPBD +C +C DEFINE THE NECESSARY CONSTANTS. +C + DATA RESL / 10. / + DATA DTOR / .017453292519943 / + DATA OV90 / .011111111111111 / + DATA PI / 3.14159265358979 / + DATA RTOD / 57.2957795130823 / +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPINT','VERSION 1') +C +C CHECK FOR AN ERROR IN THE PROJECTION SPECIFIER. +C + IF (JPRJ.LE.0.OR.JPRJ.GE.10) GO TO 901 +C +C IPRJ EQUALS JPRJ UNTIL WE FIND OUT IF FAST-PATH PROJECTIONS ARE TO BE +C USED. PHOC IS JUST A COPY OF PHIO. +C + IPRJ=JPRJ + PHOC=PHIO +C + IF (IPRJ.EQ.1) THEN +C +C COMPUTE CONSTANTS FOR THE LAMBERT CONFORMAL CONIC. +C + SINO=SIGN(1.,.5*(FLT1+FLT2)) + CHI1=(90.-SINO*FLT1)*DTOR + IF (FLT1.EQ.FLT2) THEN + COSO=COS(CHI1) + ELSE + CHI2=(90.-SINO*FLT2)*DTOR + COSO=ALOG(SIN(CHI1)/SIN(CHI2))/ALOG(TAN(.5*CHI1)/TAN(.5*CHI2)) + END IF +C + ELSE +C +C COMPUTE CONSTANTS REQUIRED FOR ALL THE OTHER PROJECTIONS. +C + TMP1=ROTA*DTOR + TMP2=PHIA*DTOR + SINR=SIN(TMP1) + COSR=COS(TMP1) + SINO=SIN(TMP2) + COSO=COS(TMP2) +C +C COMPUTE CONSTANTS REQUIRED ONLY BY THE CYLINDRICAL PROJECTIONS. +C + IF (IPRJ.GE.7) THEN +C +C SEE IF FAST-PATH TRANSFORMATIONS CAN BE USED. (PLAT = 0 AND ROTA = 0 +C OR 180.) +C + IF (ABS(PHIA).GE..0001.OR.(ABS(ROTA).GE..0001.AND. + + ABS(ROTA).LE.179.9999)) THEN +C +C NO. COMPUTE CONSTANTS FOR THE ORDINARY CYLINDRICAL PROJECTIONS. +C + SINT=COSO*COSR + COST=SQRT(1.-(SINT)**2) + TMP1=SINR/COST + TMP2=SINO/COST + PHIO=PHIO-ATAN2(TMP1,-COSR*TMP2)*RTOD + PHOC=PHIO + SINR=TMP1*COSO + COSR=-TMP2 + SINO=SINT + COSO=COST +C + ELSE +C +C YES. THE FAST PATHS ARE IMPLEMENTED AS THREE ADDITIONAL PROJECTIONS. +C + IPRJ=IPRJ+3 +C + IF (ABS(ROTA).LT..0001) THEN + SINO=1. + ELSE + SINO=-1. + PHIO=PHIO+180. + PHOC=PHIO + END IF +C + COSO=0. + SINR=0. + COSR=1. +C + END IF +C + END IF +C + END IF +C +C NOW, SET UMIN, UMAX, VMIN, AND VMAX TO CORRESPOND TO THE MAXIMUM +C USEFUL AREA PRODUCED BY THE PROJECTION. +C + GO TO (101,102,101,102,102,103,104,103,105,104,103,105) , IPRJ +C +C LAMBERT CONFORMAL CONIC AND ORTHOGRAPHIC. +C + 101 IF (IPRJ.NE.3.OR.ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN + UMIN=-1. + UMAX=1. + VMIN=-1. + VMAX=1. + ELSE + TMP1=SALT*SALT*CALF*CALF-1. + TMP2=CALF*SQRT(SALT*SALT*(1.-SALF*SALF*SBET*SBET)-1.) + UMIN=SRSS*(-SALF*CBET-TMP2)/TMP1 + UMAX=SRSS*(-SALF*CBET+TMP2)/TMP1 + TMP2=CALF*SQRT(SALT*SALT*(1.-SALF*SALF*CBET*CBET)-1.) + VMIN=SRSS*(-SALF*SBET-TMP2)/TMP1 + VMAX=SRSS*(-SALF*SBET+TMP2)/TMP1 + END IF +C + GO TO 106 +C +C STEREOGRAPHIC, LAMBERT EQUAL AREA, AND GNOMONIC. +C + 102 UMIN=-2. + UMAX=2. + VMIN=-2. + VMAX=2. + GO TO 106 +C +C AZIMUTHAL EQUIDISTANT AND MERCATOR. +C + 103 UMIN=-PI + UMAX=PI + VMIN=-PI + VMAX=PI + GO TO 106 +C +C CYLINDRICAL EQUIDISTANT. +C + 104 UMIN=-180. + UMAX=180. + VMIN=-90. + VMAX=90. + GO TO 106 +C +C MOLLWEIDE. +C + 105 UMIN=-2. + UMAX=2. + VMIN=-1. + VMAX=1. +C +C COMPUTE THE QUANTITIES USED BY MAPIT IN CHECKING FOR CROSS-OVER. +C + 106 UEPS=.75*(UMAX-UMIN) + VEPS=.75*(VMAX-VMIN) +C +C AS ALWAYS, THE CONICAL PROJECTION IS THE ODDBALL. CROSS-OVER IS NOT +C DETECTED IN U AND V, BUT IN LONGITUDE, SO THE VALUE HAS TO BE SET +C DIFFERENTLY. +C + IF (IPRJ.EQ.1) UEPS=180. +C +C NOW, JUMP TO THE APPROPRIATE LIMIT-SETTING CODE. +C + GO TO (600,200,300,400,500) , ILTS +C +C ILTS=2 POINTS (PL1,PL2) AND (PL3,PL4) ARE ON OPPOSITE CORNERS +C ------ OF THE PLOT. +C + 200 E=0. + 201 CALL MAPTRN (PLA1,PLA2+E,TMP1,TMP3) + CALL MAPTRN (PLA3,PLA4-E,TMP2,TMP4) + IF (IPRJ.GE.7.AND.TMP1.GE.TMP2.AND.E.EQ.0.) THEN + E=.0001 + GO TO 201 + END IF + UMIN=AMIN1(TMP1,TMP2) + UMAX=AMAX1(TMP1,TMP2) + VMIN=AMIN1(TMP3,TMP4) + VMAX=AMAX1(TMP3,TMP4) + IF (UMAX.GE.1.E12) GO TO 904 + GO TO 600 +C +C ILTS=3 FOUR EDGE POINTS ARE GIVEN. +C ------ +C + 300 E=0. + 301 CALL MAPTRN (PLA1,PLB1+E,TMP1,TMP5) + CALL MAPTRN (PLA2,PLB2-E,TMP2,TMP6) + IF (IPRJ.GE.7.AND.TMP1.GE.TMP2.AND.E.EQ.0.) THEN + E=.0001 + GO TO 301 + END IF + CALL MAPTRN (PLA3,PLB3,TMP3,TMP7) + CALL MAPTRN (PLA4,PLB4,TMP4,TMP8) + UMIN=AMIN1(TMP1,TMP2,TMP3,TMP4) + UMAX=AMAX1(TMP1,TMP2,TMP3,TMP4) + VMIN=AMIN1(TMP5,TMP6,TMP7,TMP8) + VMAX=AMAX1(TMP5,TMP6,TMP7,TMP8) + IF (UMAX.GE.1.E12) GO TO 904 + GO TO 600 +C +C ILTS=4 ANGULAR DISTANCES ARE GIVEN. +C ------ +C + 400 CUMI=COS(AUMN*DTOR) + SUMI=SIN(AUMN*DTOR) + CUMA=COS(AUMX*DTOR) + SUMA=SIN(AUMX*DTOR) + CVMI=COS(AVMN*DTOR) + SVMI=SIN(AVMN*DTOR) + CVMA=COS(AVMX*DTOR) + SVMA=SIN(AVMX*DTOR) +C + GO TO (904,401,402,403,404,405,406,407,408,406,407,408) , IPRJ +C +C STEREOGRAPHIC. +C + 401 IF (SUMI.LT..0001) THEN + IF (CUMI.GT.0.) UMIN=0. + ELSE + UMIN=-(1.-CUMI)/SUMI + END IF + IF (SUMA.LT..0001) THEN + IF (CUMA.GT.0.) UMAX=0. + ELSE + UMAX=(1.-CUMA)/SUMA + END IF + IF (SVMI.LT..0001) THEN + IF (CVMI.GT.0.) VMIN=0. + ELSE + VMIN=-(1.-CVMI)/SVMI + END IF + IF (SVMA.LT..0001) THEN + IF (CVMA.GT.0.) VMAX=0. + ELSE + VMAX=(1.-CVMA)/SVMA + END IF + GO TO 600 +C +C ORTHOGRAPHIC. +C + 402 IF (ABS(SALT).LE.1.) THEN + IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GT.90.) GO TO 902 + UMIN=-SUMI + UMAX=SUMA + VMIN=-SVMI + VMAX=SVMA + ELSE + IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GE.90.) GO TO 902 + UTMP=SRSS*SALF/CALF + VTMP=0. + UCEN=UTMP*CBET-VTMP*SBET + VCEN=VTMP*CBET+UTMP*SBET + UMIN=UCEN-SRSS*CALF*SUMI/CUMI + UMAX=UCEN+SRSS*CALF*SUMA/CUMA + VMIN=VCEN-SRSS*CALF*SVMI/CVMI + VMAX=VCEN+SRSS*CALF*SVMA/CVMA + END IF + GO TO 600 +C +C LAMBERT EQUAL AREA. +C + 403 IF (SUMI.LT..0001) THEN + IF (CUMI.GT.0.) UMIN=0. + ELSE + UMIN=-2./SQRT(1.+((1.+CUMI)/SUMI)**2) + END IF + IF (SUMA.LT..0001) THEN + IF (CUMA.GT.0.) UMAX=0. + ELSE + UMAX=2./SQRT(1.+((1.+CUMA)/SUMA)**2) + END IF + IF (SVMI.LT..0001) THEN + IF (CVMI.GT.0.) VMIN=0. + ELSE + VMIN=-2./SQRT(1.+((1.+CVMI)/SVMI)**2) + END IF + IF (SVMA.LT..0001) THEN + IF (CVMA.GT.0.) VMAX=0. + ELSE + VMAX=2./SQRT(1.+((1.+CVMA)/SVMA)**2) + END IF + GO TO 600 +C +C GNOMONIC. +C + 404 IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GE.89.9999) GO TO 902 + UMIN=-SUMI/CUMI + UMAX=SUMA/CUMA + VMIN=-SVMI/CVMI + VMAX=SVMA/CVMA + GO TO 600 +C +C AZIMUTHAL EQUIDISTANT. +C + 405 UMIN=-AUMN*DTOR + UMAX=AUMX*DTOR + VMIN=-AVMN*DTOR + VMAX=AVMX*DTOR + GO TO 600 +C +C CYLINDRICAL EQUIDISTANT. +C + 406 UMIN=-AUMN + UMAX=AUMX + VMIN=-AVMN + VMAX=AVMX + GO TO 600 +C +C MERCATOR. +C + 407 IF (AMAX1(AVMN,AVMX).GE.89.9999) GO TO 902 + UMIN=-AUMN*DTOR + UMAX=AUMX*DTOR + VMIN=-ALOG((1.+SVMI)/CVMI) + VMAX=ALOG((1.+SVMA)/CVMA) + GO TO 600 +C +C MOLLWEIDE. +C + 408 UMIN=-AUMN*OV90 + UMAX=AUMX*OV90 + VMIN=-SVMI + VMAX=SVMA + GO TO 600 +C +C ILTS=5 VALUES IN THE U/V PLANE ARE GIVEN. +C ------ +C + 500 UMIN=PLA1 + UMAX=PLA2 + VMIN=PLA3 + VMAX=PLA4 +C +C COMPUTE THE WIDTH AND HEIGHT OF THE PLOT. +C + 600 DU=UMAX-UMIN + DV=VMAX-VMIN +C +C ERROR IF MAP HAS ZERO AREA. +C + IF (DU.LE.0..OR.DV.LE.0.) GO TO 903 +C +C POSITION THE MAP ON THE PLOTTER FRAME. +C + IF (DU/DV.LT.(XROW-XLOW)/(YTOW-YBOW)) THEN + ULOW=.5*(XLOW+XROW)-.5*(DU/DV)*(YTOW-YBOW) + UROW=.5*(XLOW+XROW)+.5*(DU/DV)*(YTOW-YBOW) + VBOW=YBOW + VTOW=YTOW + ELSE + ULOW=XLOW + UROW=XROW + VBOW=.5*(YBOW+YTOW)-.5*(DV/DU)*(XROW-XLOW) + VTOW=.5*(YBOW+YTOW)+.5*(DV/DU)*(XROW-XLOW) + END IF +C +C ERROR IF MAP HAS ESSENTIALLY ZERO AREA. +C + IF (AMIN1(UROW-ULOW,VTOW-VBOW)*PLTR.LT.RESL) GO TO 903 +C +C DO THE REQUIRED SET CALL. +C + CALL SET (ULOW,UROW,VBOW,VTOW,UMIN,UMAX,VMIN,VMAX,1) +C +C COMPUTE THE QUANTITIES USED BY MAPIT TO SEE IF POINTS ARE FAR ENOUGH +C APART TO DRAW THE LINE BETWEEN THEM AND THE QUANTITIES USED BY MAPVP +C TO DETERMINE THE NUMBER OF DOTS TO INTERPOLATE BETWEEN TWO POINTS. +C + DSCA=(UROW-ULOW)*PLTR/DU + DPSQ=DPLT*DPLT + DSSQ=DSCA*DSCA + DBTD=DDTS/DSCA +C +C SET PARAMETERS REQUIRED IF AN ELLIPTICAL PERIMETER IS BEING USED. THE +C ELLIPSE IS MADE TO BE JUST A LITTLE BIGGER THAN AN INSCRIBED ELLIPSE +C SO AS TO AVOID ROUND-OFF PROBLEMS WHEN DRAWING THE LIMB OF CERTAIN +C PROJECTIONS. +C + UCEN=.5*(UMIN+UMAX) + VCEN=.5*(VMIN+VMAX) + URNG=.50005*(UMAX-UMIN) + VRNG=.50005*(VMAX-VMIN) +C +C NOW, COMPUTE THE LATITUDE/LONGITUDE LIMITS WHICH WILL BE REQUIRED BY +C MAPGRD AND MAPLOT, IF ANY. +C + IF (GRID.GT.0..OR.NOUT.NE.0) THEN +C +C AT FIRST, ASSUME THE WHOLE GLOBE WILL BE PROJECTED. +C + SLAM=-90. + BLAM=+90. + SLOM=PHIO-180. + BLOM=PHIO+180. +C +C JUMP IF IT'S OBVIOUS THAT REALLY IS THE CASE. +C + IF (ILTS.EQ.1.AND.(JPRJ.EQ.4.OR.JPRJ.EQ.6.OR.JPRJ.EQ.7.OR. + + JPRJ.EQ.9)) GO TO 700 +C +C OTHERWISE, THE WHOLE GLOBE IS NOT BEING PROJECTED. THE FIRST THING +C TO DO IS TO FIND A POINT (CLAT,CLON) WHOSE PROJECTION IS KNOWN TO BE +C ON THE MAP. FIRST, TRY THE POLE OF THE PROJECTION. +C + CLAT=PHIA + CLON=PHIO + CALL MAPTRN (CLAT,CLON,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX).OR. + + (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) + + GO TO 611 +C +C IF THAT DIDN'T WORK, TRY A POINT BASED ON THE LIMITS SPECIFIER. +C + IF (ILTS.EQ.2) THEN + CLAT=.5*(PLA1+PLA3) + CLON=.5*(PLA2+PLA4) + ELSE IF (ILTS.EQ.3) THEN + TMP1=AMIN1(PLA1,PLA2,PLA3,PLA4) + TMP2=AMAX1(PLA1,PLA2,PLA3,PLA4) + TMP3=AMIN1(PLB1,PLB2,PLB3,PLB4) + TMP4=AMAX1(PLB1,PLB2,PLB3,PLB4) + CLAT=.5*(TMP1+TMP2) + CLON=.5*(TMP3+TMP4) + ELSE + GO TO 700 + END IF + CALL MAPTRN (CLAT,CLON,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX).OR. + + (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) + + GO TO 611 + GO TO 700 +C +C ONCE WE HAVE THE LATITUDES AND LONGITUDES OF A POINT ON THE MAP, WE +C FIND THE MINIMUM AND MAXIMUM LATITUDE AND THE MINIMUM AND MAXIMUM +C LONGITUDE BY RUNNING A SEARCH POINT ABOUT ON A FINE LAT/LON GRID. +C +C FIND THE MINIMUM LATITUDE. +C + 611 RLAT=CLAT + RLON=CLON + DLON=SRCH + 612 RLAT=RLAT-SRCH + IF (RLAT.LE.-90.) GO TO 621 + 613 CALL MAPTRN (RLAT,RLON,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX).OR. + + (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN + DLON=SRCH + GO TO 612 + END IF + RLON=RLON+DLON + DLON=SIGN(ABS(DLON)+SRCH,-DLON) + IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 613 + RLON=RLON+DLON + DLON=SIGN(ABS(DLON)+SRCH,-DLON) + IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 613 + SLAM=RLAT +C +C FIND THE MAXIMUM LATITUDE. +C + 621 RLAT=CLAT + RLON=CLON + DLON=SRCH + 622 RLAT=RLAT+SRCH + IF (RLAT.GT.90.) GO TO 631 + 623 CALL MAPTRN (RLAT,RLON,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX).OR. + + (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN + DLON=SRCH + GO TO 622 + END IF + RLON=RLON+DLON + DLON=SIGN(ABS(DLON)+SRCH,-DLON) + IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 623 + RLON=RLON+DLON + DLON=SIGN(ABS(DLON)+SRCH,-DLON) + IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 623 + BLAM=RLAT +C +C FIND THE MINIMUM LONGITUDE. +C + 631 RLAT=CLAT + RLON=CLON + DLAT=SRCH + 632 RLON=RLON-SRCH + IF (RLON.LE.CLON-360.) GO TO 651 + 633 CALL MAPTRN (RLAT,RLON,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX).OR. + + (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN + DLAT=SRCH + GO TO 632 + END IF + RLAT=RLAT+DLAT + DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT) + IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 633 + RLAT=RLAT+DLAT + DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT) + IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 633 + SLOM=RLON-SIGN(180.,RLON+180.)+SIGN(180.,180.-RLON) +C +C FIND THE MAXIMUM LONGITUDE. +C + 641 RLAT=CLAT + RLON=CLON + DLAT=SRCH + 642 RLON=RLON+SRCH + IF (RLON.GE.CLON+360.) GO TO 651 + 643 CALL MAPTRN (RLAT,RLON,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX).OR. + + (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN + DLAT=SRCH + GO TO 642 + END IF + RLAT=RLAT+DLAT + DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT) + IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 643 + RLAT=RLAT+DLAT + DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT) + IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 643 + BLOM=RLON-SIGN(180.,RLON+180.)+SIGN(180.,180.-RLON) + IF (BLOM.LE.SLOM) BLOM=BLOM+360. + GO TO 700 +C + 651 SLOM=PHIO-180. + BLOM=PHIO+180. +C + END IF +C +C ZERO THE ERROR FLAG AND TURN OFF THE INITIALIZATION-REQUIRED FLAG. +C + 700 IIER=0 + INTF=.FALSE. +C +C DONE. +C + RETURN +C +C ERROR RETURNS. +C + 901 IIER=5 + CALL SETER (' MAPINT - ATTEMPT TO USE NON-EXISTENT PROJECTION', + 1 IIER,1) + RETURN +C + 902 IIER=6 + CALL SETER (' MAPINT - ANGULAR LIMITS TOO GREAT',IIER,1) + RETURN +C + 903 IIER=7 + CALL SETER (' MAPINT - MAP HAS ZERO AREA',IIER,1) + RETURN +C + 904 IIER=8 + CALL SETER (' MAPINT - MAP LIMITS INAPPROPIATE',IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPIT (RLAT,RLON,IFST) +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM8/ P,Q,R + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL +C + DIMENSION CPRJ(3) +C + SAVE IVSO,POLD,QOLD,UOLD,VOLD +C + DATA CPRJ / 360.,6.28318530717959,4. / +C + DATA IVSO,POLD,QOLD,UOLD,VOLD / 0,0.,0.,0.,0. / +C +C PROJECT THE POINT (RLAT,RLON) TO (U,V). +C + CALL MAPTRN (RLAT,RLON,U,V) +C +C FOR THE SAKE OF EFFICIENCY, EXECUTE ONE OF TWO PARALLEL ALGORITHMS, +C DEPENDING ON WHETHER AN ELLIPTICAL OR A RECTANGULAR PERIMETER IS IN +C USE. (THAT WAY, WE TEST ELPF ONLY ONCE.) +C + IF (ELPF) THEN +C +C ELLIPTICAL - ASSUME THE NEW POINT IS VISIBLE UNTIL WE FIND OTHERWISE. +C + IVIS=1 +C +C SEE IF THE NEW POINT IS INVISIBLE. +C + IF (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.) THEN +C +C THE NEW POINT IS INVISIBLE. RESET THE VISIBILITY FLAG. +C + IVIS=0 +C +C IF THE NEW POINT IS A "FIRST POINT" OR IF THE LAST POINT WAS NOT +C VISIBLE OR IF THE NEW POINT IS INVISIBLE BECAUSE ITS PROJECTION IS +C UNDEFINED, DRAW NOTHING. THE POSSIBLE EXISTENCE OF A VISIBLE SEGMENT +C ALONG THE LINE JOINING TWO INVISIBLE POINTS IS INTENTIONALLY IGNORED, +C FOR REASONS OF EFFICIENCY. FOR THIS REASON, OBJECTS SHOULD NOT BE +C DRAWN USING LONG LINE SEGMENTS. +C + IF (IFST.EQ.0.OR.IVSO.EQ.0.OR.U.GE.1.E12) GO TO 108 +C +C OTHERWISE, THE NEW POINT IS NOT A "FIRST POINT", THE LAST POINT WAS +C VISIBLE, AND THE PROJECTION OF THE NEW POINT IS DEFINED, SO WE NEED +C TO CONTINUE THE LINE. FIRST, IF THERE'S A CROSS-OVER PROBLEM, MOVE +C THE NEW POINT TO ITS ALTERNATE POSITION. THIS MAY MAKE IT VISIBLE. +C + IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) THEN +C + IF (JPRJ.GE.7) THEN + P=P-SIGN(CPRJ(JPRJ-6),P) + U=P + IF (JPRJ.EQ.9) U=U*SQRT(1.-V*V) + ELSE + GO TO 108 + END IF +C + IF (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.) THEN + IVIS=1 + GO TO 107 + END IF +C + END IF +C +C IF IT'S STILL INVISIBLE, INTERPOLATE TO THE EDGE OF THE FRAME, EXTEND +C THE LINE TO THAT POINT, AND QUIT. +C + CALL MAPTRE (UOLD,VOLD,U,V,UINT,VINT) + CALL MAPVP (UOLD,VOLD,UINT,VINT) + GO TO 108 +C + END IF +C +C THE NEW POINT IS VISIBLE. IF IT'S THE FIRST POINT OF A LINE, GO START +C A NEW LINE. +C + IF (IFST.EQ.0.OR.UOLD.GE.1.E12) GO TO 106 +C +C THE NEW POINT IS VISIBLE, BUT IT'S NOT THE FIRST POINT OF A LINE. +C CHECK FOR CROSS-OVER PROBLEMS. +C + IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) GO TO 101 +C +C THE NEW POINT IS VISIBLE, IT'S NOT THE FIRST POINT OF A LINE, AND +C THERE ARE NO CROSS-OVER PROBLEMS. IF THE OLD POINT WAS INVISIBLE, +C JUMP TO DRAW THE VISIBLE PORTION OF THE LINE FROM THE OLD POINT TO +C THE NEW ONE. +C + IF (IVSO.EQ.0) GO TO 102 +C +C THE NEW POINT IS VISIBLE, IT'S NOT THE FIRST POINT OF A LINE, THERE +C ARE NO CROSS-OVER PROBLEMS, AND THE LAST POINT WAS VISIBLE. JUMP TO +C JUST CONTINUE THE LINE. +C + GO TO 107 +C +C WE HAVE THE MOST DIFFICULT CASE. THE NEW POINT IS VISIBLE, IT'S NOT +C THE FIRST POINT OF A LINE, AND THERE IS A CROSS-OVER PROBLEM. NONE, +C ONE, OR TWO SEGMENTS MAY NEED TO BE DRAWN. +C + 101 IF (JPRJ.LT.7) GO TO 106 +C +C IF THE OLD POINT WAS VISIBLE, GENERATE THE ALTERNATE PROJECTION OF THE +C NEW POINT AND DRAW THE VISIBLE PORTION OF THE LINE SEGMENT JOINING THE +C OLD POINT TO THE ALTERNATE PROJECTION POINT. +C + IF (IVSO.NE.0) THEN +C + UTMP=P-SIGN(CPRJ(JPRJ-6),P) + VTMP=Q + IF (JPRJ.EQ.9) UTMP=UTMP*SQRT(1.-VTMP*VTMP) +C + IF (((UTMP-UCEN)/URNG)**2+((VTMP-VCEN)/VRNG)**2.GT.1.) THEN + CALL MAPTRE (UOLD,VOLD,UTMP,VTMP,UTMP,VTMP) + END IF +C + CALL MAPVP (UOLD,VOLD,UTMP,VTMP) +C + END IF +C +C NOW GENERATE AN ALTERNATE PROJECTION OF THE OLD POINT CLOSE TO THE NEW +C ONE AND DRAW THE VISIBLE PORTION OF THE LINE SEGMENT JOINING IT TO THE +C NEW POINT. +C + UOLD=POLD-SIGN(CPRJ(JPRJ-6),POLD) + IF (JPRJ.EQ.9) UOLD=UOLD*SQRT(1.-VOLD*VOLD) +C + IF (((UOLD-UCEN)/URNG)**2+((VOLD-VCEN)/VRNG)**2.LE.1.) GO TO 105 +C +C MOVE (UOLD,VOLD) BY INTERPOLATING TO THE EDGE OF THE FRAME. +C + 102 CALL MAPTRE (U,V,UOLD,VOLD,UOLD,VOLD) +C + ELSE +C +C RECTANGULAR - REPEAT THE ABOVE CODE, CHANGING THE TESTS FOR A POINT'S +C BEING INSIDE/OUTSIDE THE PERIMETER. COMMENTING WILL BE ABBREVIATED. +C + IVIS=1 +C + IF (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX) THEN +C + IVIS=0 +C + IF (IFST.EQ.0.OR.IVSO.EQ.0.OR.U.GE.1.E12) GO TO 108 +C + IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) THEN +C + IF (JPRJ.GE.7) THEN + P=P-SIGN(CPRJ(JPRJ-6),P) + U=P + IF (JPRJ.EQ.9) U=U*SQRT(1.-V*V) + ELSE + GO TO 108 + END IF +C + IF (U.GE.UMIN.AND.U.LE.UMAX.AND. + + V.GE.VMIN.AND.V.LE.VMAX) THEN + IVIS=1 + GO TO 107 + END IF + END IF +C + CALL MAPTRP (UOLD,VOLD,U,V,UINT,VINT) + CALL MAPVP (UOLD,VOLD,UINT,VINT) + GO TO 108 +C + END IF +C + IF (IFST.EQ.0.OR.UOLD.GE.1.E12) GO TO 106 +C + IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) GO TO 103 +C + IF (IVSO.EQ.0) GO TO 104 +C + GO TO 107 +C + 103 IF (JPRJ.LT.7) GO TO 106 +C + IF (IVSO.NE.0) THEN +C + UTMP=P-SIGN(CPRJ(JPRJ-6),P) + VTMP=Q + IF (JPRJ.EQ.9) UTMP=UTMP*SQRT(1.-VTMP*VTMP) +C + IF (UTMP.LT.UMIN.OR.UTMP.GT.UMAX.OR. + + VTMP.LT.VMIN.OR.VTMP.GT.VMAX) THEN + CALL MAPTRP (UOLD,VOLD,UTMP,VTMP,UTMP,VTMP) + END IF +C + CALL MAPVP (UOLD,VOLD,UTMP,VTMP) + END IF +C + UOLD=POLD-SIGN(CPRJ(JPRJ-6),POLD) + IF (JPRJ.EQ.9) UOLD=UOLD*SQRT(1.-VOLD*VOLD) +C + IF (UOLD.GE.UMIN.AND.UOLD.LE.UMAX.AND. + + VOLD.GE.VMIN.AND.VOLD.LE.VMAX) GO TO 105 +C + 104 CALL MAPTRP (U,V,UOLD,VOLD,UOLD,VOLD) +C + END IF +C +C DRAW THE VISIBLE PORTION OF THE LINE JOINING THE OLD POINT TO THE NEW. +C + 105 IF (IDTL.EQ.0) THEN + CALL FRSTD (UOLD,VOLD) + DATL=0. + END IF +C + CALL MAPVP (UOLD,VOLD,U,V) +C + GO TO 108 +C +C START A NEW LINE. +C + 106 IF (IDTL.EQ.0) THEN + CALL FRSTD (U,V) + DATL=0. + END IF +C + GO TO 108 +C +C CONTINUE THE LINE. +C + 107 IF (IFST.LT.2.AND.((U-UOLD)**2+(V-VOLD)**2)*DSSQ.LE.DPSQ) RETURN + CALL MAPVP (UOLD,VOLD,U,V) +C +C SAVE INFORMATION ABOUT THE CURRENT POINT FOR THE NEXT CALL AND QUIT. +C + 108 IVSO=IVIS + POLD=P + QOLD=Q + UOLD=U + VOLD=V +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPIQ +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50) +C +C FLUSH THE POINTS BUFFER. +C + IF (NPTB.GT.0) THEN + CALL POINTS (XPTB,YPTB,NPTB,0,0) + NPTB=0 + END IF +C +C FLUSH PLOTIT'S BUFFER, TOO. +C + CALL PLOTIT (0,0,0) +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPLBL +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER +C +C DEFINE REQUIRED CONSTANTS. SIN1 AND COS1 ARE RESPECTIVELY THE SINE +C AND COSINE OF ONE DEGREE. +C + DATA SIN1 / .017452406437283 / + DATA COS1 / .999847695156390 / +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPLBL','VERSION 1') +C +C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE +C LAST INITIALIZATION, DO NOTHING. +C + IF (INTF) RETURN + IF (IIER.NE.0) RETURN +C +C IF REQUESTED, LETTER KEY MERIDIANS AND POLES. +C + IF (LBLF) THEN +C +C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR LABELLING. +C + CALL MAPCHI (3,1,0) +C +C FIRST, THE NORTH POLE. +C + CALL MAPTRN (90.,0.,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX) + + .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) + + CALL WTSTR (U,V,'NP',ILCW,0,0) +C +C THEN, THE SOUTH POLE. +C + CALL MAPTRN (-90.,0.,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX) + + .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) + + CALL WTSTR (U,V,'SP',ILCW,0,0) +C +C THE EQUATOR. +C + RLON=PHIO-10. + DO 101 I=1,36 + RLON=RLON+10. + CALL MAPTRN (0.,RLON,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX) + + .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) + + GO TO 102 + 101 CONTINUE + GO TO 103 + 102 CALL WTSTR (U,V,'EQ',ILCW,0,0) +C +C THE GREENWICH MERIDIAN. +C + 103 RLAT=85. + DO 104 I=1,16 + RLAT=RLAT-10. + CALL MAPTRN (RLAT,0.,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX) + + .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) + + GO TO 105 + 104 CONTINUE + GO TO 106 + 105 CALL WTSTR (U,V,'GM',ILCW,0,0) +C +C INTERNATIONAL DATE LINE. +C + 106 RLAT=85. + DO 107 I=1,16 + RLAT=RLAT-10. + CALL MAPTRN (RLAT,180.,U,V) + IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN + + .AND.V.LE.VMAX) + + .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) + + GO TO 108 + 107 CONTINUE + GO TO 109 + 108 CALL WTSTR (U,V,'ID',ILCW,0,0) +C +C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN. +C + 109 CALL MAPCHI (-3,0,0) +C + END IF +C +C DRAW PERIMETER, IF REQUESTED. +C + IF (PRMF) THEN +C +C RESET THE LINE INTENSITY, DOTTING, AND DASH PATTERN FOR THE PERIMETER. +C + CALL MAPCHI (1,0,IOR(ISHIFT(32767,1),1)) +C +C THE PERIMETER IS EITHER AN ELLIPSE OR A RECTANGLE, DEPENDING ON ELPF. +C + IF (ELPF) THEN + U=.9999*URNG + V=0. + DATL=0. + CALL FRSTD (UCEN+U,VCEN) + DO 110 I=1,360 + UOLD=U + VOLD=V + U=COS1*UOLD-SIN1*VOLD + V=SIN1*UOLD+COS1*VOLD + CALL MAPVP (UCEN+UOLD,VCEN+VOLD*VRNG/URNG, + + UCEN+U ,VCEN+V *VRNG/URNG) + 110 CONTINUE + ELSE + DATL=0. + UMINX=UMIN+.9999*(UMAX-UMIN) + UMAXX=UMAX-.9999*(UMAX-UMIN) + VMINX=VMIN+.9999*(VMAX-VMIN) + VMAXX=VMAX-.9999*(VMAX-VMIN) + CALL FRSTD (UMINX,VMINX) + CALL MAPVP (UMINX,VMINX,UMAXX,VMINX) + CALL MAPVP (UMAXX,VMINX,UMAXX,VMAXX) + CALL MAPVP (UMAXX,VMAXX,UMINX,VMAXX) + CALL MAPVP (UMINX,VMAXX,UMINX,VMINX) + END IF +C +C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN. +C + CALL MAPCHI (-1,0,0) +C + END IF +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPLOT +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMB/ IIER +C +C DEFINE REQUIRED CONSTANTS. +C + DATA PI / 3.14159265358979 / +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPLOT','VERSION 1') +C +C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE +C LAST INITIALIZATION, DO NOTHING. +C + IF (INTF) RETURN + IF (IIER.NE.0) RETURN +C +C IF THE SELECTED OUTLINE TYPE IS "NONE", DO NOTHING. +C + IF (NOUT.LE.0) RETURN +C +C SET THE FLAG IWGF TO SAY WHETHER OR NOT THE WHOLE GLOBE IS SHOWN BY +C THE CURRENT PROJECTION. IF SO (IWGF=1), THERE'S NO NEED TO WASTE THE +C TIME REQUIRED TO CHECK EACH OUTLINE POINT GROUP FOR INTERSECTION WITH +C THE WINDOW. +C + IWGF=0 + IF (BLAM-SLAM.GT.179.9999.AND.BLOM-SLOM.GT.359.9999) IWGF=1 +C +C IGIS KEEPS TRACK OF CHANGES IN THE GROUP IDENTIFIER, SO THAT THE +C INTENSITY CAN BE CHANGED WHEN NECESSARY. +C + IGIS=0 +C +C POSITION TO THE USER-SELECTED PORTION OF THE OUTLINE DATASET. +C + CALL MAPIO (1) + NSEG=0 +C +C READ THE NEXT RECORD (GROUP OF POINTS). +C + 101 CALL MAPIO (2) + NSEG=NSEG+1 +C +C CHECK FOR THE END OF THE DESIRED DATA. +C + IF (NPTS.EQ.0) GO TO 103 +C +C IF LESS THAN THE WHOLE GLOBE IS SHOWN BY THE PROJECTION, DO A QUICK +C CHECK FOR INTERSECTION OF THE BOX SURROUNDING THE POINT GROUP WITH +C THE AREA SHOWN. +C + IF (IWGF.EQ.0) THEN + IF (SLAG.GT.BLAM.OR.BLAG.LT.SLAM) GO TO 101 + IF ((SLOG .GT.BLOM.OR.BLOG .LT.SLOM).AND. + + (SLOG-360..GT.BLOM.OR.BLOG-360..LT.SLOM).AND. + + (SLOG+360..GT.BLOM.OR.BLOG+360..LT.SLOM)) GO TO 101 + END IF +C +C SEE IF THE USER WANTS TO OMIT THIS POINT GROUP. +C + CALL MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS) + IF (NPTS.LE.1) GO TO 101 +C +C IF WE'VE SWITCHED TO A NEW GROUP, SET THE INTENSITY, DOTTING, AND +C DASH PATTERN FOR THE GROUP. +C + IF (IGID.NE.IGIS) THEN + IF (IGIS.NE.0) CALL MAPCHI (-4-IGIS,0,0) + CALL MAPCHI (4+IGID,IDOT,IOR(ISHIFT(32767,1),1)) + IGIS=IGID + END IF +C +C PLOT THE GROUP. +C + CALL MAPIT (PNTS(1),PNTS(2),0) +C + DO 102 K=2,NPTS-1 + CALL MAPIT (PNTS(2*K-1),PNTS(2*K),1) + 102 CONTINUE +C + CALL MAPIT (PNTS(2*NPTS-1),PNTS(2*NPTS),2) +C +C GO GET ANOTHER GROUP. +C + GO TO 101 +C +C RESET THE INTENSITY, DOTTING, AND DASH PATTERN, IF NECESSARY. +C + 103 IF (IGIS.NE.0) CALL MAPCHI (-4-IGIS,0,0) +C +C IF THE LIMB LINES HAVE NOT ALREADY BEEN DRAWN, DO IT NOW. +C + IF (GRID.LE.0.) CALL MAPLMB +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPPOS (ARG1,ARG2,ARG3,ARG4) +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMB/ IIER +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPPOS','VERSION 1') +C +C CHECK THE ARGUMENTS FOR ERRORS. +C + IF (ARG1.LT.0..OR.ARG1.GE.ARG2.OR.ARG2.GT.1.) GO TO 901 + IF (ARG3.LT.0..OR.ARG3.GE.ARG4.OR.ARG4.GT.1.) GO TO 901 +C +C TRANSFER IN THE VALUES. +C + XLOW=ARG1 + XROW=ARG2 + YBOW=ARG3 + YTOW=ARG4 +C +C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED. +C + INTF=.TRUE. +C +C DONE. +C + RETURN +C +C ERROR EXIT. +C + 901 IIER=19 + CALL SETER (' MAPPOS - ARGUMENTS ARE INCORRECT',IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPROJ (ARG1,ARG2,ARG3,ARG4) +C + CHARACTER*(*) ARG1 +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10) + CHARACTER*2 DDCT,LDCT,PDCT + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPROJ','VERSION 1') +C +C TRANSFER THE PARAMETERS DEFINING THE PROJECTION. +C + I=IDICTL(ARG1,PDCT,10) + IF (I.EQ.0) GO TO 901 +C + JPRJ=I +C + IF (JPRJ.EQ.3) THEN + CALL MAPSTR ('SA',0.) + ELSE IF (JPRJ.EQ.10) THEN + JPRJ=3 + IF (ABS(SALT).LE.1.) CALL MAPSTR ('SA',6.631) + END IF +C + PHIA=ARG2 + PHIO=ARG3 + ROTA=ARG4 +C +C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED. +C + INTF=.TRUE. +C +C DONE. +C + RETURN +C +C ERROR EXIT. +C + 901 IIER=9 + CALL MAPCEM (' MAPROJ - UNKNOWN PROJECTION NAME ',ARG1,IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPRS +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPRS','VERSION 1') +C +C RESTORE THE SET CALL. +C + CALL SET (ULOW,UROW,VBOW,VTOW,UMIN,UMAX,VMIN,VMAX,1) +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPRST (IFNO) +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER + COMMON /MAPNTS/ INTS(7) + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPRST','VERSION 1') +C +C READ A RECORD OF SAVED PARAMETERS. +C + READ (IFNO,ERR=901,END=902) NOUT,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1, + + PLA2,PLA3,PLA4,PLB1,PLB2,PLB3,PLB4, + + PLTR,GRID,IDSH,IDOT,LBLF,PRMF,ELPF, + + XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH, + + ILCW,DPLT,DDTS,SALT,SSMO,SRSS,ALFA, + + BETA,SALF,CALF,SBET,CBET, + + (INTS(I),I=1,7) +C +C RE-INITIALIZE EZMAP. +C + CALL MAPINT +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=20 + CALL SETER ('MAPRST - ERROR ON READ',IIER,1) + RETURN +C + 902 IIER=21 + CALL SETER ('MAPRST - EOF ON READ',IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPSAV (IFNO) +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER + COMMON /MAPNTS/ INTS(7) + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPSAV','VERSION 1') +C +C WRITE A RECORD CONTAINING ALL THE USER-SETTABLE PARAMETERS. +C + WRITE (IFNO,ERR=901) NOUT,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1, + + PLA2,PLA3,PLA4,PLB1,PLB2,PLB3,PLB4, + + PLTR,GRID,IDSH,IDOT,LBLF,PRMF,ELPF, + + XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH, + + ILCW,DPLT,DDTS,SALT,SSMO,SRSS,ALFA, + + BETA,SALF,CALF,SBET,CBET, + + (INTS(I),I=1,7) +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=22 + CALL SETER ('MAPSAV - ERROR ON WRITE',IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPSET (ARG1,ARG2,ARG3,ARG4,ARG5) +C + CHARACTER*(*) ARG1 + DIMENSION ARG2(2),ARG3(2),ARG4(2),ARG5(2) +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10) + CHARACTER*2 DDCT,LDCT,PDCT + COMMON /MAPCMB/ IIER +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPSET','VERSION 1') +C +C TRANSFER THE PARAMETERS DEFINING THE MAP LIMITS. +C + I=IDICTL(ARG1,LDCT,5) + IF (I.EQ.0) GO TO 901 + ILTS=I +C + PLA1=ARG2(1) + PLA2=ARG3(1) + PLA3=ARG4(1) + PLA4=ARG5(1) +C + IF (I.EQ.3) THEN + PLB1=ARG2(2) + PLB2=ARG3(2) + PLB3=ARG4(2) + PLB4=ARG5(2) + END IF +C +C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED. +C + INTF=.TRUE. +C +C DONE. +C + RETURN +C +C ERROR EXIT. +C + 901 IIER=10 + CALL MAPCEM (' MAPSET - UNKNOWN MAP AREA SPECIFIER ',ARG1,IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPSTC (WHCH,CVAL) +C + CHARACTER*(*) WHCH,CVAL +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10) + CHARACTER*2 DDCT,LDCT,PDCT + COMMON /MAPCMB/ IIER +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTC','VERSION 1') +C + IF (WHCH(1:2).EQ.'OU') THEN + I=IDICTL(CVAL,DDCT,5) + IF (I.EQ.0) GO TO 901 + NOUT=I-1 + ELSE + GO TO 902 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=11 + CALL MAPCEM (' MAPSTC - UNKNOWN OUTLINE NAME ',CVAL,IIER,1) + RETURN +C + 902 IIER=12 + CALL MAPCEM (' MAPSTC - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPSTI (WHCH,IVAL) +C + CHARACTER*(*) WHCH +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER + COMMON /MAPNTS/ INTS(7) + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTI','VERSION 1') +C + IF (WHCH(1:2).EQ.'DA') THEN + IDSH=IVAL + ELSE IF (WHCH(1:2).EQ.'DD') THEN + DDTS=IVAL + DBTD=DDTS/DSCA + ELSE IF (WHCH(1:2).EQ.'DL') THEN + IDTL=IVAL + ELSE IF (WHCH(1:2).EQ.'DO') THEN + IDOT=IVAL + ELSE IF (WHCH(1:2).EQ.'EL') THEN + ELPF=IVAL.NE.0 + ELSE IF (WHCH(1:2).EQ.'GR') THEN + GRID=IVAL + ELSE IF (WHCH(1:2).EQ.'I1') THEN + INTS(1)=IVAL + ELSE IF (WHCH(1:2).EQ.'I2') THEN + INTS(2)=IVAL + ELSE IF (WHCH(1:2).EQ.'I3') THEN + INTS(3)=IVAL + ELSE IF (WHCH(1:2).EQ.'I4') THEN + INTS(4)=IVAL + ELSE IF (WHCH(1:2).EQ.'I5') THEN + INTS(5)=IVAL + ELSE IF (WHCH(1:2).EQ.'I6') THEN + INTS(6)=IVAL + ELSE IF (WHCH(1:2).EQ.'I7') THEN + INTS(7)=IVAL + ELSE IF (WHCH(1:2).EQ.'LA') THEN + LBLF=IVAL.NE.0 + ELSE IF (WHCH(1:2).EQ.'LS') THEN + ILCW=IVAL + ELSE IF (WHCH(1:2).EQ.'MV') THEN + DPLT=IVAL + DPSQ=DPLT*DPLT + ELSE IF (WHCH(1:2).EQ.'PE') THEN + PRMF=IVAL.NE.0 + ELSE IF (WHCH(1:2).EQ.'RE') THEN + PLTR=IVAL + DSCA=(UROW-ULOW)*PLTR/(UMAX-UMIN) + DSSQ=DSCA*DSCA + DBTD=DDTS/DSCA + ELSE IF (WHCH(1:2).EQ.'SA') THEN + SALT=IVAL + IF (ABS(SALT).GT.1.) THEN + SSMO=SALT*SALT-1. + SRSS=SQRT(SSMO) + END IF + ELSE IF (WHCH(1:2).EQ.'S1') THEN + ALFA=IVAL + SALF=SIN(.017453292519943*ALFA) + CALF=COS(.017453292519943*ALFA) + ELSE IF (WHCH(1:2).EQ.'S2') THEN + BETA=IVAL + SBET=SIN(.017453292519943*BETA) + CBET=COS(.017453292519943*BETA) + ELSE + GO TO 901 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=13 + CALL MAPCEM (' MAPSTI - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPSTL (WHCH,LVAL) +C + CHARACTER*(*) WHCH + LOGICAL LVAL +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMB/ IIER +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTL','VERSION 1') +C + IF (WHCH(1:2).EQ.'DL') THEN + IDTL=0 + IF (LVAL) IDTL=1 + ELSE IF (WHCH(1:2).EQ.'DO') THEN + IDOT=0 + IF (LVAL) IDOT=1 + ELSE IF (WHCH(1:2).EQ.'EL') THEN + ELPF=LVAL + ELSE IF (WHCH(1:2).EQ.'LA') THEN + LBLF=LVAL + ELSE IF (WHCH(1:2).EQ.'PE') THEN + PRMF=LVAL + ELSE + GO TO 901 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=14 + CALL MAPCEM (' MAPSTL - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPSTR (WHCH,RVAL) +C + CHARACTER*(*) WHCH +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMB/ IIER + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTR','VERSION 1') +C + IF (WHCH(1:2).EQ.'DD') THEN + DDTS=RVAL + DBTD=DDTS/DSCA + ELSE IF (WHCH(1:2).EQ.'GD') THEN + GRDR=AMAX1(.001,AMIN1(10.,RVAL)) + ELSE IF (WHCH(1:2).EQ.'GR') THEN + GRID=RVAL + ELSE IF (WHCH(1:2).EQ.'MV') THEN + DPLT=RVAL + DPSQ=DPLT*DPLT + ELSE IF (WHCH(1:2).EQ.'RE') THEN + PLTR=RVAL + DSCA=(UROW-ULOW)*PLTR/(UMAX-UMIN) + DSSQ=DSCA*DSCA + DBTD=DDTS/DSCA + ELSE IF (WHCH(1:2).EQ.'SA') THEN + SALT=RVAL + IF (ABS(SALT).GT.1.) THEN + SSMO=SALT*SALT-1. + SRSS=SQRT(SSMO) + END IF + ELSE IF (WHCH(1:2).EQ.'S1') THEN + ALFA=RVAL + SALF=SIN(.017453292519943*ALFA) + CALF=COS(.017453292519943*ALFA) + ELSE IF (WHCH(1:2).EQ.'S2') THEN + BETA=RVAL + SBET=SIN(.017453292519943*BETA) + CBET=COS(.017453292519943*BETA) + ELSE IF (WHCH(1:2).EQ.'SR') THEN + SRCH=AMAX1(.001,AMIN1(10.,RVAL)) + ELSE + GO TO 901 + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=15 + CALL MAPCEM (' MAPSTR - UNKNOWN PARAMETER NAME ',WHCH,IIER,1) + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPTRN (RLAT,RLON,U,V) +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC + COMMON /MAPCM8/ P,Q,R + COMMON /MAPCMB/ IIER + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C DEFINE REQUIRED CONSTANTS. DTOR IS PI OVER 180, DTRH IS HALF OF DTOR +C OR PI OVER 360, AND TOPI IS 2 OVER PI. +C + DATA DTOR / .017453292519943 / + DATA DTRH / .008726646259971 / + DATA RTOD / 57.2957795130823 / + DATA TOPI / .636619772367581 / +C +C SET UP U AND V FOR THE FAST PATHS. U IS A LONGITUDE, IN DEGREES, +C BETWEEN -180. AND +180., INCLUSIVE, AND V IS A LATITUDE, IN DEGREES. +C + TMP1=RLON-PHOC + U=TMP1-SIGN(180.,TMP1+180.)+SIGN(180.,180.-TMP1) + V=RLAT +C +C TAKE FAST PATHS FOR SIMPLE CYLINDRICAL PROJECTIONS. +C + IF (IPRJ-10) 101,116,112 +C +C NO FAST PATH. SORT OUT THE LAMBERT CONFORMAL CONIC FROM THE REST. +C + 101 IF (IPRJ-1) 901,102,103 +C +C LAMBERT CONFORMAL CONIC. +C + 102 P=U + CHI=90.-SINO*RLAT + IF (CHI.GE.179.9999) GO TO 118 + R=TAN(DTRH*CHI)**COSO + U=U*COSO*DTOR + V=-R*SINO*COS(U) + U=R*SIN(U) + GO TO 117 +C +C NOT LAMBERT CONFORMAL CONIC. CALCULATE CONSTANTS COMMON TO MOST OF +C THE OTHER PROJECTIONS. +C + 103 TMP1=U*DTOR + TMP2=V*DTOR + SINPH=SIN(TMP1) + SINLA=SIN(TMP2) + COSPH=COS(TMP1) + COSLA=COS(TMP2) + TCOS=COSLA*COSPH + COSA=AMAX1(-1.,AMIN1(+1.,SINLA*SINO+TCOS*COSO)) + SINA=SQRT(1.-COSA*COSA) + IF (SINA.LT..0001) THEN + SINA=0. + IF (IPRJ.GE.7.OR.COSA.LT.0.) GO TO 118 + U=0. + V=0. + GO TO 116 + END IF + SINB=COSLA*SINPH/SINA + COSB=(SINLA*COSO-TCOS*SINO)/SINA +C +C JUMP TO CODE APPROPRIATE FOR THE CHOSEN PROJECTION. +C + GO TO (104,105,106,107,108,109,110,111) , IPRJ-1 +C +C STEREOGRAPHIC. +C + 104 IF (ABS(SINA).LT..0001) THEN + R=SINA/2. + ELSE + R=(1.-COSA)/SINA + END IF + GO TO 115 +C +C ORTHOGRAPHIC OR SATELLITE-VIEW, DEPENDING ON THE VALUE OF SALT. +C + 105 IF (ABS(SALT).LE.1.) THEN + IF (COSA.GT.0.) THEN + R=SINA + ELSE + IF (SALT.GE.0.) GO TO 118 + R=2.-SINA + END IF + GO TO 115 + ELSE + IF (COSA.GT.1./ABS(SALT)) THEN + R=SRSS*SINA/(ABS(SALT)-COSA) + ELSE + IF (SALT.GE.0.) GO TO 118 + R=2.-SRSS*SINA/(ABS(SALT)-COSA) + END IF + IF (ALFA.EQ.0.) GO TO 115 + UTM1=R*(SINB*COSR+COSB*SINR) + VTM1=R*(COSB*COSR-SINB*SINR) + UTM2=UTM1*CBET+VTM1*SBET + VTM2=VTM1*CBET-UTM1*SBET + UTM3=SRSS*UTM2/(UTM2*SALF+SRSS*CALF) + VTM3=SRSS*VTM2*CALF/(UTM2*SALF+SRSS*CALF) + U=UTM3*CBET-VTM3*SBET + V=VTM3*CBET+UTM3*SBET + GO TO 116 + END IF +C +C LAMBERT EQUAL AREA. +C + 106 IF (ABS(COSA+1.).LT.1.E-6) GO TO 118 + R=(1.+COSA)/SINA + R=2./SQRT(1.+R*R) + GO TO 115 +C +C GNOMONIC. +C + 107 IF (COSA.LE..0001) GO TO 118 + R=SINA/COSA + GO TO 115 +C +C AZIMUTHAL EQUIDISTANT. +C + 108 IF (ABS(COSA+1.).LT.1.E-6) GO TO 118 + R=ACOS(COSA) + GO TO 115 +C +C CYLINDRICAL EQUIDISTANT, ARBITRARY POLE AND ORIENTATION. +C + 109 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)*RTOD + V=90.-ACOS(COSA)*RTOD + GO TO 116 +C +C MERCATOR, ARBITRARY POLE AND ORIENTATION. +C + 110 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR) + V=ALOG((1.+COSA)/SINA) + GO TO 116 +C +C MOLLWEIDE, ARBITRARY POLE AND ORIENTATION. +C + 111 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)*TOPI + P=U + V=COSA + U=U*SINA + GO TO 117 +C +C FAST-PATH CYLINDRICAL PROJECTIONS (WITH PLAT=ROTA=0). +C + 112 IF (IPRJ-12) 113,114,901 +C +C FAST-PATH MERCATOR. +C + 113 IF (ABS(RLAT).GT.89.9999) GO TO 118 + U=U*DTOR + V=ALOG(TAN((RLAT+90.)*DTRH)) + GO TO 116 +C +C FAST-PATH MOLLWEIDE. +C + 114 U=U/90. + V=SIN(RLAT*DTOR) + P=U + U=U*SQRT(1.-V*V) + GO TO 117 +C +C COMMON TERMINAL CODE FOR CERTAIN PROJECTIONS. +C + 115 U=R*(SINB*COSR+COSB*SINR) + V=R*(COSB*COSR-SINB*SINR) +C + 116 P=U +C + 117 Q=V +C +C NORMAL EXIT. +C + RETURN +C +C PROJECTION OF POINT IS INVISIBLE OR UNDEFINED. +C + 118 U=1.E12 + P=U + RETURN +C +C ERROR EXIT. +C + 901 IF (IIER.NE.0) GO TO 118 + IIER=16 + CALL SETER (' MAPTRN - ATTEMPT TO USE NON-EXISTENT PROJECTION', + + IIER,1) + GO TO 118 +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPUSR (IPRT) + RETURN + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPVEC (XLAT,XLON) + CALL MAPIT (XLAT,XLON,1) + RETURN + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE SUPCON (RLAT,RLON,UVAL,VVAL) + CALL MAPTRN (RLAT,RLON,UVAL,VVAL) + RETURN + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE SUPMAP (JPRJ,PLAT,PLON,ROTA,PLM1,PLM2,PLM3,PLM4,JLTS, + + JGRD,IOUT,IDOT,IERR) +C + DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2) +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10) + CHARACTER*2 DDCT,LDCT,PDCT + COMMON /MAPCMB/ IIER +C + DIMENSION LPRJ(10),LLTS(5) +C + DATA LPRJ / 2,3,1,4,5,6,10,7,8,9 / + DATA LLTS / 1,2,5,4,3 / +C +C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR. +C + CALL Q8QST4 ('GRAPHX','EZMAP','SUPMAP','VERSION 1') +C +C SET EZMAP'S GRID-SPACING PARAMETER. +C + CALL MAPSTI ('GR',MOD(IABS(JGRD),1000)) +C +C SET EZMAP'S OUTLINE-SELECTION PARAMETER. +C + IF (IABS(IOUT).EQ.0.OR.IABS(IOUT).EQ.1) THEN + I=1+2*IABS(IOUT)+(1+ISIGN(1,JPRJ))/2 + ELSE + I=MAX0(1,MIN0(5,IOUT)) + END IF +C + CALL MAPSTC ('OU',DDCT(I)) +C +C SET EZMAP'S PERIMETER-DRAWING FLAG. +C + CALL MAPSTL ('PE',JGRD.GE.0) +C +C SET EZMAP'S GRID-LINE-LABELLING FLAG. +C + CALL MAPSTL ('LA',MOD(IABS(JGRD),1000).NE.0) +C +C SET EZMAP'S DOTTED-OUTLINE FLAG. +C + CALL MAPSTI ('DO',MAX0(0,MIN0(1,IDOT))) +C +C SET EZMAP'S PROJECTION-SELECTION PARAMETERS. +C + I=MAX0(1,MIN0(10,IABS(JPRJ))) + CALL MAPROJ (PDCT(LPRJ(I)),PLAT,PLON,ROTA) +C +C SET EZMAP'S RECTANGULAR-LIMITS-SELECTION PARAMETERS. +C + I=LLTS(MAX0(1,MIN0(5,IABS(JLTS)))) + CALL MAPSET (LDCT(I),PLM1,PLM2,PLM3,PLM4) +C +C DRAW THE MAP. +C + CALL MAPDRW +C +C RETURN THE ERROR FLAG TO THE USER. +C + IERR=IIER +C +C DONE. +C + RETURN +C + END +C +C*********************************************************************** +C T H E C O D E - I N T E R N A L R O U T I N E S +C*********************************************************************** +C + SUBROUTINE MAPCEM (IEM1,IEM2,IIER,IFLG) +C + CHARACTER*(*) IEM1,IEM2 +C +C MAPCEM IS CALLED TO DO A CALL TO SETER WHEN THE ERROR MESSAGE TO BE +C PRINTED IS IN TWO PARTS WHICH NEED TO BE CONCATENATED. FORTRAN-77 +C RULES MAKE IT NECESSARY TO CONCATENATE THE TWO PARTS OF THE MESSAGE +C INTO A LOCAL CHARACTER VARIABLE. +C + CHARACTER*100 IEMC +C + IEMC=IEM1//IEM2 + CALL SETER (IEMC,IIER,IFLG) +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPCHI (IPRT,IDTG,IDPT) +C +C MAPCHI IS CALLED BY VARIOUS EZMAP ROUTINES TO RESET THE INTENSITY, +C DOTTING, AND DASH PATTERN BEFORE AND AFTER DRAWING PARTS OF A MAP. +C +C THE ARGUMENT IPRT, IF POSITIVE, SAYS WHICH PART OF THE MAP IS ABOUT +C TO BE DRAWN, AS FOLLOWS: +C +C IPRT PART OF MAP. +C ---- ------------ +C 1 PERIMETER. +C 2 GRID. +C 3 LABELLING. +C 4 LIMB LINES. +C 5 OUTLINE POINT GROUP, CONTINENTAL. +C 6 OUTLINE POINT GROUP, U.S. +C 7 OUTLINE POINT GROUP, COUNTRY. +C +C A CALL WITH IPRT EQUAL TO THE NEGATIVE OF ONE OF THESE VALUES ASKS +C THAT THE INTENSITY SAVED BY THE LAST CALL, WITH IPRT POSITIVE, BE +C RESTORED. +C +C WHEN IPRT IS POSITIVE, IDTG IS ZERO IF SOLID LINES ARE TO BE USED, 1 +C IF DOTTED LINES ARE TO BE USED. IF IPRT IS NEGATIVE, IDTG IS IGNORED. +C +C WHEN IPRT IS POSITIVE AND IDTG IS ZERO, IDPT IS THE DASH PATTERN TO BE +C USED. IF IPRT IS NEGATIVE OR IDTG IS NON-ZERO, IDPT IS IGNORED. +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPNTS/ INTS(7) +C +C DECLARE ONE OF THE DASH-PACKAGE COMMON BLOCKS, TOO. +C + COMMON /SMFLAG/ ISMO +C +C THE VARIABLES INTO, IDTS, AND ISMS NEED TO BE SAVED BETWEEN CALLS. +C + SAVE INTO,IDTS,ISMS +C +C FLUSH ALL BUFFERS BEFORE CHANGING ANYTHING. +C + CALL MAPIQ +C +C SET/RESET INTENSITY, DOTTING, AND DASH PATTERN. THE USER HAS THE +C LAST WORD. +C + IF (IPRT.GT.0) THEN + ISMS=ISMO + ISMO=1 + IDTS=IDTL + IDTL=IDTG + IF (IDTL.EQ.0) CALL DASHDB (IDPT) +C +C THE FOLLOWING LINES HAVE BEEN COMMENTED OUT BECAUSE THE INTENSITY +C SETTING CAUSES SOME STRANGE BEHAVIOUR ON CERTAIN TERMINALS AND +C WORKSTATIONS. +C +C CALL GETUSV ('IN',INTO) +C CALL SETUSV ('IN',IFIX(10000.*FLOAT(INTS(IPRT))/255.)) + CALL MAPUSR (IPRT) + ELSE + CALL MAPUSR (IPRT) +C +C THE FOLLOWING LINE HAVE BEEN COMMENTED OUT BECAUSE THE INTENSITY +C SETTING CAUSES SOME STRANGE BEHAVIOUR ON CERTAIN TERMINALS AND +C WORKSTATIONS. +C +C CALL SETUSV ('IN',INTO) + IF (IDTL.EQ.0) CALL DASHDB (IOR(ISHIFT(32767,1),1)) + IDTL=IDTS + ISMO=ISMS + END IF +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + INTEGER FUNCTION IDICTL (ISTR,IDCT,NDCT) +C + CHARACTER*(*) ISTR + CHARACTER*2 IDCT(NDCT) +C +C THE VALUE OF THIS FUNCTION IS THE INDEX IN THE NDCT-ELEMENT DICTIONARY +C IDCT OF THE STRING ISTR. ONLY THE FIRST TWO CHARACTERS OF ISTR AND +C IDCT(I) ARE COMPARED. IF ISTR IS NOT FOUND IN THE DICTIONARY, THE +C FUNCTION VALUE IS ZERO. +C + DO 101 I=1,NDCT + IF (ISTR(1:2).EQ.IDCT(I)) THEN + IDICTL=I + RETURN + END IF + 101 CONTINUE +C +C NOT FOUND. RETURN A ZERO. +C + IDICTL=0 + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPIO (IACT) +C +C THIS ROUTINE PERFORMS ALL POSITIONING AND INPUT OF THE OUTLINE DATASET +C FOR MAPLOT. THE ARGUMENT IACT SPECIFIES WHAT IS TO BE DONE: 1 ASKS +C THAT THE DATASET BE POSITIONED AT THE BEGINNING OF THE DESIRED "FILE", +C 2 THAT THE NEXT RECORD BE READ. +C +C FIVE LINES OF THE CODE BELOW HAVE BEEN INSERTED TO MAKE THIS ROUTINE +C RUN EFFICIENTLY ON NCAR'S CRAYS; THESE LINES SHOULD BE REMOVED BY +C ANYONE IMPLEMENTING EZMAP ON ANOTHER SYSTEM (EXCEPT PERHAPS ANOTHER +C CRAY). +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) + COMMON /MAPCMB/ IERR +C + IF (IACT.EQ.1) THEN +C +C POSITION TO THE DESIRED "FILE" WITHIN THE DATASET. +C +C THE FOLLOWING FIVE LINES ARE FOR NCAR'S CRAYS. +C +C ITPN=6LEZMPDT +C IF (IFDNT(ITPN).EQ.0) THEN +C CALL SDACCESS (IERR,ITPN) +C IF (IERR.NE.0) GO TO 901 +C END IF +C + REWIND ITPN +C + IF (NOUT.NE.1) THEN + ITMP=NOUT + 101 READ (ITPN,END=902) NPTS,IGID,BLAG,SLAG,BLOG,SLOG, + + (PNTS(I),I=1,NPTS) + IF (NPTS.GT.1) GO TO 101 + ITMP=ITMP-1 + IF (ITMP.GT.1) GO TO 101 + END IF +C + ELSE +C +C READ THE NEXT RECORD. +C + READ (ITPN) NPTS,IGID,BLAG,SLAG,BLOG,SLOG,(PNTS(I),I=1,NPTS) + NPTS=NPTS/2 +C + END IF +C +C DONE. +C + RETURN +C +C ERROR EXITS. +C + 901 IIER=17 + CALL SETER (' MAPIO - OUTLINE DATASET IS UNREADABLE',IIER,1) + NOUT=0 + RETURN +C + 902 IIER=18 + CALL SETER (' MAPIO - EOF ENCOUNTERED IN OUTLINE DATASET',IIER,1) + NOUT=0 + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPLMB +C +C THE ROUTINE MAPLMB IS CALLED BY MAPGRD AND/OR MAPLOT TO DRAW THE LIMB +C LINES. +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C DEFINE REQUIRED CONSTANTS. SIN1 AND COS1 ARE RESPECTIVELY THE SINE +C AND COSINE OF ONE DEGREE. +C + DATA SIN1 / .017452406437283 / + DATA COS1 / .999847695156390 / + DATA PI / 3.14159265358979 / +C +C THE ARITHMETIC STATEMENT FUNCTIONS FLOOR AND CLING GIVE, RESPECTIVELY, +C THE "FLOOR" OF X - THE LARGEST INTEGER LESS THAN OR EQUAL TO X - AND +C THE "CEILING" OF X - THE SMALLEST INTEGER GREATER THAN OR EQUAL TO X. +C + FLOOR(X)=AINT(X+1.E4)-1.E4 + CLING(X)=-FLOOR(-X) +C +C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR LIMB LINES. +C + CALL MAPCHI (4,0,IOR(ISHIFT(32767,1),1)) +C +C DRAW LIMB LINES, THE NATURE OF WHICH DEPENDS ON THE PROJECTION. +C + GO TO (101,110,104,105,110,106,110,110,107,110,110,107) , IPRJ +C +C LAMBERT CONFORMAL CONIC WITH TWO STANDARD PARALLELS. +C + 101 DLAT=GRDR + RLON=PHIO+179.9999 + K=CLING(180./DLAT) + DO 103 I=1,2 + RLAT=-90. + CALL MAPIT (RLAT,RLON,0) + DO 102 J=1,K-1 + RLAT=RLAT+DLAT + CALL MAPIT (RLAT,RLON,1) + 102 CONTINUE + RLAT=RLAT+DLAT + CALL MAPIT (RLAT,RLON,2) + RLON=PHIO-179.9999 + 103 CONTINUE + GO TO 110 +C +C ORTHOGRAPHIC (OR SATELLITE-VIEW). +C + 104 IF (ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN + URAD=1. + RVTU=1. + ELSE + DNOM=SALT*SALT*CALF*CALF-1. + URAD=SSMO*CALF/DNOM + RVTU=SQRT(DNOM)/SRSS + END IF + GO TO 108 +C +C LAMBERT EQUAL AREA. +C + 105 URAD=2. + RVTU=1. + GO TO 108 +C +C AZIMUTHAL EQUIDISTANT. +C + 106 URAD=PI + RVTU=1. + GO TO 108 +C +C MOLLWEIDE. +C + 107 URAD=2. + RVTU=0.5 +C + 108 UCIR=URAD + VCIR=0. + IVIS=-1 + DO 109 I=1,361 + IF (IPRJ.NE.3.OR.ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN + U=UCIR + V=RVTU*VCIR + ELSE + UTMP=UCIR-SRSS*SALF/DNOM + VTMP=RVTU*VCIR + U=UTMP*CBET-VTMP*SBET + V=VTMP*CBET+UTMP*SBET + END IF + IF (.NOT.ELPF.AND. + + (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX)) THEN + IF (IVIS.EQ.1) THEN + CALL MAPTRP (UOLD,VOLD,U,V,UEDG,VEDG) + CALL MAPVP (UOLD,VOLD,UEDG,VEDG) + END IF + IVIS=0 + ELSE IF (ELPF.AND. + + (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.)) THEN + IF (IVIS.EQ.1) THEN + CALL MAPTRE (UOLD,VOLD,U,V,UEDG,VEDG) + CALL MAPVP (UOLD,VOLD,UEDG,VEDG) + END IF + IVIS=0 + ELSE + IF (IVIS.LT.0) THEN + DATL=0. + CALL FRSTD (U,V) + IVIS=1 + ELSE + IF (IVIS.EQ.0) THEN + IF (.NOT.ELPF) CALL MAPTRP (U,V,UOLD,VOLD,UOLD,VOLD) + IF ( ELPF) CALL MAPTRE (U,V,UOLD,VOLD,UOLD,VOLD) + DATL=0. + CALL FRSTD (UOLD,VOLD) + IVIS=1 + END IF + CALL MAPVP (UOLD,VOLD,U,V) + END IF + END IF + UOLD=U + VOLD=V + UTMP=UCIR + VTMP=VCIR + UCIR=UTMP*COS1-VTMP*SIN1 + VCIR=UTMP*SIN1+VTMP*COS1 + 109 CONTINUE +C +C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN. +C + 110 CALL MAPCHI (-4,0,0) +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPTRE (UINS,VINS,UOUT,VOUT,UINT,VINT) +C +C THIS ROUTINE FINDS THE POINT OF INTERSECTION (UINT,VINT) OF THE LINE +C FROM (UINS,VINS) TO (UOUT,VOUT) WITH THE EDGE OF AN ELLIPTICAL FRAME. +C THE FIRST POINT IS INSIDE THE FRAME AND THE SECOND OUTSIDE THE FRAME. +C +C BECAUSE MAPTRE CAN BE CALLED WITH THE SAME ACTUAL ARGUMENTS FOR UINT +C AND VINT AS FOR UOUT AND VOUT, RESPECTIVELY, UINT AND VINT MUST NOT +C BE RESET UNTIL ALL USE OF UOUT AND VOUT IS COMPLETE. +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM +C +C WHAT'S INVOLVED IS JUST A LOT OF ALGEBRA. +C + IF (ABS(UOUT-UINS).GT.ABS(VOUT-VINS)) THEN + P=(VOUT-VINS)/(UOUT-UINS) + Q=(UOUT*VINS-UINS*VOUT)/(UOUT-UINS) + A=VRNG*VRNG+P*P*URNG*URNG + B=2.*(P*Q*URNG*URNG-UCEN*VRNG*VRNG-P*URNG*URNG*VCEN) + C=UCEN*UCEN*VRNG*VRNG+Q*Q*URNG*URNG-2.*Q*URNG*URNG*VCEN+ + + URNG*URNG*VCEN*VCEN-URNG*URNG*VRNG*VRNG + UTM1=SQRT(AMAX1(B*B-4.*A*C,0.)) + UTM2=.5*(-B-UTM1)/A + IF ((UTM2-UOUT)*(UTM2-UINS).GT.0.) UTM2=.5*(-B+UTM1)/A + UINT=UTM2 + VINT=P*UINT+Q + ELSE + P=(UOUT-UINS)/(VOUT-VINS) + Q=(UINS*VOUT-UOUT*VINS)/(VOUT-VINS) + A=URNG*URNG+P*P*VRNG*VRNG + B=2.*(P*Q*VRNG*VRNG-URNG*URNG*VCEN-P*UCEN*VRNG*VRNG) + C=URNG*URNG*VCEN*VCEN+Q*Q*VRNG*VRNG-2.*Q*UCEN*VRNG*VRNG+ + + UCEN*UCEN*VRNG*VRNG-URNG*URNG*VRNG*VRNG + VTM1=SQRT(AMAX1(B*B-4.*A*C,0.)) + VTM2=.5*(-B-VTM1)/A + IF ((VTM2-VOUT)*(VTM2-VINS).GT.0.) VTM2=.5*(-B+VTM1)/A + VINT=VTM2 + UINT=P*VINT+Q + END IF +C +C DONE. +C + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPTRP (UINS,VINS,UOUT,VOUT,UINT,VINT) +C +C THIS ROUTINE FINDS THE POINT OF INTERSECTION (UINT,VINT) OF THE LINE +C FROM (UINS,VINS) TO (UOUT,VOUT) WITH THE EDGE OF A RECTANGULAR FRAME. +C THE FIRST POINT IS INSIDE THE FRAME AND THE SECOND OUTSIDE THE FRAME. +C +C BECAUSE MAPTRP CAN BE CALLED WITH THE SAME ACTUAL ARGUMENTS FOR UINT +C AND VINT AS FOR UOUT AND VOUT, RESPECTIVELY, UINT AND VINT MUST NOT +C BE RESET UNTIL ALL USE OF UOUT AND VOUT IS COMPLETE. +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM +C +C GIVEN ONE COORDINATE OF A POINT ON THE LINE JOINING (UINS,VINS) AND +C (UOUT,VOUT), THE OTHER CAN BE OBTAINED BY USING ONE OF THE FOLLOWING +C ARITHMETIC STATEMENT FUNCTIONS: +C + UFUN(V)=UINS+(V-VINS)*DU/DV + VFUN(U)=VINS+(U-UINS)*DV/DU +C +C I I +C 5 I 4 I 6 +C I I +C ----------------- +C FIRST, DETERMINE IN WHICH I I +C OF THE AREAS SHOWN THE 2 I 1 I 3 +C POINT (UOUT,VOUT) LIES. I I +C ----------------- +C I I +C 8 I 7 I 9 +C I I +C + IREA=1 + IF (UOUT-UMIN) 101,104,102 + 101 IREA=IREA+1 + GO TO 104 + 102 IF (UOUT-UMAX) 104,104,103 + 103 IREA=IREA+2 + 104 IF (VOUT-VMIN) 105,108,106 + 105 IREA=IREA+6 + GO TO 108 + 106 IF (VOUT-VMAX) 108,108,107 + 107 IREA=IREA+3 +C +C NEXT, COMPUTE THE QUANTITIES REQUIRED BY UFUN AND VFUN AND JUMP TO THE +C APPROPRIATE PIECE OF CODE FOR THE GIVEN AREA. +C + 108 DU=UOUT-UINS + DV=VOUT-VINS +C + GO TO (119,113,114,115,109,110,116,111,112) , IREA +C + 109 IF (UFUN(VMAX)-UMIN) 113,115,115 + 110 IF (UFUN(VMAX)-UMAX) 115,115,114 + 111 IF (UFUN(VMIN)-UMIN) 113,116,116 + 112 IF (UFUN(VMIN)-UMAX) 116,116,114 +C + 113 UINT=UMIN + GO TO 117 + 114 UINT=UMAX + GO TO 117 + 115 VINT=VMAX + GO TO 118 + 116 VINT=VMIN + GO TO 118 +C + 117 VINT=VFUN(UINT) + RETURN +C + 118 UINT=UFUN(VINT) + RETURN +C + 119 UINT=UOUT + VINT=VOUT + RETURN +C + END +C +C----------------------------------------------------------------------- +C + SUBROUTINE MAPVP (UOLD,VOLD,U,V) +C +C PLOT THE LINE SEGMENT FROM (UOLD,VOLD) TO (U,V), USING EITHER A SOLID +C LINE OR A DOTTED LINE (DEPENDING ON THE VALUE OF THE COMMON VARIABLE +C IDTL). +C +C DECLARE REQUIRED COMMON BLOCKS. SEE MAPBD FOR DESCRIPTIONS OF THESE +C COMMON BLOCKS AND THE VARIABLES IN THEM. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW + LOGICAL INTF,LBLF,PRMF,ELPF + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL + COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50) +C +C SELECT VECTOR OR DOT MODE. +C + IF (IDTL.EQ.0) THEN +C +C USE A SINGLE VECTOR. +C + CALL VECTD (U,V) +C + ELSE +C +C USE DOTS. DELU AND DELV ARE THE U AND V COMPONENTS OF THE VECTOR +C JOINING (UOLD,VOLD) TO (U,V) AND VLEN IS THE LENGTH OF THE VECTOR. +C + DELU=U-UOLD + DELV=V-VOLD +C + VLEN=SQRT(DELU*DELU+DELV*DELV) +C +C NOW DISTRIBUTE DOTS ALONG THE VECTOR. THE FIRST ONE IS SPACED JUST +C FAR ENOUGH ALONG IT (DATL UNITS) TO BE DBTD UNITS AWAY FROM THE LAST +C DOT ON THE PREVIOUS VECTOR AND THE REST ARE DBTD UNITS APART. +C + 101 IF (DATL.LT.VLEN) THEN + IF (NPTB.GE.50) THEN + CALL POINTS (XPTB,YPTB,NPTB,0,0) + NPTB=0 + END IF + NPTB=NPTB+1 + XPTB(NPTB)=UOLD+(DATL/VLEN)*DELU + YPTB(NPTB)=VOLD+(DATL/VLEN)*DELV + DATL=DATL+DBTD + GO TO 101 + END IF +C +C SET DATL FOR THE NEXT CALL. +C + DATL=DATL-VLEN +C + END IF +C +C DONE. +C + RETURN +C + END +C +C*********************************************************************** +C T H E B L O C K D A T A " R O U T I N E " - D E F A U L T S +C*********************************************************************** +C + BLOCK DATA MAPBD +C +C THE COMMON BLOCK MAPCM1 CONTAINS TRANSFORMATION CONSTANTS. +C + COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC +C +C THE COMMON BLOCK MAPCM2 CONTAINS AREA-SPECIFICATION VARIABLES. +C + COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG, + + BLAM,SLAM,BLOM,SLOM +C +C THE COMMON BLOCK MAPCM3 CONTAINS PARAMETERS HAVING TO DO WITH READING +C THE DATA FOR OUTLINES. +C + COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200) +C +C THE COMMON BLOCK MAPCM4 CONTAINS MOST OF THE INPUT PARAMETERS. +C + COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4, + + PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF, + + ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW +C + LOGICAL INTF,LBLF,PRMF,ELPF +C +C THE COMMON BLOCK MAPCM5 CONTAINS VARIOUS LISTS ("DICTIONARIES") OF +C TWO-CHARACTER CODES REQUIRED BY EZMAP FOR PARAMETER-SETTING. +C + COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10) +C + CHARACTER*2 DDCT,LDCT,PDCT +C +C THE COMMON BLOCK MAPCM7 CONTAINS PARAMETERS DESCRIBING THE PORTION OF +C THE PLOTTER FRAME BEING USED. +C + COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW +C +C THE COMMON BLOCK MAPCM8 CONTAINS PARAMETERS SET BY MAPTRN AND USED BY +C MAPIT IN HANDLING "CROSS-OVER" PROBLEMS. +C + COMMON /MAPCM8/ P,Q,R +C +C THE COMMON BLOCK MAPCMA CONTAINS VALUES WHICH ARE USED TO POSITION +C DOTS ALONG DOTTED OUTLINES AND TO AVOID DRAWING VECTORS WHICH ARE +C TOO SHORT. +C + COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL +C +C THE COMMON BLOCK MAPCMB CONTAINS THE EZMAP ERROR FLAG. +C + COMMON /MAPCMB/ IIER +C +C THE COMMON BLOCK MAPCMP CONTAINS THE BUFFERS IN WHICH THE X AND Y +C COORDINATES OF POINTS ARE COLLECTED FOR AN EVENTUAL CALL TO POINTS. +C + COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50) +C +C THE COMMON BLOCK MAPNTS CONTAINS QUANTITIES SPECIFYING THE INTENSITIES +C TO BE USED FOR VARIOUS PORTIONS OF THE PLOT. +C + COMMON /MAPNTS/ INTS(7) +C +C THE COMMON BLOCK MAPSAT CONTAINS PARAMETERS FOR THE SATELLITE-VIEW +C PROJECTION. +C + COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET +C +C +C BELOW ARE DESCRIPTIONS OF THE VARIABLES IN EACH OF THE COMMON BLOCKS, +C TOGETHER WITH DATA STATEMENTS GIVING DEFAULT VALUES TO THOSE VARIABLES +C WHICH NEED DEFAULT VARIABLES. +C +C +C VARIABLES IN MAPCM1: +C +C IPRJ IS AN INTEGER BETWEEN 1 AND 12, SPECIFYING WHAT PROJECTION IS +C CURRENTLY IN USE. THE VALUES 10, 11, AND 12 SPECIFY FAST-PATH +C VERSIONS OF THE VALUES 7, 8, AND 9, RESPECTIVELY. SINO, COSO, SINR, +C COSR, AND PHOC ARE PROJECTION VARIABLES COMPUTED BY MAPINT FOR USE BY +C MAPTRN. PHOC, AS IT HAPPENS, IS JUST A COPY OF PHIO, FROM THE COMMON +C BLOCK MAPCM4. +C +C +C VARIABLES IN MAPCM2: +C +C UMIN, UMAX, VMIN, AND VMAX SPECIFY THE LIMITS OF THE RECTANGLE TO BE +C DRAWN, IN PROJECTION SPACE. UEPS AND VEPS ARE SET BY MAPINT FOR USE +C IN MAPIT IN TESTING FOR CROSS-OVER PROBLEMS. UCEN, VCEN, URNG, AND +C VRNG ARE COMPUTED BY MAPINT FOR USE WHEN THE MAP PERIMETER IS MADE +C ELLIPTICAL (BY SETTING THE FLAG ELPF). BLAM, SLAM, BLOM, AND SLOM +C ARE RESPECTIVELY THE BIGGEST LATITUDE, THE SMALLEST LATITUDE, THE +C BIGGEST LONGITUDE, AND THE SMALLEST LONGITUDE ON THE MAP. THEY ARE +C USED IN MAPGRD AND IN MAPLOT TO MAKE THE DRAWING OF GRIDS AND OUTLINES +C MORE EFFICIENT. UMIN AND UMAX ARE GIVEN DEFAULT VALUES TO PREVENT +C IN MAPSTI AND MAPSTR FROM BLOWING UP WHEN PLTR IS SET PRIOR TO THE +C FIRST CALL TO MAPINT. +C + DATA UMIN,UMAX / 0.,1. / +C +C +C VARIABLES IN MAPCM3: +C +C ITPN IS THE UNIT NUMBER OF THE "TAPE" FROM WHICH OUTLINE DATA IS TO +C BE READ. NOUT IS THE NUMBER OF THE OUTLINE TO BE USED; THE VALUES 0 +C THROUGH 5 IMPLY 'NO', 'CO', 'US', 'PS', AND 'PO', RESPECTIVELY; THUS, +C IF NOUT IS ZERO, NO OUTLINES ARE TO BE USED, AND, IF IT IS NON-ZERO, +C IT IS THE NUMBER OF THE "FILE" TO BE READ FROM UNIT ITPN. NPTS, JUST +C AFTER A READ, IS THE NUMBER OF ELEMENTS READ INTO PNTS; IT IS THEN +C DIVIDED BY 2 TO BECOME THE NUMBER OF POINTS DEFINED BY THE GROUP JUST +C READ. IGID IS AN IDENTIFIER FOR THE GROUP, SO THAT, FOR EXAMPLE, ONE +C CAN DISTINGUISH A GROUP BELONGING TO A INTERNATIONAL BOUNDARY FROM +C ONE BELONGING TO A U.S. STATE BOUNDARY. BLAG, SLAG, BLOG, AND SLOG +C SPECIFY THE BIGGEST AND SMALLEST LATITUDE AND THE BIGGEST AND SMALLEST +C LONGITUDE OF THE POINTS IN THE GROUP, SO THAT, IN SOME CASES AT LEAST, +C ONE CAN DECIDE QUICKLY NOT TO BOTHER WITH THE GROUP. PNTS CONTAINS +C NPTS COORDINATE PAIRS, EACH CONSISTING OF A LATITUDE AND A LONGITUDE, +C IN DEGREES. +C + DATA ITPN,NOUT / 1,1 / +C +C +C VARIABLES IN MAPCM4: +C +C INTF IS A FLAG WHOSE VALUE AT ANY GIVEN TIME INDICATES WHETHER THE +C PACKAGE EZMAP IS IN NEED OF INITIALIZATION (.TRUE.) OR NOT (.FALSE). +C JPRJ IS AN INTEGER BETWEEN 1 AND 9 INDICATING THE TYPE OF PROJECTION +C CURRENTLY IN USE. PHIA, PHIO, AND ROTA ARE THE POLE LATITUDE AND +C LONGITUDE AND THE ROTATION ANGLE SPECIFIED BY THE LAST USER CALL TO +C MAPROJ. ILTS IS AN INTEGER BETWEEN 1 AND 5, SPECIFYING HOW THE LIMITS +C OF THE MAP ARE TO BE CHOSEN. PLA1-4 AND PLB1-4 ARE THE VALUES GIVEN +C BY THE USER FOR PLM1(1), PLM2(1), ..., PLM1(2), PLM2(2), ..., IN THE +C LAST CALL TO MAPSET. PLTR IS THE PLOTTER RESOLUTION - EFFECTIVELY, +C THE NUMBER OF ADDRESSABLE POINTS IN THE X DIRECTION. GRID IS THE +C DESIRED SPACING BETWEEN GRID LINES, IN DEGREES OF LATITUDE/LONGITUDE. +C IDSH IS THE DESIRED DASH PATTERN (16-BIT BINARY) FOR GRID LINES. IDOT +C IS A FLAG SELECTING SOLID OUTLINES (0) OR DOTTED OUTLINES (1). LBLF +C IS A LOGICAL FLAG INDICATING WHETHER THE INTERNATIONAL DATE LINE, THE +C EQUATOR, THE GREENWICH MERIDIAN, AND THE POLES ARE TO BE LABELLED OR +C NOT. PRMF IS A LOGICAL FLAG INDICATING WHETHER OR NOT A PERIMETER +C IS TO BE DRAWN. ELPF IS A LOGICAL FLAG INDICATING WHETHER THE MAP +C PERIMETER IS TO BE RECTANGULAR (.FALSE.) OR ELLIPTICAL (.TRUE.). +C XLOW, XROW, YBOW, AND YTOW ARE FRACTIONS BETWEEN 0. AND 1. SPECIFYING +C THE POSITION OF AREA OF THE PLOTTER FRAME IN WHICH THE MAP IS TO BE +C PUT; THE MAP IS CENTERED IN THIS AREA AND MADE AS LARGE AS POSSIBLE. +C IDTL IS A FLAG SPECIFYING THAT MAPIT SHOULD DRAW SOLID OUTLINES (0) +C OR DOTTEN OUTLINES (1). GRDR AND SRCH ARE MEASURED IN DEGREES AND +C LIE IN THE RANGE FROM .001 TO 10. GRDR SPECIFIES THE RESOLUTION WITH +C WHICH THE GRID IS TO BE DRAWN AND SRCH THE ACCURACY WITH WHICH THE +C LATITUDE/LONGITUDE LIMITS OF THE MAP ARE TO BE FOUND. ILCW IS THE +C CHARACTER WIDTH FOR CHARACTERS IN THE LABEL, AS REQUIRED FOR USE IN A +C CALL TO PWRIT. +C + DATA INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,PLB1,PLB2 / + 1 .TRUE., 7, 0., 0., 0., 1, 0., 0., 0., 0., 0., 0. / +C + DATA PLB3,PLB4, PLTR,GRID, IDSH,IDOT, LBLF , PRMF , ELPF ,IDTL / + 1 0., 0.,4096., 10.,21845, 0,.TRUE.,.TRUE.,.FALSE., 0 / +C + DATA XLOW,XROW,YBOW,YTOW / .05,.95,.05,.95 / +C + DATA GRDR,SRCH / 1.,1. / +C + DATA ILCW / 1 / +C +C +C VARIABLES IN MAPCM5: +C +C DDCT IS THE DICTIONARY OF AVAILABLE DATASETS, LDCT THE DICTIONARY OF +C MAP LIMIT DEFINITION TYPES, AND PDCT THE DICTIONARY OF MAP PROJECTION +C NAMES. +C + DATA DDCT / 'NO','CO','US','PS','PO' / +C + DATA LDCT / 'MA','CO','PO','AN','LI' / +C + DATA PDCT / 'LC','ST','OR','LE','GN','AE','CE','ME','MO','SV' / +C +C +C VARIABLES IN MAPCM7: +C +C ULOW, UROW, VBOW, AND VTOW DEFINE THE FRACTION OF THE PLOTTER FRAME +C TO BE OCCUPIED BY THE MAP - THEY MAY BE THOUGHT OF AS THE FIRST FOUR +C ARGUMENTS OF THE SET CALL OR, IN THE GKS SCHEME, AS THE VIEWPORT. +C THEY ARE COMPUTED BY MAPINT. ULOW AND UROW ARE GIVEN DEFAULT VALUES +C TO PREVENT CODE IN MAPSTI AND MAPSTR FROM BLOWING UP WHEN PLTR IS +C SET PRIOR TO THE FIRST CALL TO MAPINT. +C + DATA ULOW,UROW / 0.,1. / +C +C +C VARIABLES IN MAPCM8: +C +C P, Q, AND R ARE SET BY MAPTRN EACH TIME IT MAPS (RLAT,RLON) TO (U,V). +C Q IS ALWAYS EQUAL TO V, BUT P IS NOT ALWAYS EQUAL TO U. INSTEAD, IT +C IS A VALUE OF U FROM AN INTERMEDIATE STEP IN THE PROJECTION PROCESS. +C FOR THE LAMBERT CONFORMAL CONIC, P IS THE DISTANCE, IN LONGITUDE, FROM +C THE CENTRAL MERIDIAN. FOR THE CYLINDRICAL PROJECTIONS, P IS A VALUE +C OF U PRIOR TO MULTIPLICATION BY A FUNCTION OF V SHRINKING THE MAP +C TOWARD A VERTICAL BISECTOR. THEY ARE ALL USED BY MAPIT, WHILE DRAWING +C LINES FROM POINT TO POINT, TO DETECT "CROSS-OVER" (A JUMP FROM ONE +C SIDE OF THE MAP TO THE OTHER, CAUSED BY THE PROJECTION'S HAVING SLIT +C THE GLOBE ALONG SOME HALF OF A GREAT CIRCLE AND LAID IT OPEN WITH THE +C TWO SIDES OF THE SLIT AT OPPOSITE ENDS OF THE MAP). +C +C +C VARIABLES IN MAPCMA: +C +C DPLT IS THE MIMIMUM VECTOR LENGTH; MAPIT REQUIRES TWO POINTS TO BE AT +C LEAST DPLT PLOTTER UNITS APART BEFORE IT WILL JOIN THEM WITH A VECTOR. +C DDTS IS THE DESIRED DISTANCE IN PLOTTER UNITS BETWEEN DOTS IN A DOTTED +C OUTLINE. THESE VALUES ARE RELATIVE TO THE "PLOTTER RESOLUTION" PLTR; +C DPLT/PLTR IS A FRACTION OF THE PLOTTER FRAME. DSCA IS THE RATIO OF +C THE LENGTH OF A VECTOR, MEASURED IN PLOTTER UNITS, TO THE LENGTH OF +C THE SAME VECTOR, MEASURED IN THE U/V PLANE. THUS, GIVEN A VECTOR OF +C LENGTH D IN THE U/V PLANE, D*DSCA IS ITS LENGTH IN PLOTTER UNITS. +C DPSQ AND DSSQ ARE THE SQUARES OF DPLT AND DSCA, RESPECTIVELY. DBTD +C IS THE DISTANCE, IN THE U/V PLANE, BETWEEN TWO DOTS DDTS PLOTTER +C UNITS APART. DPLT AND DDTS HAVE THE VALUES GIVEN BELOW AND ARE NOT +C RESET BY THE CODE; DSCA, DPSQ, DSSQ, AND DBTD ARE COMPUTED BY MAPINT. +C DSCA IS GIVEN A DEFAULT VALUE ONLY TO KEEP THE ROUTINES MAPSTI AND +C MAPSTR FROM BLOWING UP WHEN DDTS IS SET PRIOR TO ANY CALL TO MAPINT. +C DATL IS USED BY MAPIT AND MAPVP TO KEEP TRACK OF WHERE THE NEXT POINT +C ALONG A CURVE SHOULD GO. +C + DATA DPLT,DDTS,DSCA / 4.,12.,1. / +C +C +C VARIABLES IN MAPCMB: +C +C IIER IS AN ERROR FLAG, SET WHENEVER AN ERROR OCCURS DURING A CALL TO +C ONE OF THE EZMAP ROUTINES. ITS VALUE MAY BE RETRIEVED BY A CALL TO +C MAPGTI. +C + DATA IIER / 0 / +C +C +C VARIABLES IN MAPCMP: +C +C NPTB IS THE NUMBER OF POINTS WHOSE COORDINATES HAVE BEEN COLLECTED IN +C THE ARRAYS XPTB AND YPTB FOR EVENTUAL OUTPUT BY A CALL TO POINTS. +C + DATA NPTB / 0 / +C +C VARIABLES IN MAPNTS: +C +C THE ARRAY INTS SPECIFIES INTENSITIES TO BE USED FOR THE PERIMETER, FOR +C THE GRID, FOR LABELLING, FOR LIMBS, FOR THE CONTINENTAL OUTLINES, FOR +C THE U.S. STATE OUTLINES, AND FOR INTERNATIONAL POLITICAL OUTLINES. +C SEE THE ROUTINE MAPCHI. EACH ELEMENT IS AN INTEGER IN THE RANGE 0 TO +C 255, INCLUSIVE. +C + DATA INTS / 240,150,210,240,240,180,210 / +C +C +C VARIABLES IN MAPSAT: +C +C THE ABSOLUTE VALUE OF SALT, IF GREATER THAN 1, SERVES AS A FLAG THAT +C A SATELLITE-VIEW PROJECTION IS TO BE USED IN PLACE OF AN ORTHOGRAPHIC +C PROJECTION; ITS VALUE IS THE DISTANCE OF THE SATELLITE FROM THE CENTER +C OF THE EARTH, IN UNITS OF EARTH RADII. IN THIS CASE, SSMO IS THE +C SQUARE OF SALT MINUS 1 AND SRSS IS THE SQUARE ROOT OF SSMO. IF ALFA +C IS ZERO, THE PROJECTION SHOWS THE VIEW SEEN BY A SATELLITE LOOKING +C STRAIGHT AT THE CENTER OF THE EARTH; CALL THIS THE BASIC SATELLITE +C VIEW. IF ALFA IS NON-ZERO, IT AND BETA ARE ANGLES, IN DEGREES, +C DETERMINING WHERE THE LINE OF SIGHT OF THE PROJECTION IS. IF E IS +C AT THE CENTER OF THE EARTH, S IS AT THE SATELLITE, AND P IS A POINT +C ALONG THE LINE OF SIGHT, THEN ALFA MEASURES THE ANGLE ESP. IF O IS +C THE POINT AT THE ORIGIN OF THE BASIC SATELLITE VIEW AND P IS THE +C PROJECTION OF THE LINE OF SIGHT, THEN BETA MEASURES THE ANGULAR +C DISTANCE FROM THE POSITIVE U AXIS TO THE LINE OP, POSITIVE IF +C MEASURED COUNTER-CLOCKWISE. SALF, CALF, SBET, AND CBET ARE SINES +C AND COSINES OF ALFA AND BETA. THE SIGN OF SALT INDICATES WHETHER A +C NORMAL PROJECTION (POSITIVE) OR AN EXTENDED PROJECTION (NEGATIVE) +C IS TO BE USED. THE LATTER MAKES IT EASIER TO OVERLAY CONREC OUTPUT +C ON ONE OF THESE PROJECTIONS, BY PROJECTING POINTS OUT OF SIGHT AROUND +C THE LIMB TO POINT JUST OUTSIDE THE LIMB ON THE PROJECTED VIEW. +C + DATA SALT,ALFA,BETA,SALF,CALF,SBET,CBET / 0.,0.,0.,0.,1.,0.,1. / +C +C REVISION HISTORY: +C +C FEBRUARY, 1982 ADDED MODIFICATIONS SO THAT POINTS GENERATED BY THE +C DRAWING OF DOTTED CONTINENTAL OUTLINES ARE BUFFERED +C AND THEN PUT OUT WITH A CALL TO POINTS, INSTEAD OF +C BEING PUT OUT ONE AT A TIME WITH A CALL TO POINT AS +C BEFORE. THE LATTER RESULTED IN HUGE OVERHEAD IN THE +C PLOT FILE. ROUTINES MAPLOT AND MAPVP WERE MODIFIED, +C AND A NEW COMMON BLOCK MAPCMP WAS ADDED. +C +C AUGUST, 1984 CONVERTED TO FORTRAN-77 AND GKS. DELETED THE EZMAP +C ENTRY POINT. +C +C MARCH, 1985 COMPLETELY OVERHAULED THE CODE TO SIMPLIFY IT AND TO +C REMOVE KNOWN ERRORS. UPDATED THE OUTLINE DATASET +C TO REMOVE ERRORS AND TO INCLUDE INTERNATIONAL +C BOUNDARIES. IMPLEMENTED MANY CONTROLS AIMED AT +C OBVIATING THE NEED FOR SOURCE MODIFICATION BY USERS. +C +C MAY, 1985 ADDED CODE TO PREVENT PROBLEMS WHEN A SMOOTHING +C VERSION OF THE DASH PACKAGE IS LOADED. ADDED CODE +C IN MAPIT TO GET AROUND A CFT COMPILER PROBLEM. +C ADDED CODE TO DO EXTENDED ORTHOGRAPHIC AND SATELLITE- +C VIEW PROJECTIONS. +C +C JULY, 1985 FIXED A MISSING DECLARATION IN THE SUBROUTINE MAPSET +C AND LIMITED "CALL PLOTIT (0,0,0)" TO THE GKS VERSION. +C +C AUGUST, 1985 FIXED A PROBLEM IN MAPGRD WHICH CAUSED MERIDIANS ON +C MERCATOR MAPS WITH VERTICAL LIMITS TOO CLOSE TO THE +C POLES TO BE DRAWN IMPROPERLY. (THE TEST FOR CROSS- +C OVER, IN MAPIT, WAS BEING PASSED BECAUSE THE POINTS +C USED TO DRAW THE MERIDIANS WERE TOO FAR APART.) ALSO +C FIXED AN ERROR IN THE GKS CODE IN MAPCHI AND BEEFED +C UP THE IMPLEMENTORS' INSTRUCTIONS TO SAY WHAT TO DO +C WITH THAT ROUTINE WHEN COLOR IS AVAILABLE. +C +C NOVEMBER, 1985 ADDED CODE TO PREVENT GKS CLIPPING FROM DESTROYING +C PART OF THE PERIMETER. +C + END |