* Last processed by NICE on 12-Jun-2000 15:54:00 * Customized for : IEEE, LINUX, UNIX, MOTIF, F77 C makplan_main.f * SUBROUTINE MAKPLAN(SUBSCAN_NUMBER,SUBSCAN_EPOCH,SUBSCAN_TIME, $SUBSCAN_IFIRST,SUBSCAN_ILAST, $LST,SIGNAL, $XCOORD,YCOORD, $ROW_D,ROW_W,MAP_D,MAP_W,RECEIVER_FLAG,IFUN) * * C Data description * INCLUDE 'inc:xpar.inc' INCLUDE 'inc:format.inc' INCLUDE 'inc:memory.inc' INCLUDE 'makplan.inc' INCLUDE 'const.inc' INCLUDE 'parameter.inc' * INTEGER*4 SUBSCAN_NUMBER(1) REAL*4 SUBSCAN_EPOCH(1) REAL*4 SUBSCAN_TIME(1) INTEGER*4 SUBSCAN_IFIRST(1) ! index of first record of the subscan INTEGER*4 SUBSCAN_ILAST(1) ! index of last record of the subscan * * REAL*4 LST(1) REAL*4 SIGNAL(1) * REAL*4 XCOORD(1) REAL*4 YCOORD(1) * REAL*4 ROW_D(1) ! regridded row (data) REAL*4 ROW_W(1) ! regridded row (weight) REAL*4 MAP_D(1) ! regridded map (data) REAL*4 MAP_W(1) ! regridded map (weight) * LOGICAL RECEIVER_FLAG(1) * INTEGER*4 POINTER, IP * INTEGER BLC(4), TRC(4) INTEGER I,ISUBSCAN,IMAP,II INTEGER ICHAN,IFUN INTEGER IFIRST,ILAST INTEGER NP_SUBSCAN REAL*8 W_MIN,W_MAX REAL*8 ALOW,ALIM REAL OFFSET REAL MAXMIN(8) REAL XLIMIT LOGICAL ERROR * DATA BLC /0,0,0,0/, TRC /0,0,0,0/ * * C --- Identify first record and last record for each subscan XLIMIT = ABS(XMIN) IF (XLIMIT.LT.ABS(XMAX)) XLIMIT=XMAX XLIMIT = XLIMIT/3600 ! in degrees CALL FIND_SUBSCAN_LIMIT(LST,SUBSCAN_TIME, $SUBSCAN_IFIRST,SUBSCAN_ILAST,XCOORD,YCOORD, $XLIMIT,SINT,NSUBSCAN,NRECORD) * * * -- Initialize convolving function * CALL FUNGEN(FUNC,IFUN) C C C -- Raz array DO I = 1,NCOL*NROW*NCHANNEL MAP_D(I) = 0 MAP_W(I) = 0 ENDDO * * * * C CALCULATE NCHANNEL MAPS C ------------------------ * DO ICHAN=1,NCHANNEL IMAP = 1 + (ICHAN-1)*NCOL*NROW IF (.NOT.RECEIVER_FLAG(ICHAN)) THEN DO ISUBSCAN=1,NSUBSCAN IFIRST = SUBSCAN_IFIRST(ISUBSCAN) ILAST = SUBSCAN_ILAST(ISUBSCAN) IF (IFIRST.NE.0 .AND. ILAST.NE.0) THEN NP_SUBSCAN = ILAST-IFIRST+1 OFFSET = ((-1)**(ISUBSCAN-1))*ZIGZAG*10. * DO I=IFIRST,ILAST ! already done in zigzag_correction * XCOORD(I) = XCOORD(I)+OFFSET * IF (FLIP) XCOORD(I) = -XCOORD(I) * ENDDO * c -- c Nasmith ---> Az/El rotation c Output XGRID,YGRID (rotated XGRID,YGRID) and ZGRID (ori. XGRID) c -- * * ! The subroutine azcon regrids the data in azimuth, and * ! places the resultant scan into the array row_d. * * CALL AZCON(ROW_D(1),ROW_W(1), $ SIGNAL(IFIRST+(ICHAN-1)*NRECORD), $ XCOORD(IFIRST),NP_SUBSCAN,IFUN) * * * * ! The subroutine ELCON makes the az-el map from the azimuth * ! scans by convolution of the data onto the number grid of * ! the map array 'mapd_e' * ! In the process it noise-filters in * ! the elevation direction and regrids the data to allow * ! for an elevation offset. * ! Input : * ! - mapd_a, mapw_a: data and weight after gridding in azimuth * ! Output : * ! - mapd_e, mapw_e: data and weight after gridding in elevation * IF (SMOOTH_EL.OR.(NROW.NE.NSUBSCAN)) THEN CALL ELCON(ROW_D(1), ROW_W(1), $ MAP_D(IMAP), MAP_W(IMAP), $ YCOORD(IFIRST),IFUN) ELSE * !copy row_d and row_w in maps_el and mapw (nrow=nsubscan) II = (ISUBSCAN-1)*NCOL + (ICHAN-1)*NCOL*NROW DO I=1,NCOL MAP_D(II+I) = ROW_D(I) * ROW_W(I) MAP_W(II+I) = ROW_W(I) ENDDO ENDIF * * * ENDIF ENDDO * * C --- Compute maximum and minimum weight W_MIN = 0 W_MAX = 0 CALL WMAX(MAP_D(IMAP),MAP_W(IMAP), $ W_MAX,W_MIN,BLANKING,NCOL*NROW) * C --- Normalize : C divide by weight C flagge data if weight < 0.1*w_max (original value: 0.2*w_max) C or weight < 0.5*w_min (weight negative) C ALIM = 0.1*W_MAX ALOW = 0.5*W_MIN CALL MNORM(MAP_D(IMAP),MAP_W(IMAP), $ ALIM,ALOW,BLANKING,NCOL*NROW,1.) * ELSE ! flagged channel DO I = 1,NCOL*NROW MAP_D(IMAP+I-1) = BLANKING ENDDO ENDIF ENDDO * * restore xcoord (remove zigzag correction) DO ISUBSCAN=1,NSUBSCAN IFIRST = SUBSCAN_IFIRST(ISUBSCAN) ILAST = SUBSCAN_ILAST(ISUBSCAN) OFFSET = ((-1)**(ISUBSCAN-1))*ZIGZAG*10. IF (IFIRST.NE.0 .AND. ILAST.NE.0) THEN DO I=IFIRST,ILAST ! restore xcoord IF (FLIP) XCOORD(I) = -XCOORD(I) XCOORD(I) = XCOORD(I)-OFFSET ENDDO ENDIF ENDDO * C --- make GILDAS image file * CALL MAXMIN_IMAGE (MAP_D(1),NCOL,NROW,NCHANNEL,MAXMIN) X_NDIM = 3 IF (.NOT.JANSKY_FLAG) THEN X_UNIT = ' Counts' ELSE IF (MAXMIN(2).LT.2) THEN X_UNIT = ' mJy' DO ICHAN = 1,NCHANNEL IMAP = 1 + (ICHAN-1)*NCOL*NROW CALL NORM3(MAP_D(IMAP),MAP_W(IMAP), $ ALIM,ALOW,BLANKING,NCOL*NROW) ENDDO CALL MAXMIN_IMAGE (MAP_D(1),NCOL,NROW,NCHANNEL,MAXMIN) ELSE X_UNIT = ' Jy' ENDIF ENDIF X_DIM(1) = NCOL X_DIM(2) = NROW X_DIM(3) = NCHANNEL X_DIM(4) = 1 X_SIZE = X_DIM(1)*X_DIM(2)*X_DIM(3)*X_DIM(4) * X_REF1 = 1 X_VAL1 = -ABS(XMIN)*SEC_TO_RAD X_INC1 = XINC*SEC_TO_RAD * X_REF2 = 1 IF (SMOOTH_EL.OR.(NROW.NE.NSUBSCAN)) THEN X_VAL2 = -ABS(OELV)*DEG_TO_RAD X_INC2 = YINC*SEC_TO_RAD ELSE X_VAL2 = OELV*DEG_TO_RAD X_INC2 = -SIGN(1.,OELV)*YINC*SEC_TO_RAD ENDIF * X_REF3 = 0 X_VAL3 = 0 X_INC3 = 1 * X_REF4 = 0 X_VAL4 = 0 X_INC4 = 1 * X_TYPE = 'GILDAS_IMAGE' X_NAME = SNAM X_FORM = FMT_R4 X_GENE = 29 X_SYST = 'AZIMUTHAL' X_BLAN = 2 X_BVAL = BLANKING X_EVAL = 0. X_EXTR = 10 X_RMIN = MAXMIN(1) X_RMAX = MAXMIN(2) X_MIN1 = MAXMIN(3) X_MIN2 = MAXMIN(4) X_MIN3 = MAXMIN(5) X_MAX1 = MAXMIN(6) X_MAX2 = MAXMIN(7) X_MAX3 = MAXMIN(8) X_MIN4 = 1 X_MAX4 = 1 * X_DESC = 18 X_POSI = 12 X_RA = SLAM*DEG_TO_RAD X_DEC = SBET*DEG_TO_RAD X_PROJ = 9 X_SPEC = 12 X_RESO = 3 X_FREQ = FREQUENCY/1.D6 ! frequency in Mhz * SNAM = ' ' WRITE (SNAM(1:4),'(i4.4)') SCAN_NUMBER CALL SIC_LOWER (SNAM) CALL SIC_PARSEF(SNAM,X_FILE,' ','.mdb') CALL GDF_GEIS (X_ISLO,ERROR) ! reserve slot CALL GDF_WRITX (X_ISLO,ERROR) CALL GDF_CRIS (X_ISLO,X_TYPE,X_FILE,X_FORM,X_SIZE,ERROR) CALL GDF_GEMS (X_MSLO,X_ISLO,BLC,TRC,X_ADDR,X_FORM,ERROR) IP = POINTER (X_ADDR,MEMORY) CALL R4TOR4(MAP_D(1),MEMORY(IP),NCOL*NROW*NCHANNEL) CALL GDF_FRIS (X_ISLO,ERROR) * RETURN END