C LAST UPDATE: C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C*************************** C** LFN_SHOW_XDL ** C*************************** C CD-Routine: List Refined Values for XDL_VIEW - LFN_SHOW_XDL C This routine is used to list the refined parameter values to an XDL_VIEW C I/O window. CD-end CD-Fortran: SUBROUTINE LFN_SHOW_XDL (IVH, IPACK, IPLATE, RMS, OLD_RMS) CD-end INCLUDE 'implicit_none.finc' C C Purpose: List refined parameter values to an xdl_view i/o window C C Author: John W. Campbell, September 1993 C C Arguments: C INTEGER IVH INTEGER IPACK INTEGER IPLATE REAL RMS REAL OLD_RMS CD-Parameters: C IVH i (R) View-object handle for the xdl_view i/o window C IPACK i (R) Pack number C IPLATE i (R) Plate number C ITERM i (R) =1, o/p to terminal, =0 o/p to file C RMS r (R) rms error after the refinement C OLD_RMS r (R) rms error before the refinement (will not be o/p C if 0.0 given) CD-end C C====== Parameter statements C C C====== GLOBALS: C INCLUDE 'refine_limits.finc' INCLUDE 'refine_data.finc' INCLUDE 'refobs_list.finc' C C====== FUNCTION TYPES: C INTEGER LENSTR INTEGER XDLSTR C C====== LOCALS: C INTEGER KFLAG INTEGER KERR INTEGER ND INTEGER I INTEGER J INTEGER DISTOR_TYPE INTEGER NSPDX INTEGER NSPDY REAL SPD_XY REAL SPDX_MIN REAL SPDX_MAX REAL SPDY_MIN REAL SPDY_MAX REAL SPDX(MAX_SPD) REAL SPDY(MAX_SPD) REAL VALUE CHARACTER*2 VALSTR CHARACTER*2 ERRSTR CHARACTER*80 STR C INTEGER KFLAG !Parameter status flag C INTEGER KERR !Error flag C INTEGER ND !No. of decimal places flag C INTEGER I !Loop variable C INTEGER J !Loop variable C INTEGER DISTOR_TYPE !Distortion type flag C INTEGER NSPDX !Spatial distortion x polynomial order C INTEGER NSPDY !Spatial distortion y polynomial order C REAL SPD_XY !Spatial distortion xy correction C REAL SPDX_MIN !Spatial distortion chebyshev x lower bound C REAL SPDX_MAX !Spatial distortion chebyshev x upper bound C REAL SPDY_MIN !Spatial distortion chebyshev y lower bound C REAL SPDX_MAX !Spatial distortion chebyshev y upper bound C REAL SPDX(MAX_SPD) !Spatial distortion x polynomial coeffts C REAL SPDY(MAX_SPD) !Spatial distortion y polynomial coeffts C REAL VALUE !Parameter value C CHARACTER*2 VALSTR !Parameter value string (dummy) C CHARACTER*2 ERRSTR !Error string (dummy) C CHARACTER*80 STR !Output string C C------------------------------------------------------------------------------- C CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, KFLAG) STR = 'PhiX =' CALL LDM_GET_PHIX (IPACK, VALUE, KFLAG, ND, KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,2,1) CALL STR_ADDS(STR,' PhiY =',1) CALL LDM_GET_PHIY (IPACK, VALUE, KFLAG, ND, KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,2,1) CALL STR_ADDS(STR,' PhiZ =',1) CALL LDM_GET_PHIZ (IPACK, VALUE, KFLAG, ND, KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,2,1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) STR = 'c_to_f =' CALL LDM_GET_CTOF (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,2,1) CALL STR_ADDS(STR,' x_c =',1) CALL LDM_GET_XC (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL STR_ADDS(STR,' y_c =',1) CALL LDM_GET_YC (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL STR_ADDS(STR,' w_c =',1) CALL LDM_GET_WC (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL STR_ADDS(STR,' y_scale =',1) CALL LDM_GET_YSCAL (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) IF (REFINE_CELL) THEN STR = 'Cell:' CALL LDM_GET_A (VALUE, KFLAG, ND) CALL STR_ADDF(STR,VALUE,2,1) CALL LDM_GET_B (VALUE, KFLAG, ND) CALL STR_ADDF(STR,VALUE,2,1) CALL LDM_GET_C (VALUE, KFLAG, ND) CALL STR_ADDF(STR,VALUE,2,1) CALL LDM_GET_ALPHA (VALUE, KFLAG, ND) CALL STR_ADDF(STR,VALUE,2,1) CALL LDM_GET_BETA (VALUE, KFLAG, ND) CALL STR_ADDF(STR,VALUE,2,1) CALL LDM_GET_GAMMA (VALUE, KFLAG, ND) CALL STR_ADDF(STR,VALUE,2,1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) END IF IF (REFINE_DSTOR) THEN STR = 'y_scale =' CALL LDM_GET_YSCAL (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL STR_ADDS(STR,'twist =',1) CALL LDM_GET_TWIST (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL STR_ADDS(STR,'tilt =',1) CALL LDM_GET_TILT (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) IF (DISTOR_TYPE.EQ.1) THEN STR = 'bulge' CALL LDM_GET_BULGE (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,3,1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) ELSE IF (DISTOR_TYPE.EQ.2) THEN STR ='roff =' CALL LDM_GET_ROFF (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,1,1) CALL STR_ADDS(STR,'toff =',1) CALL LDM_GET_TOFF (IPACK, IPLATE, VALUE, KFLAG, ND, + KERR, ERRSTR) CALL STR_ADDF(STR,VALUE,1,1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) END IF END IF IF (REFINE_SPD) THEN IF (DISTOR_TYPE.EQ.3) THEN CALL LDM_SPDXY (IPACK, IPLATE, SPD_XY, + NSPDX, SPDX_MIN, SPDX_MAX, SPDX, + NSPDY, SPDY_MIN, SPDY_MAX, SPDY, + MAX_SPD, KERR, ERRSTR) STR = 'spdxy =' CALL STR_ADDF(STR,SPD_XY,-3,1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) I = 0 J = 0 100 I = I + 1 IF (I.GT.NSPDX.OR.I.GT.MAX_SPD) GO TO 110 IF (J.EQ.0) THEN STR = 'spdx' ELSE CALL STR_ADDS(STR,'spdx',1) END IF CALL STR_ADDI(STR,I,0) CALL STR_ADDS(STR,'=',1) CALL STR_ADDF(STR, SPDX(I),-3,1) J = J + 1 IF (J.EQ.3) THEN CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) J = 0 END IF GO TO 100 110 IF (J.GT.0) THEN CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) END IF I = 0 J = 0 120 I = I + 1 IF (I.GT.NSPDY.OR.I.GT.MAX_SPD) GO TO 130 IF (J.EQ.0) THEN STR = 'spdy' ELSE CALL STR_ADDS(STR,'spdy',1) END IF CALL STR_ADDI(STR,I,0) CALL STR_ADDS(STR,'=',1) CALL STR_ADDF(STR, SPDY(I),-3,1) J = J + 1 IF (J.EQ.3) THEN CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) J = 0 END IF GO TO 120 130 IF (J.GT.0) THEN CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) END IF END IF END IF C C====== Output refined and previous rms values C STR = 'RMS =' CALL STR_ADDF(STR, RMS, 3, 1) CALL STR_ADDS(STR, 'mm. for the', 1) CALL STR_ADDI(STR, NUM_REF_OBS, 1) CALL STR_ADDS(STR,'spots used in the refinement',1) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) IF (OLD_RMS.GT.0.0) THEN STR = '(from' CALL STR_ADDF(STR,OLD_RMS, 3,1) CALL STR_ADDS(STR,')',0) CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(STR), + LENSTR(STR), 2, KERR) END IF RETURN END