; FILE:    prog_hr_mvc60.ips
; PURPOSE: Make a high resolution magnetogram from a 60 sec observation
;	   2 double scans each in LCP and RCP
;	   Downlink either:
;		mag + continuum filtergram (sqrt comp)	4b002000 & 40083e00
;		mag + average line depth 		4b002000 & 44033e00
;			(OR)
;		mag + average dopplergram		4b002000 & 4a022e00
; METHOD:
;		LCP in page 0 & 6
;		RCP in page 1 & 4
;		FC  in page 3 & 5 (Si)
;		F1,2,3,4 in page 2 (Sd)
;
;		VEL-RCP in page 5
;		LINE-DEP (RCP) in page 17
;		VEL-LCP in page 15
;		LINE-DEP (LCP) in page 18
;		LINE-DEP (Avg) in page 19	
;		LINE-DEP (Avg) extracted in 18	compress into page 13
;
;		MAG in page 6			extracted into page 4
;		VEL-AVG in page 7		extracted into page 15
;
;		CONT flgram 1024 extract in page 0
;		CONT flgram extract to 19	compress into page 17
; HISTORY: Written 27-Feb-96 by M.Morrison
;	29-Feb-96 (MDM) - Removed the continuum observable calculation
;			- Added filtergram continuum
;	 4-Mar-96 (MDM) - Changed shift count on LDEPTH instruction from 10 to 8
;			- Removed the sqrt compression of the LDEPTH observable (new DPC 44033e00)
;			- Changed LDEPTH compression from e2 to e3
;			- Shifted some page usage around
;	 5-Mar-96 (MDM) - Changed the shift count and sqrt table used by LDEPTH instruction
;			- Added the square-root compression again

QPROG_HR_MC60::
    SETREGS $IPRL_DL_PARAM 2 0x8800 0x2000			;downlink continuum and mag
    GOTO &INCOMING_IMG

QPROG_HR_ML60::
    SETREGS $IPRL_DL_PARAM 2 0x6800 0x2000			;downlink line-depth and mag
    GOTO &INCOMING_IMG

QPROG_HR_MV60::
    SETREGS $IPRL_DL_PARAM 2 0x7800 0x2000			;downlink avg-dop and mag

INCOMING_IMG:
    COPYRD2D $IPRL_EXTRACT_80K $IPRL_EXTRACT_PARAM 6            ;setup the parameters to be used by the extract subroutine

    BRANCHEQ R3072  18 &FRM18
    BRANCHEQ R3072  19 &FRM19
    BRANCHEQ R3072  20 &FRM20
    END

FRM18:

    ;---- Make RCP velocity
    SETREGS $IPRL_VEL_PARAM   8  1:0x00514  4:0x00514  5:0x00726  3 127    
    SETREGS $IPRL_VEL_PARAM+8 6  1 0xe5  0x4a00 0x2000   1 16
    CALLQUE $QSR_MK_VEL						;1.7 sec

    ;---- Line depth (for RCP)
    SETREGS  $IPRL_LDEP_PARAM    9 1:0x00514  4:0x00514 17:0x00726 7  127  7
    SETREGS  $IPRL_LDEP_PARAM+9  3 0xe4 0x4400 0x2000
    CALLQUE  $QSR_MK_LDEP					;0.6 sec

    END

FRM19:
    ;---- Make LCP velocity
    SETREGS $IPRL_VEL_PARAM   8  0:0x00514  6:0x00514  15:0x00726  3 127    
    SETREGS $IPRL_VEL_PARAM+8 6  1 0xe5  0x4a01 0x2000   1 16
    CALLQUE $QSR_MK_VEL						;1.7 sec

    ;---- Line depth (for LCP)
    SETREGS  $IPRL_LDEP_PARAM    9 0:0x00514  6:0x00514 18:0x00726 7  127  7
    SETREGS  $IPRL_LDEP_PARAM+9  3 0xe4 0x4401 0x2000
    CALLQUE  $QSR_MK_LDEP					;0.6 sec

    ;---- Make the average line depth
    SETREGS  $IPRL_SUMDIFF_PARAM  10  17:0x00726 18:0x00726 19:0x00726   16   0xe3 0x4404 0x2000	;??? 16???
    CALLQUE  $QSR_DO_SUM					;0.3 sec

    ;---- Extract line depth
    SETREGS  $IPRL_EXTRACT_INST 4  19:0x0726 18:0x0726          ;setup source/destination page of the extract
    CALLQUE  $QSR_FMT_EXTRACT                           	;0.3 sec 

    END

FRM20:
    ;---- Continuum filtergram (get it out of the way for next page 3 write)

    SETREGS  $IPRL_FLTGRAM_PARAM 4 3:0x0000 0:0x0226            ;set source page and destination pages
    SETREGS  $IPRL_FLTGRAM_PARAM+8 3 0xe2   0x4008 0x2000       ;last three words are n/k, dpc(h,l)
    CALLQUE  $QSR_MK_FLTGRAM					;0.3 sec


    ;vvvvvvvvvvvvvvvvvvv could be done at FRAME19, but want it done in order

    ;---- Compress the line-depth
    SETREGS  $IPRL_SQRT_PARAM    4  18:0x00726 13:0x0726
    CALLQUE  $QSR_SQRT_COMP					;0.3 sec

    ;---- Subtract two velocities to make the mag
    SETREGS $IPRL_MAG_PARAM    6  5:0x00726  15:0x00726  6:0x00726
    SETREGS $IPRL_MAG_PARAM+6  5  0x100000L  1  0xFFFF  13
    SETREGS $IPRL_MAG_PARAM+11 3  0xe4 0x4b00 0x2000
    CALLQUE $QSR_MK_MAG						;0.3 sec

    ;---- Make the average dopplergram
    SETREGS  $IPRL_SUMDIFF_PARAM  10  5:0x00726  15:0x00726  7:0x00726   13   0xe4 0x4a02 0x2000
    CALLQUE  $QSR_DO_SUM					;0.3 sec

    ;---- Extract the mag and avg-dop data

    SETREGS  $IPRL_EXTRACT_INST 4 6:0x0726 4:0x0726             ;setup source/destination page of the extract
    CALLQUE  $QSR_FMT_EXTRACT                                   ;extract the image   	0.3 sec 

    SETREGS  $IPRL_EXTRACT_INST 4 7:0x0726 15:0x0726            ;setup source/destination page of the extract
    CALLQUE  $QSR_FMT_EXTRACT                                   ;extract the image	0.3 sec

    ;^^^^^^^^^^^^^^^^^^^ could be done at FRAME19, but want it done in order

    ;---- Extract continuum and square-root it
    SETREGS  $IPRL_EXTRACT_INST  4  0:0x00226  19:0x0726	;setup source/destination page of the extract
    CALLQUE  $QSR_FMT_EXTRACT                                   ;extract the image   	0.3 sec 

    SETREGS  $IPRL_SQRT_PARAM    4  19:0x00726 17:0x0726
    CALLQUE  $QSR_SQRT_COMP					;0.3 sec

    ;---- Downlink the two observables
    CALLQUE $QSR_DL_2PAGE					;0.6 sec
END