CD-Doc: C. CD-end CD-Section: Getting LDM Parameter Values C The data in the Laue data module must only be accessed via a set of C supplied routines to make its use independent of the actual way the C data values are stored internally. Each LDM parameter has its C own routine which should be used where efficient access is required. C There is also a general routine to retrieve a parameter value C for a given LDM keyword string CD-end C LAST UPDATE: C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C************************** C** LDM_GET ** C************************** C CD-Routine: General Routine to Get LDM Parameter Value - LDM_GET C This routine will return the value of any LDM parameter except for C the 'SYMMETRY' parameter. The parameter value is returned as string, C and where relevant as a real or integer value. The symmetry data may C only be returned via the specific LDM_GET_SYMM routine. For AXORD only C the string is returned and not IORD or ISWAP CD-end CD-Fortran: SUBROUTINE LDM_GET (KEYWORD, IPACK, IPLATE, VALSTR, VALUE, ND, + IVAL, IFLAG, ITYP, IERR, ERRSTR) CD-end INCLUDE 'implicit_none.finc' C C Purpose: Get an LDM parameter value using the parsed keyword C information. Parameter returned as string, and where C relevant real or integer value. (All except SYMMETRY) C C Author: John W. Campbell, June 1993 C C Arguments: C CHARACTER*(*) KEYWORD INTEGER IPACK INTEGER IPLATE CHARACTER*(*) VALSTR REAL VALUE INTEGER ND INTEGER IVAL INTEGER IFLAG INTEGER ITYP INTEGER IERR CHARACTER*(*) ERRSTR CD-Parameters: C KEYWORD c (R) Full keyword string (upper case) C Note: All LDM keywords valid excepy SYMMETRY. C The symmetry data may only be returned C via the specific LDM_GET_SYMM routine. C C For AXORD only the string is returned and C not IORD or ISWAP C IPACK i (R) Pack number (explicit) if relevant for the parameter C IPLATE i (R) Plate number (explicit) if relevant for the parameter C VALSTR i (W) The value returned as a string (max 120 chars) C VALUE r (W) The parameter value as a real number for 'real number' C parameters. C ND i (W) The number of decimal places to be printed for 'real C number' parameters (-ve for E format) C IVAL i (W) The parameter value as an integer for integer parameters C IFLAG i (W) The status of the parameter value =-1 undefined C = 0 default C = 1 set explicitly C = 2 set globally C ITYP i (W) = 0 string value returned C = 1 string value and integer code C = 2 integer value (string also returned) C = 3 real value (string also returned) C = 4 LDM extended integer parameter C = 5 LDM extended float parameter C = 6 LDM extended single token string parameter C = 7 LDM extended multiple token string parameter C = 8 LDM extended variable array parameter C IERR i (W) Error flag = 0 OK C = 1 Invalid keyword C = -1 Invalid pack number C = -2 Invalid plate number C = -3 Invalid polynomial coefficient number C = -4 Any error from extended LDM keyword C ERRSTR c (W) Returns string for error message (max. 80 chars) C C Note: for an extended LDM parameter, only the first integer or C real value will be returned for any parameter which has C more than one value. Also the value string length of C 120 may not be adequate in all cases. Special purpose C routines should be written to get values for such C parameters (or use KDMF_GETVALUE calls directly) CD-end C C====== Parameter statements C C C====== GLOBALS: C INCLUDE 'ldm_data.finc' INCLUDE 'ldm_extended.finc' EXTERNAL LDM_BDAT C C====== FUNCTION TYPES: C INTEGER LDM_SPD_PAR INTEGER KDMSTR INTEGER LENSTR C C====== LOCALS: C INTEGER IORD INTEGER KERR INTEGER NUM_INP INTEGER ISWAP INTEGER ICOEFF REAL SVAL(LDM_MAXSPD) C C------------------------------------------------------------------------------- C C====== Initialisations C VALSTR = ' ' VALUE = 0.0 ND = 0 IVAL = 0 IFLAG = -1 ITYP = 0 IERR = 0 ERRSTR = ' ' C C====== Find keyword and set value C IF (KEYWORD.EQ.'CRYSTAL') THEN CALL LDM_GET_CRYST (VALSTR, IFLAG) ITYP = 0 RETURN ELSE IF (KEYWORD.EQ.'TITLE') THEN CALL LDM_GET_TITLE (VALSTR, IFLAG) ITYP = 0 RETURN ELSE IF (KEYWORD.EQ.'SYSTEM') THEN CALL LDM_GET_SYST (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'LATTICE') THEN CALL LDM_GET_LATT (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'SYMMETRY') THEN IERR = 1 ERRSTR = 'Cannot use LDM_GET for symmetry keyword' RETURN ELSE IF (KEYWORD.EQ.'BEAM_AXIS') THEN CALL LDM_GET_BEAM (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'ROTATION_AXIS') THEN CALL LDM_GET_ROT (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'IMAGE_TYPE') THEN CALL LDM_GET_IMTYP (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'IMAGE_DATA') THEN CALL LDM_GET_IMDAT (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'DGEOM') THEN CALL LDM_GET_DGEOM (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'AXORD') THEN CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG) ITYP = 0 RETURN ELSE IF (KEYWORD.EQ.'FIDTYPE') THEN CALL LDM_GET_FIDT (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'FIDX1') THEN CALL LDM_GET_FIDX1 (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'FIDY1') THEN CALL LDM_GET_FIDY1 (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'FIDX2') THEN CALL LDM_GET_FIDX2 (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'FIDY2') THEN CALL LDM_GET_FIDY2 (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'FIDX3') THEN CALL LDM_GET_FIDX3 (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'FIDY3') THEN CALL LDM_GET_FIDY3 (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'NXRAST') THEN CALL LDM_GET_NXRAS (IVAL, IFLAG) ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'NYRAST') THEN CALL LDM_GET_NYRAS (IVAL, IFLAG) ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'RASTER_SIZE') THEN CALL LDM_GET_RAST (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'RMIN') THEN CALL LDM_GET_RMIN (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'RMAX') THEN CALL LDM_GET_RMAX (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'XLOW') THEN CALL LDM_GET_XLOW (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'XHIGH') THEN CALL LDM_GET_XHIGH (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'YLOW') THEN CALL LDM_GET_YLOW (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'YHIGH') THEN CALL LDM_GET_YHIGH (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'DISTORTION_TYPE') THEN CALL LDM_GET_DSTOR (VALSTR, IVAL, IFLAG) ITYP = 1 RETURN ELSE IF (KEYWORD.EQ.'FTHRESH') THEN CALL LDM_GET_FTHR (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'FIDBOX') THEN CALL LDM_GET_FBOX (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'STHRESH') THEN CALL LDM_GET_STHR (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'OVERLOAD_PIXEL') THEN CALL LDM_GET_OVPIX (IVAL, IFLAG) ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'NUMPACK') THEN CALL LDM_GET_NUMP (IVAL, IFLAG) ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'NPLATES') THEN CALL LDM_GET_NPLAT (IVAL, IFLAG) ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'TEMPLATE') THEN CALL LDM_GET_TEMPL (VALSTR, IFLAG) ITYP = 0 RETURN ELSE IF (KEYWORD.EQ.'SPOT_EPSILON') THEN CALL LDM_GET_EPS (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'DTILT') THEN CALL LDM_GET_DTILT (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'N1OD') THEN CALL LDM_GET_N1OD (IVAL, IFLAG) ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'G1OD') THEN CALL LDM_GET_G1OD (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'BASEOD') THEN CALL LDM_GET_BASE (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'NONLINEARITY') THEN CALL LDM_GET_NONL (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'DSPIN') THEN CALL LDM_GET_DSPIN (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPINDLE') THEN CALL LDM_GET_SPIN (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'PACK_ID') THEN CALL LDM_GET_PID (IPACK, IVAL, IFLAG, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'KEYPLATE') THEN CALL LDM_GET_KEYP (IPACK, IVAL, IFLAG, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'FILENAME') THEN CALL LDM_GET_FNAME (IPACK, IPLATE, VALSTR, IFLAG, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 0 RETURN ELSE IF (KEYWORD.EQ.'X_CEN_F') THEN CALL LDM_GET_XCENF (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'Y_CEN_F') THEN CALL LDM_GET_YCENF (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPACING') THEN CALL LDM_GET_SPAC (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'A') THEN CALL LDM_GET_A (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'B') THEN CALL LDM_GET_B (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'C') THEN CALL LDM_GET_C (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'ALPHA') THEN CALL LDM_GET_ALPHA (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'BETA') THEN CALL LDM_GET_BETA (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'GAMMA') THEN CALL LDM_GET_GAMMA (VALUE, IFLAG, ND) ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'LMIN') THEN CALL LDM_GET_LMIN (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'LMAX') THEN CALL LDM_GET_LMAX (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'DMIN') THEN CALL LDM_GET_DMIN (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'PHIX') THEN CALL LDM_GET_PHIX (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'PHIY') THEN CALL LDM_GET_PHIY (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'PHIZ') THEN CALL LDM_GET_PHIZ (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'CTOF') THEN CALL LDM_GET_CTOF (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'Y_SCALE') THEN CALL LDM_GET_YSCAL (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPOT_LENGTH') THEN CALL LDM_GET_SPOTL (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPOT_WIDTH') THEN CALL LDM_GET_SPOTW (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPOT_FACTOR') THEN CALL LDM_GET_SPOTF (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPOT_BORDER') THEN CALL LDM_GET_SPOTB (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPOT_DELTA') THEN CALL LDM_GET_SPOTD (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'X_C') THEN CALL LDM_GET_XC (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'Y_C') THEN CALL LDM_GET_YC (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'W_C') THEN CALL LDM_GET_WC (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'TWIST') THEN CALL LDM_GET_TWIST (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'TILT') THEN CALL LDM_GET_TILT (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'BULGE') THEN CALL LDM_GET_BULGE (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'ROFF') THEN CALL LDM_GET_ROFF (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'TOFF') THEN CALL LDM_GET_TOFF (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPDXY') THEN CALL LDM_GET_SPDXY (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPDX_N') THEN CALL LDM_GET_SPDXN (IPACK, IPLATE, IVAL, IFLAG, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'SPDX_MIN') THEN CALL LDM_GET_SXMIN (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPDX_MAX') THEN CALL LDM_GET_SXMAX (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (LDM_SPD_PAR(1,KEYWORD).GT.0) THEN ICOEFF = LDM_SPD_PAR(1,KEYWORD) CALL LDM_GET_SPDX (ICOEFF, IPACK, IPLATE, SVAL, IFLAG, ND, + IERR, ERRSTR) VALUE = SVAL(1) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPDY_N') THEN CALL LDM_GET_SPDYN (IPACK, IPLATE, IVAL, IFLAG, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 2 GO TO 400 ELSE IF (KEYWORD.EQ.'SPDY_MIN') THEN CALL LDM_GET_SYMIN (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'SPDY_MAX') THEN CALL LDM_GET_SYMAX (IPACK, IPLATE, VALUE, IFLAG, ND, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (LDM_SPD_PAR(2,KEYWORD).GT.0) THEN ICOEFF = LDM_SPD_PAR(2,KEYWORD) CALL LDM_GET_SPDY (ICOEFF, IPACK, IPLATE, SVAL, IFLAG, ND, + IERR, ERRSTR) VALUE = SVAL(1) IF (IERR.NE.0) RETURN ITYP = 3 GO TO 500 ELSE IF (KEYWORD.EQ.'RFL') THEN CALL LDM_GET_RFL (IPACK, IPLATE, IVAL, IFLAG, + IERR, ERRSTR) IF (IERR.NE.0) RETURN ITYP = 2 GO TO 400 ELSE IF (EXTENDED) THEN CALL KDMF_GETVALUE (KDX_EXT, KDMSTR(KEYWORD), + LENSTR(KEYWORD), IPACK, IPLATE, + LEN(VALSTR), KDMSTR(VALSTR), + KDM_FVALS, KDM_ND, KDM_IVALS, NUM_INP, + IFLAG, ITYP, KDMSTR(ERRSTR), + LEN(ERRSTR), KERR) ITYP = ITYP + 3 IVAL = KDM_IVALS(1) VALUE = KDM_FVALS(1) ND = KDM_ND(1) IF (KERR.NE.0) IERR = -4 RETURN END IF IERR = 1 ERRSTR = 'Invalid LDM keyword' END IF RETURN C C====== Create string from integer value C 400 VALSTR = ' ' CALL STR_ADDI (VALSTR, IVAL, 0) RETURN C C====== Create string from a real value C 500 VALSTR = ' ' CALL STR_ADDF (VALSTR, VALUE, ND, 0) RETURN END