diff options
Diffstat (limited to 'sys/gio/ncarutil/conlib/conop1.f')
| -rw-r--r-- | sys/gio/ncarutil/conlib/conop1.f | 465 |
1 files changed, 465 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/conlib/conop1.f b/sys/gio/ncarutil/conlib/conop1.f new file mode 100644 index 00000000..fc61872d --- /dev/null +++ b/sys/gio/ncarutil/conlib/conop1.f @@ -0,0 +1,465 @@ + SUBROUTINE CONOP1 (IOPT) +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 SET THE CONTRAN OPTIONS +C +C INPUT +C IOPT-CHARACTER STRING OF OPTION VALUE +C +C SET COMMON DATA EQUAL TO INPUT DATA +C +C +C + COMMON /CONRA1/ CL(30) ,NCL ,OLDZ ,PV(210) , + 1 FINC ,HI ,FLO + COMMON /CONRA2/ REPEAT ,EXTRAP ,PER ,MESS , + 1 ISCALE ,LOOK ,PLDVLS ,GRD , + 2 CINC ,CHILO ,CON ,LABON , + 3 PMIMX ,SCALE ,FRADV ,EXTRI , + 4 BPSIZ ,LISTOP + COMMON /CONRA3/ IREC + COMMON /CONRA4/ NCP ,NCPSZ + COMMON /CONRA5/ NIT ,ITIPV + COMMON /CONRA6/ XST ,YST ,XED ,YED , + 1 STPSZ ,IGRAD ,IG ,XRG , + 2 YRG ,BORD ,PXST ,PYST , + 3 PXED ,PYED ,ITICK + COMMON /CONRA7/ TITLE ,ICNT ,ITLSIZ + COMMON /CONRA8/ IHIGH ,INMAJ ,INLAB ,INDAT , + 1 LEN ,IFMT ,LEND , + 2 IFMTD ,ISIZEP ,INMIN + COMMON /CONRA9/ ICOORD(500),NP ,MXXY ,TR , + 1 BR ,TL ,BL ,CONV , + 2 XN ,YN ,ITLL ,IBLL , + 3 ITRL ,IBRL ,XC ,YC , + 4 ITLOC(210) ,JX ,JY ,ILOC , + 5 ISHFCT ,XO ,YO ,IOC ,NC + COMMON /CONR10/ NT ,NL ,NTNL ,JWIPT , + 1 JWIWL ,JWIWP ,JWIPL ,IPR , + 2 ITPV + COMMON /CONR11/ NREP ,NCRT ,ISIZEL , + 1 MINGAP ,ISIZEM , + 2 TENS + COMMON /CONR12/ IXMAX ,IYMAX ,XMAX ,YMAX + LOGICAL REPEAT ,EXTRAP ,PER ,MESS , + 1 LOOK ,PLDVLS ,GRD ,LABON , + 2 PMIMX ,FRADV ,EXTRI ,CINC , + 3 TITLE ,LISTOP ,CHILO ,CON + COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD, + 1 SLDPLT + LOGICAL SHIELD,SLDPLT + COMMON /CONR14/LINEAR + LOGICAL LINEAR + COMMON /CONR15/ ISTRNG + CHARACTER*64 ISTRNG + COMMON /CONR16/ FORM + CHARACTER*10 FORM + COMMON /CONR17/ NDASH, IDASH, EDASH + CHARACTER*10 NDASH, IDASH, EDASH + COMMON /RANINT/ IRANMJ, IRANMN, IRANTX + COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX + COMMON /RASINT/ IRASMJ, IRASMN, IRASTX +C +C +C +C INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE +C NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF +C CONFLICT +C + COMMON /INTPR/ IPAU ,FPART ,TENSN ,NP11 , + 1 SMALL ,L1 ,ADDLR ,ADDTB , + 2 MLLINE ,ICLOSE + CHARACTER*7 IOPT + CHARACTER*2 TAG, OPT +C +C + SAVE +C +c +NOAO - initialize block data before changing any values + call conbdn +c -NOAO +C DETERMINE OPTION AND ITS VALUE +C + TAG = IOPT(1:2) + IF (IOPT(3:3) .EQ. '=') THEN + OPT = IOPT(4:5) + ELSE + OPT = IOPT(5:6) + ENDIF +C +C REP FOUND CHECK VALUE OF SWITCH +C + IF (TAG .EQ. 'RE') THEN +C +C SWITCH = ON CONTOUR SAME DATA +C + IF (OPT .EQ. 'ON') THEN + REPEAT = .TRUE. + RETURN +C +C SWITCH = OFF CONTOUR NEW DATA +C + ELSEIF (OPT .EQ. 'OF') THEN + REPEAT = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C EXTRAPOLATION FLAG +C + ELSEIF (TAG .EQ. 'EX') THEN +C +C SWITCH = ON EXTRAPOLATE WHEN CONTOURING +C + IF (OPT .EQ. 'ON') THEN + EXTRAP = .TRUE. + RETURN +C +C SWITCH = OFF INTERPOLATE ONLY +C + ELSEIF (OPT .EQ. 'OF') THEN + EXTRAP = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C PER FOUND SET PERIMETER +C + ELSEIF (TAG .EQ. 'PE') THEN +C +C SWITCH = ON DRAW PERIMETERS +C + IF (OPT .EQ. 'ON') THEN + PER = .TRUE. +C +C TURN GRID OFF, USER WANTS PERIMETER +C + GRD = .FALSE. + RETURN +C +C SWITCH = OFF DO NOT DRAW PERIMETERS +C + ELSEIF (OPT .EQ. 'OF') THEN + PER = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C DEF FOUND SET ALL OPTIONS TO DEFAULT (NO SWITCHES) +C + ELSEIF (TAG .EQ. 'DE') THEN + PER = .TRUE. + LISTOP = .FALSE. + PMIMX = .FALSE. + SCALE = 1. + TENSN = TENS + EXTRAP = .FALSE. + TITLE = .FALSE. + ITLSIZ = 16 + REPEAT = .FALSE. + MESS = .TRUE. + CON = .FALSE. + CINC = .FALSE. + CHILO = .FALSE. + IGRAD = IG + ISCALE = 0 + NCP = 4 + LOOK = .FALSE. + GRD = .FALSE. + PLDVLS = .FALSE. + INMAJ = 1 + INMIN = 1 + INDAT = 1 + INLAB = 1 + IRANMJ = 1 + IRANMN = 1 + IRANTX = 1 + IRASMJ = 1 + IRASMN = 1 + IRASTX = 1 + IRAQMJ = 1 + IRAQMN = 1 + IRAQTX = 1 + BPSIZ = 0. + LABON = .TRUE. + ISIZEL = 9 + ISIZEP = 8 + ISIZEM = 15 + FRADV = .TRUE. + EXTRI = .FALSE. + MINGAP = 3 + LINEAR = .FALSE. + ICOUNT = 0 + SHIELD = .FALSE. + SLDPLT = .FALSE. +C +C SET DEFAULT DASH PATTERN +C + IDASH = '$$$$$$$$$$' + NDASH = '$$$$$$$$$$' + EDASH = '$$$$$$$$$$' +C +C SET DEFAULT FORMAT +C + FORM = '(G10.3)' + RETURN +C +C MES FOUND TEST VALUE OF SWITCH +C + ELSEIF (TAG .EQ. 'ME') THEN +C +C ACTIVATE CONRAN MESSAGE +C + IF (OPT .EQ. 'ON') THEN + MESS = .TRUE. + RETURN +C +C TURN OFF CONRAN MESSAGE +C + ELSEIF (OPT .EQ. 'OF') THEN + MESS = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C SCALING OPTION GET VALUE OF SWITCH +C + ELSEIF (TAG .EQ. 'SC') THEN +C +C SET VALUE OF SCALE FLAG +C + IF (OPT .EQ. 'ON') THEN + ISCALE = 0 + RETURN + ELSEIF (OPT .EQ. 'OF') THEN + ISCALE = 1 + RETURN + ELSEIF (OPT .EQ. 'PR') THEN + ISCALE = 2 + RETURN + ELSE + GOTO 120 + ENDIF +C +C TRIANGLE FLAG GET VALUE OF SWITCH +C + ELSEIF (TAG .EQ. 'TR') THEN +C +C SWITCH ON +C + IF (OPT .EQ. 'ON') THEN + LOOK = .TRUE. + RETURN +C +C SWITCH OFF +C + ELSEIF (OPT .EQ. 'OF') THEN + LOOK = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C PLOT DATA VALUES FLAG GET VALUE OF SWITCH +C + ELSEIF (TAG .EQ. 'PD') THEN +C +C SWITCH ON +C + IF (OPT .EQ. 'ON') THEN + PLDVLS = .TRUE. + RETURN +C +C SWITCH OFF +C + ELSEIF (OPT .EQ. 'OF') THEN + PLDVLS = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C GRID OPTION ACTIVATED GET VALUE OF SWITCH +C + ELSEIF (TAG .EQ. 'GR') THEN +C +C SWITCH ON SET GRID FLAG +C + IF (OPT .EQ. 'ON') THEN + GRD = .TRUE. +C +C TURN PER OFF USER WANTS GRID +C + PER = .FALSE. + RETURN +C +C SWITCH OFF CLEAR GRID FLAG +C + ELSEIF (OPT .EQ. 'OF') THEN + GRD = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C LABEL PLOTTING FLAG GET VALUE OF SWITCH +C + ELSEIF (TAG .EQ. 'LA') THEN +C +C SWITCH ON LABEL CONTOURS +C + IF (OPT .EQ. 'ON') THEN + LABON = .TRUE. + RETURN +C +C SWITCH OFF DON"T LABEL CONTOURS +C + ELSEIF (OPT .EQ. 'OF') THEN + LABON = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C PLOT THE RELATIVE MIN"S AND MAX"S +C + ELSEIF (TAG .EQ. 'PM') THEN +C +C SWTICH ON PLOT THE INFO +C + IF (OPT .EQ. 'ON') THEN + PMIMX = .TRUE. + RETURN +C +C SWTICH OFF DO NOT PLOT THE INFO +C + ELSEIF (OPT .EQ. 'OF') THEN + PMIMX = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C ADVANCE FRAME BEFORE TRIANGULATION PLOT +C + ELSEIF (TAG .EQ. 'TF') THEN +C +C SWITCH ON ADVANCE FRAME +C + IF (OPT .EQ. 'ON') THEN + FRADV = .TRUE. + RETURN +C +C SWITCH OFF DO NOT ADVANCE FRAME +C + ELSEIF (OPT .EQ. 'OF') THEN + FRADV = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C EXIT AFTER TRIANGULATION +C + ELSEIF (TAG .EQ. 'TO') THEN +C +C SWITCH ON EXIT AFTER TRIANGULATION +C + IF (OPT .EQ. 'ON') THEN + EXTRI = .TRUE. + LOOK = .TRUE. + FRADV = .FALSE. + RETURN +C +C SWITCH OFF DO NOT EXIT AFTER TRIANGULATION +C + ELSEIF (OPT .EQ. 'OF') THEN + FRADV = .TRUE. + LOOK = .FALSE. + EXTRI = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C LIST OPTION GET VALUE OF SWITCH +C + ELSEIF (TAG .EQ. 'LO') THEN +C +C ON SET LIST OPTIONS FLAG +C + IF (OPT .EQ. 'ON') THEN + LISTOP = .TRUE. + RETURN +C +C TURN OFF LIST OPTIONS FLAG +C + ELSEIF (OPT .EQ. 'OF') THEN + LISTOP = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C SET THE INTERPOLATION SCHEME +C + ELSEIF (TAG .EQ. 'IT') THEN +C +C SET TO C1 SURFACE +C + IF (OPT .EQ. 'C1') THEN + LINEAR = .FALSE. + RETURN +C +C SET TO LINEAR INTERPOLATION +C + ELSEIF (OPT .EQ. 'LI') THEN + LINEAR = .TRUE. + RETURN + ELSE + GOTO 120 + ENDIF +C +C SET THE SHIELD PLOT FLAG +C + ELSEIF (TAG .EQ. 'PS') THEN +C +C TURN ON SHIELD PLOT +C + IF (OPT .EQ. 'ON') THEN + SLDPLT = .TRUE. + RETURN +C +C TURN OFF SHIELD PLOT +C + ELSEIF (OPT .EQ. 'OF') THEN + SLDPLT = .FALSE. + RETURN + ELSE + GOTO 120 + ENDIF + ELSE + GOTO 120 + ENDIF +C +C ERROR UNDEFINED OPTION DETECTED +C + 120 CALL SETER (' CONOP1 -- UNDEFINED OPTION',1,1) + RETURN +C + END |