* Last processed by NICE on 12-Jun-2000 15:54:00 * Customized for : IEEE, LINUX, UNIX, MOTIF, F77 PROGRAM ONOFF_TASK * * This is the main program of the gildas task ONOFF. * * Adapted from A.Sievers program and F.Motte nic procedure * Algorythm of noise reduction from T.Snidjers * INCLUDE 'const.inc' INCLUDE 'inc:memory.inc' INCLUDE 'onoff.inc' * * * Shared memory parameters * INTEGER*4 POINTER INTEGER*4 IADDRRECORD ! address of shared memory area INTEGER*4 IP,IPSUBSCAN,IPRECORD ! index in memory area INTEGER*4 IP_EPOCH INTEGER*4 IP_SIGWEI, IP_FLUX_ONF, IP_FLUX_RMS INTEGER*4 IP_DELTA_RA, IP_DELTA_DEC, IP_INDEX INTEGER*4 IP_DELTA_AZ, IP_DELTA_EL INTEGER*4 IP_MEAN_ON, IP_MEAN_OFF INTEGER*4 IP_X0, IP_Y0, IP_Z0, IP_X1, IP_Y1 INTEGER*4 IP_YSUBS, IP_YSUBS_SIG, IP_FLAGSUB INTEGER*4 IP_SNOISEM, IP_SNOISEW INTEGER*4 IP_AZOFF, IP_ELOFF, IP_FLAG, IP_GAIN,IP_NSUBREC INTEGER*4 IP_LST, IP_AZ, IP_EL, IP_SIGNAL INTEGER*4 IP_PARAM, IP_PHASES INTEGER*4 IP_X, IP_Y, IP_Z, IP_W, IP_SELCHAN INTEGER*4 IP_SIGFIT, IP_FITMETHOD,IP_DIST,IP_NEWSIGNAL INTEGER*4 IP_FLAGONOFF, IP_SOURCE_CHAN INTEGER*4 IP_XCOO,IP_YCOO INTEGER*4 IADDR INTEGER SIC_GETVM,IER * INTEGER DATA_SHMID ! shared memory identifier INTEGER N_RECEIVERS,NPARAM_RECEIVER,NPARAM_SUBSCAN INTEGER LENGTH INTEGER NFIT PARAMETER (NFIT=3) ! 3 methods to fit noise REAL RMS_FIT(NFIT) * * * Read gildas parameters * CALL GILDAS_OPEN CALL GILDAS_INTE('DATA_SHMID$',DATA_SHMID,1) CALL GILDAS_INTE('NSUBSCAN$',NSUBSCAN,1) CALL GILDAS_INTE('NRECORD$',NRECORD,1) * CALL GILDAS_INTE('SCAN_TYPE$',SCAN_TYPE,1) IF (SCAN_TYPE.NE.1) THEN WRITE(6,*) $ 'Observing mode is not "ON_OFF". Cannot run ONOFF' CALL GILDAS_CLOSE STOP ENDIF CALL GILDAS_INTE('SCAN_NUMBER$',SCAN_NUMBER,1) CALL GILDAS_INTE('NCHAN$',NCHAN,1) CALL GILDAS_CHAR('SNAM$',SNAM) CALL GILDAS_REAL('SLAM$',SLAM,1) CALL GILDAS_REAL('OLAM$',OLAM,1) CALL GILDAS_REAL('SBET$',SBET,1) CALL GILDAS_REAL('OBET$',OBET,1) CALL GILDAS_INTE('COORD_SYST$',COORD_SYST,1) CALL GILDAS_REAL('EPOCH$',EPOCH,1) CALL GILDAS_INTE('DATE_OBSERV$',DATE_OF_OBSERVATION,1) CALL GILDAS_REAL('OAZM$',OAZM,1) CALL GILDAS_REAL('OELV$',OELV,1) CALL GILDAS_REAL('WOBBLER_THROW$',WOBBLER_THROW,1) CALL GILDAS_REAL('UNBAL$',UNBAL,1) CALL GILDAS_DBLE('SITE_LATITUDE$',SITE_LATITUDE,1) CALL GILDAS_DBLE('SITE_LONGITUDE$',SITE_LONGITUDE,1) * CALL GILDAS_LOGI('JANSKY_FLAG$',JANSKY_FLAG,1) CALL GILDAS_LOGI('NOISE_FLAG$',NOISE_FLAG,1) CALL GILDAS_LOGI('NOISE$',NOISE,1) CALL GILDAS_INTE('ONOFF_MODE$',ONOFF_MODE,1) CALL GILDAS_INTE('FORMAT$',FORMAT,1) CALL GILDAS_INTE('COMPUTE$',COMPUTE,1) CALL GILDAS_INTE('ONOFF_FIT$',FIT_TYPE,1) CALL GILDAS_REAL('ONOFF_FIT_DIST$',FIT_DIST,1) CALL GILDAS_CHAR('ONOFF_FILE$',ONOFF_FILE) CALL GILDAS_REAL('BOLGAIN$',REF_GAIN,1) CALL GILDAS_INTE('REF_CHAN$',REF_CHAN,1) CALL GILDAS_CHAR('TELESCOPE$',TELESCOPE) CALL GILDAS_REAL('ONOFF_BEAM$',ONOFF_BEAM_RADIUS,1) CALL GILDAS_INTE('FIELD_ROTATION$',FIELD_ROTATION,1) CALL GILDAS_CLOSE * IF (ONOFF_MODE.EQ.0) THEN WRITE(6,*) '*** ONOFF_MODE undefined ***' STOP ENDIF * * Link to data shared memory * C+WIN32 c CALL OPEN_SHARED_MEMORY(DATA_SHMID) C-WIN32 CALL ATTACH_MEMORY(DATA_SHMID,IADDRRECORD) IP = POINTER(IADDRRECORD,MEMORY) CALL R4TOR4(MEMORY(IP),N_RECEIVERS,1) CALL R4TOR4(MEMORY(IP+1),NPARAM_RECEIVER,1) CALL R4TOR4(MEMORY(IP+2),NPARAM_SUBSCAN,1) IP_PARAM = IP+3 IP_AZOFF = IP_PARAM IP_ELOFF = IP_AZOFF + NCHAN IP_FLAG = IP_ELOFF + NCHAN IP_GAIN = IP_FLAG + 2*NCHAN IPSUBSCAN = IP_PARAM + NPARAM_RECEIVER*NCHAN IP_EPOCH = IPSUBSCAN + NSUBSCAN IP_NSUBREC = IPSUBSCAN + 3*NSUBSCAN IPRECORD = IPSUBSCAN + NPARAM_SUBSCAN *NSUBSCAN IP_LST = IPRECORD IP_AZ = IPRECORD + NRECORD IP_EL = IPRECORD + 2*NRECORD IP_SIGNAL = IPRECORD + 3*NRECORD IP_XCOO = IPRECORD+(3+N_RECEIVERS)*NRECORD IP_YCOO = IPRECORD+(4+N_RECEIVERS)*NRECORD * * * Allocate memory * * NPAIRS = NSUBSCAN/2 IF (TELESCOPE(1:3).EQ.'CSO') NPAIRS=NRECORD/2 LENGTH = NCHAN*NRECORD + 17*NCHAN + NSUBSCAN + 3*NPAIRS $+ 3*NCHAN*NSUBSCAN +(3+2+NFIT)*NRECORD + NCHAN*NCHAN +NCHAN IER = SIC_GETVM(LENGTH,IADDR) IF (IER.NE.1) THEN WRITE(6,*) ' *** Unable to allocate memory (2)***' WRITE(6,*) 'ier=',IER STOP ENDIF IP = POINTER(IADDR,MEMORY) IP_SIGWEI = IP IP_NEWSIGNAL= IP + NRECORD IP_PHASES = IP_NEWSIGNAL+ NCHAN*NRECORD IP_FLUX_ONF = IP_PHASES + 2*NRECORD IP_FLUX_RMS = IP_FLUX_ONF + NCHAN IP_DELTA_RA = IP_FLUX_RMS + NCHAN IP_DELTA_DEC= IP_DELTA_RA + NCHAN IP_DELTA_AZ = IP_DELTA_DEC+ NCHAN IP_DELTA_EL = IP_DELTA_AZ + NCHAN IP_FLAGONOFF= IP_DELTA_EL + NCHAN IP_INDEX = IP_FLAGONOFF+ NCHAN IP_MEAN_ON = IP_INDEX + NSUBSCAN IP_MEAN_OFF = IP_MEAN_ON + NCHAN IP_X0 = IP_MEAN_OFF + NCHAN IP_Y0 = IP_X0 + NPAIRS IP_Z0 = IP_Y0 + NPAIRS IP_X1 = IP_Z0 + NPAIRS IP_Y1 = IP_X1 + NCHAN IP_YSUBS = IP_Y1 + NCHAN IP_YSUBS_SIG= IP_YSUBS + NCHAN*NSUBSCAN IP_FLAGSUB = IP_YSUBS_SIG+ NCHAN*NSUBSCAN IP_SNOISEM = IP_FLAGSUB + NCHAN*NSUBSCAN IP_SNOISEW = IP_SNOISEM + NRECORD*NFIT IP_SIGFIT = IP_SNOISEW + NRECORD IP_X = IP_SIGFIT + NRECORD IP_Y = IP_X + NCHAN IP_Z = IP_Y + NCHAN IP_W = IP_Z + NCHAN IP_SELCHAN = IP_W + NCHAN IP_FITMETHOD= IP_SELCHAN + NCHAN IP_DIST = IP_FITMETHOD+ NCHAN IP_SOURCE_CHAN = IP_DIST + NCHAN*NCHAN * * Copy channel flags in memory(ip_flagonoff) CALL R4TOR4(MEMORY(IP_FLAG), MEMORY(IP_FLAGONOFF),NCHAN) * * * Initialize index(nsubscan) CALL INIT_INDEX(MEMORY(IP_NSUBREC),MEMORY(IP_INDEX),NSUBSCAN) * * * Compute onoff flux * IF (TELESCOPE(1:3).NE.'CSO') THEN ! Pico Veleta CALL ONOFF_FLUX (MEMORY(IP_SIGNAL),MEMORY(IP_NEWSIGNAL), $ MEMORY(IP_SIGWEI), $ MEMORY(IP_FLUX_ONF),MEMORY(IP_FLUX_RMS),MEMORY(IP_INDEX), $ MEMORY(IP_NSUBREC),MEMORY(IP_MEAN_ON),MEMORY(IP_MEAN_OFF), $ MEMORY(IP_X0),MEMORY(IP_Y0),MEMORY(IP_Z0), $ MEMORY(IP_X1),MEMORY(IP_Y1), $ MEMORY(IP_YSUBS),MEMORY(IP_YSUBS_SIG), $ MEMORY(IP_FLAGSUB),MEMORY(IP_SNOISEM), $ MEMORY(IP_SNOISEW),MEMORY(IP_FLAGONOFF), $ MEMORY(IP_AZOFF),MEMORY(IP_ELOFF), $ MEMORY(IP_X),MEMORY(IP_Y),MEMORY(IP_Z),MEMORY(IP_W), $ MEMORY(IP_SELCHAN),MEMORY(IP_PHASES), $ MEMORY(IP_FITMETHOD),MEMORY(IP_SIGFIT),RMS_FIT, $ MEMORY(IP_DIST),MEMORY(IP_SOURCE_CHAN), $ MEMORY(IP_XCOO),MEMORY(IP_YCOO),MEMORY(IP_EL),NFIT) ELSE CALL ONOFF_FLUX_SHARC (MEMORY(IP_SIGNAL), $ MEMORY(IP_FLUX_ONF),MEMORY(IP_FLUX_RMS), $ MEMORY(IP_X0),MEMORY(IP_Y0), $ MEMORY(IP_FLAGONOFF)) ENDIF * * * Compute alpha and delat offsets * * CALL ONOFF_RADEC (MEMORY(IP_LST),MEMORY(IP_SIGWEI), $MEMORY(IP_EL),MEMORY(IP_AZ), $MEMORY(IP_AZOFF),MEMORY(IP_ELOFF), $MEMORY(IP_DELTA_RA),MEMORY(IP_DELTA_DEC), $MEMORY(IP_DELTA_AZ),MEMORY(IP_DELTA_EL), $MEMORY(IP_SNOISEM),MEMORY(IP_EPOCH)) * * * Write results * CALL ONOFF_RESULT ( $MEMORY(IP_FLUX_ONF),MEMORY(IP_FLUX_RMS), $MEMORY(IP_DELTA_RA),MEMORY(IP_DELTA_DEC), $MEMORY(IP_DELTA_AZ),MEMORY(IP_DELTA_EL), $MEMORY(IP_YSUBS),MEMORY(IP_YSUBS_SIG), $MEMORY(IP_GAIN),MEMORY(IP_FITMETHOD)) * STOP END * ******************************************************************** * SUBROUTINE INIT_INDEX(NSUBREC,INDX,NSUBSCAN) * INTEGER INDX(1),NSUBREC(1) INTEGER NSUBSCAN INTEGER I * INDX(1) = 1 DO I=2,NSUBSCAN INDX(I) = INDX(I-1)+NSUBREC(I-1) ENDDO END