* Last processed by NICE on 12-Jun-2000 15:54:00 * Customized for : IEEE, LINUX, UNIX, MOTIF, F77 * PROGRAM CONVERT_TASK * ========================= * * This is the main program of the gildas task CONVERT * * INCLUDE 'inc:xpar.inc' INCLUDE 'inc:ypar.inc' INCLUDE 'inc:format.inc' INCLUDE 'inc:memory.inc' INCLUDE 'const.inc' INCLUDE 'convert.inc' INCLUDE 'parameter.inc' * C Shared memory parameters INTEGER*4 POINTER INTEGER*4 IPSUBSCAN,IPRECORD,IP ! index in memory area INTEGER*4 IADDR,IPMAP,IP_PARAM,IPSCAN INTEGER*4 IP_SUBPARAM,IP_WORK,IP_OFFSET,IP_RADEC INTEGER*4 IP_RECEIVER_FLAG,IP_RECEIVER_RMS INTEGER SIC_GETVM INTEGER DATA_SHMID ! shared memory identifier * INTEGER IER ! error status INTEGER N_XY * INTEGER SCAN_TYPE, IFUN * REAL*4 MAXMIN(8) LOGICAL ERROR CHARACTER FILE*40, SCAN_LIST*256, MAP_UNIT*12 INTEGER BLC(4), TRC(4) INTEGER LEN_STRING,I,J REAL*4 ZERO REAL YMAX INTEGER LENC INTEGER N_RECEIVERS,NPARAM_RECEIVER,NPARAM_SUBSCAN CHARACTER*12 INPUT_TYPE ! ekh or saa * DATA BLC /0,0,0,0/, TRC /0,0,0,0/ * * Read gildas parameters * CALL GILDAS_OPEN CALL GILDAS_INTE('DATA_SHMID$',DATA_SHMID,1) * CALL GILDAS_INTE('NRECORD$',NRECORD,1) CALL GILDAS_INTE('NSUBSCAN$',NSUBSCAN,1) * CALL GILDAS_INTE('SCAN_NUMBER$',SCAN_NUMBER,1) SCAN_LIST=' ' CALL GILDAS_CHAR('SCAN_LIST$',SCAN_LIST) CALL GILDAS_INTE('SCAN_TYPE$',SCAN_TYPE,1) IF (SCAN_TYPE.NE.2 .AND. SCAN_LIST.EQ.' ') THEN WRITE(6,*) $ 'Observing mode is not "ON_THE_FLY". Cannot run CONVERT' CALL GILDAS_CLOSE STOP ENDIF * CALL GILDAS_INTE('NCHAN$',NCHANNEL,1) CALL GILDAS_DBLE('FREQUENCY$',FREQUENCY,1) CALL GILDAS_CHAR('SNAM$',SNAM) CALL GILDAS_DBLE('SLAM$',SLAM,1) CALL GILDAS_DBLE('SBET$',SBET,1) CALL GILDAS_REAL('OLAM$',OLAM,1) CALL GILDAS_REAL('OBET$',OBET,1) CALL GILDAS_DBLE('EPOCH$',EPOCHFR,1) CALL GILDAS_REAL('OAZM$',OAZM,1) CALL GILDAS_REAL('OELV$',OELV,1) CALL GILDAS_REAL('SINT$',SINT,1) IF (SINT.EQ.0 .AND. SCAN_LIST.EQ.' ') THEN WRITE(6,*) $ 'X-interval is 0 (SINT=0). Cannot run CONVERT' CALL GILDAS_CLOSE STOP ENDIF CALL GILDAS_REAL('XINC_RADEC$',XINC_RADEC,1) CALL GILDAS_REAL('YINC_RADEC$',YINC_RADEC,1) CALL GILDAS_DBLE('SITE_LATITUDE$',SITE_LATITUDE,1) SITE_LATITUDE = SITE_LATITUDE/DEG_TO_RAD CALL GILDAS_REAL('RA_EXTENT$' ,RA_EXTENT, 1) CALL GILDAS_REAL('DEC_EXTENT$',DEC_EXTENT,1) CALL GILDAS_INTE('FUNCTION$',IFUN,1) CALL GILDAS_REAL('CUTOFF$',CUTOFF,1) CALL GILDAS_CHAR('TYPE$',INPUT_TYPE) CALL GILDAS_CHAR('TELESCOPE$',TELESCOPE) CALL GILDAS_INTE('REF_CHAN$',REF_CHAN,1) CALL GILDAS_INTE('FIELD_ROTATION$',FIELD_ROTATION,1) CALL GILDAS_CLOSE * * Conversion IF (FREQUENCY.EQ.0) THEN FREQUENCY = 243. IF (TELESCOPE(1:3).EQ.'CSO') FREQUENCY = 857. ! ENDIF FREQUENCY = FREQUENCY*1.D9 ! frequency in Herz * * * Extract the scan numbers from the variable scan_list IER = SIC_GETVM(100,IADDR) IF (IER.NE.1) THEN WRITE(6,*)' *** Unable to allocate memory ***' STOP ENDIF IPSCAN = POINTER(IADDR,MEMORY) LEN_STRING = LEN(SCAN_LIST) I = 1 NSCAN = 0 J = INDEX(SCAN_LIST(I:),' ') DO WHILE (J.NE.0 .AND. I.LE.LEN_STRING) IF (J.NE.1) THEN READ(SCAN_LIST(I:),*) MEMORY(IPSCAN+NSCAN) NSCAN = NSCAN+1 ENDIF I = I+J J = INDEX(SCAN_LIST(I:),' ') ENDDO * * Test if nothing to do IF (SCAN_NUMBER.LT.0 .AND. NSCAN.EQ.0) THEN WRITE(6,*) ' no scan' STOP ENDIF * * * * * Convert the map identified with scan_number (if scan_list empty),else combine * * * IF (NSCAN.EQ.0) THEN * Read file "scan_number".ekh FILE = ' ' WRITE (FILE(1:4),'(i4.4)') SCAN_NUMBER IF (INPUT_TYPE(1:3).EQ.'EKH' .OR. $ INPUT_TYPE(1:3).EQ.'ekh' ) THEN CALL SIC_PARSEF(FILE,Y_FILE,' ','.ekh') ELSEIF (INPUT_TYPE(1:3).EQ.'SAA' .OR. $ INPUT_TYPE(1:3).EQ.'saa' ) THEN CALL SIC_PARSEF(FILE,Y_FILE,' ','.saa') ELSE WRITE(6,'(/,a,a3,a,/)') ' *** Invalid input type : ', $ INPUT_TYPE(1:3),' ***' GOTO 99 ENDIF CALL GDF_GEIS (Y_ISLO,ERROR) ! reserve slot CALL GDF_REIS (Y_ISLO,Y_TYPE,Y_FILE,Y_FORM,Y_SIZE,ERROR) IF (ERROR) THEN WRITE(6,*)' *** Cannot open file : ', $ Y_FILE(1:LENC(Y_FILE)),' ***' GOTO 99 ENDIF CALL GDF_READY (Y_ISLO,ERROR) CALL GDF_GEMS (Y_MSLO,Y_ISLO,BLC,TRC,Y_ADDR,Y_FORM,ERROR) IPMAP = POINTER (Y_ADDR,MEMORY) MAP_UNIT = Y_UNIT NCOL = Y_DIM(1) NROW = Y_DIM(2) XINC = ABS(Y_INC1/SEC_TO_RAD) ! XINC in arcseconds YINC = ABS(Y_INC2/SEC_TO_RAD) ! YINC in arcseconds XMIN = Y_VAL1/SEC_TO_RAD XMAX = XMIN + (NCOL-1)*XINC YMIN = Y_VAL2/SEC_TO_RAD YMAX = YMIN + (NROW-1)*YINC IF (Y_INC2.LT.0) THEN YMIN = (Y_VAL2+(NROW-Y_REF2)*Y_INC2)/SEC_TO_RAD YMAX = Y_VAL2/SEC_TO_RAD ENDIF * * Link to data shared memory C+WIN32 c CALL OPEN_SHARED_MEMORY(DATA_SHMID) C-WIN32 CALL ATTACH_MEMORY(DATA_SHMID,IADDR) IP = POINTER(IADDR,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_OFFSET = IP_PARAM IP_RECEIVER_FLAG = IP_PARAM+2*NCHANNEL IP_RECEIVER_RMS = IP_PARAM+3*NCHANNEL IPSUBSCAN = IP_PARAM + NCHANNEL*NPARAM_RECEIVER IPRECORD = IPSUBSCAN + NSUBSCAN*NPARAM_SUBSCAN * * * Allocate memory for : * subscan parameters (number of first record and of last record) * weight_map(nlin,ncol),lst_map(nlin,ncol),el_map(nlin,ncol), * xcoord_map(nlin,ncol,nchannel),ycoord_map(nlin,ncol,nchannel) N_XY = NCOL*NROW IER = SIC_GETVM(2*NSUBSCAN+3*N_XY + 2*N_XY*NCHANNEL,IADDR) IF (IER.NE.1) THEN WRITE(6,*)' *** Unable to allocate memory (2)***' WRITE(6,*)'ier=',IER STOP ENDIF IP_SUBPARAM = POINTER(IADDR,MEMORY) IP_WORK = IP_SUBPARAM + 2*NSUBSCAN ZERO = 0 DO I=0,3*N_XY + 2*N_XY*NCHANNEL-1 ! Raz allocated memory CALL R4TOR4(ZERO,MEMORY(IP_WORK+I),1) ENDDO * * * Initialization of maps LST_MAP[NX,NY],EL_MAP[NX,NY], * XCOORD_MAP[NX,NY,NCHAN],YCOORD_MAP[NX,NY,NCHAN] * * Convert_init parameters : * SUBSCAN_NUMBER,SUBSCAN_EPOCH, ! subscan number.epoch * SUBSCAN_TIME, ! subscan time * SUBSCAN_IFIRST,SUBSCAN_ILAST, ! first record and last record * ! (work space) * LST_RECORD,EL_RECORD, ! LST,EL * XSCAN_COORD,YSCAN_COORD, ! scanning coordinates * LST_MAP, EL_MAP, ! LST_MAP[NX,NY],EL_MAP[NX,NY] * XCOORD_MAP, YCOORD_MAP, ! XCOORD_MAP[NX,NY,NCHAN] * WEIGHT_MAP, ! WEIGHT_MAP[NX,NY] (work space) * OA,OE, ! receiver offsets * N_X,N_Y,N_Z) ! = ncol,nrow,channel * CALL CONVERT_INIT( $ MEMORY(IPSUBSCAN), $ MEMORY(IPSUBSCAN+NSUBSCAN), $ MEMORY(IPSUBSCAN+2*NSUBSCAN), $ MEMORY(IP_SUBPARAM),MEMORY(IP_SUBPARAM+NSUBSCAN), $ MEMORY(IPRECORD),MEMORY(IPRECORD+2*NRECORD), $ MEMORY(IPRECORD+(3+N_RECEIVERS)*NRECORD), $ MEMORY(IPRECORD+(4+N_RECEIVERS)*NRECORD), $ MEMORY(IP_WORK),MEMORY(IP_WORK+N_XY), $ MEMORY(IP_WORK+2*N_XY), $ MEMORY(IP_WORK+2*N_XY + NCHANNEL*N_XY), $ MEMORY(IP_WORK+2*N_XY +2*NCHANNEL*N_XY), $ MEMORY(IP_OFFSET),MEMORY(IP_OFFSET+NCHANNEL), $ NCOL,NROW,NCHANNEL,IFUN) * * Find dimensions of resulting RA-DEC map and allocate memory IF (RA_EXTENT.NE.0 .AND. DEC_EXTENT.NE.0) THEN CALL MAP_PARAMETER ELSE CALL CONVERT_LIMITS(YMAX,MEMORY(IPRECORD+NRECORD/2), $ MEMORY(IPRECORD+2.5*NRECORD), $ MEMORY(IP_OFFSET),MEMORY(IP_OFFSET+NCHANNEL), $ MEMORY(IP_RECEIVER_FLAG)) ENDIF IER = SIC_GETVM(3*NX_RADEC*NY_RADEC,IADDR) IF (IER.NE.1) THEN WRITE(6,*)' *** Unable to allocate memory (3)***' STOP ENDIF IP_RADEC = POINTER(IADDR,MEMORY) * Initialize output map CALL INIT_GDF_OUTPUT * * Converts AZ-EL maps in RA-DEC maps * * Convert parameters : * LST_MAP, ! LST_MAP[NX,NY], * XCOORD_MAP ! XCOORD_MAP[NX,NY,NCHAN] * YCOORD_MAP ! YCOORD_MAP[NX,NY,NCHAN] * AZEL_DATA(NCOL,NROW,NCHANNEL) ! AZ-EL map * RADEC_DATA(NX_RADEC,NY_RADEC) ! RA-DEC map (output) * RADEC_WEIGHT(NX_RADEC,NY_RADEC) ! RA-DEC weight (output)) * RADEC_DATA_raw(NX_RADEC,NY_RADEC) ! unnormalized data * CALL CONVERT( $ MEMORY(IP_WORK), $ MEMORY(IP_WORK+2*N_XY),MEMORY(IP_WORK+N_XY*(2+NCHANNEL)), $ MEMORY(IPMAP), $ MEMORY(IP_RADEC), $ MEMORY(IP_RADEC+NX_RADEC*NY_RADEC), $ MEMORY(IP_RADEC+2*NX_RADEC*NY_RADEC), $ MEMORY(IP_RECEIVER_FLAG),MEMORY(IP_RECEIVER_RMS),IFUN,ERROR) IF (ERROR) GOTO 99 * * * --- Make GILDAS image file ("scan_number.cnv") * * CALL MAXMIN_IMAGE (MEMORY(IP_RADEC),NX_RADEC,NY_RADEC,1,MAXMIN) X_UNIT = MAP_UNIT X_RMIN = MAXMIN(1) ! minimum X_RMAX = MAXMIN(2) ! maximum X_MIN1 = MAXMIN(3) ! pixel of minimum (1st axis) X_MIN2 = MAXMIN(4) ! pixel of minimum (2nd axis) X_MIN3 = 1 ! pixel of minimum (3rd axis) X_MAX1 = MAXMIN(6) ! pixel of maximum (1st axis) X_MAX2 = MAXMIN(7) ! pixel of maximum (2nd axis) X_MAX3 = 1 ! pixel of minimum (3rd axis) FILE = ' ' WRITE (FILE(1:4),'(i4.4)') SCAN_NUMBER CALL SIC_PARSEF(FILE,X_FILE,' ','.cnv') 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 (MEMORY(IP_RADEC),MEMORY(IP),2*NX_RADEC*NY_RADEC) CALL GDF_FRIS (X_ISLO,ERROR) CALL GDF_FRIS (Y_ISLO,ERROR) * * * * Combine image with other images (if nscan different from 0) * * Compute the map (data and weight) * ELSE * Combine parameters * pointer on scan_list * total weight (output), * data (output) * CALL FUNGEN(FUNC,IFUN) * Find dimensions of resulting RA-DEC map and allocate memory CALL COMBINE_INIT(MEMORY(IPSCAN)) IF (RA_EXTENT.NE.0 .AND. DEC_EXTENT.NE.0) THEN CALL MAP_PARAMETER ELSE CALL COMBINE_LIMITS(MEMORY(IPSCAN)) ENDIF IER = SIC_GETVM(3*NX_RADEC*NY_RADEC,IADDR) IF (IER.NE.1) THEN WRITE(6,*)' *** Unable to allocate memory (3)***' STOP ENDIF IP_RADEC = POINTER(IADDR,MEMORY) CALL INIT_GDF_OUTPUT * CALL COMBINE(MEMORY(IPSCAN), MEMORY(IP_RADEC), $ MEMORY(IP_RADEC+NX_RADEC*NY_RADEC),IFUN,ERROR,MAP_UNIT) IF (ERROR) GOTO 99 * * Create a Gildas Image * CALL MAXMIN_IMAGE (MEMORY(IP_RADEC),NX_RADEC,NY_RADEC,1,MAXMIN) X_UNIT = MAP_UNIT X_RMIN = MAXMIN(1) ! minimum X_RMAX = MAXMIN(2) ! maximum X_MIN1 = MAXMIN(3) ! pixel of minimum (1st axis) X_MIN2 = MAXMIN(4) ! pixel of minimum (2nd axis) X_MIN3 = 1 ! pixel of minimum (3rd axis) X_MAX1 = MAXMIN(6) ! pixel of maximum (1st axis) X_MAX2 = MAXMIN(7) ! pixel of maximum (2nd axis) X_MAX3 = 1 ! pixel of maximum (3rd axis) X_POSA = -12345 ! this is a mosaic CALL SIC_PARSEF(SNAM,X_FILE,' ','.cnv') CALL SIC_LOWER (X_FILE) 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 (MEMORY(IP_RADEC),MEMORY(IP), $ 2*NX_RADEC*NY_RADEC) CALL GDF_FRIS (X_ISLO,ERROR) CALL MAXMIN_IMAGE (MEMORY(IP_RADEC+NX_RADEC*NY_RADEC),NX_RADEC, $ NY_RADEC,1,MAXMIN) ENDIF STOP * 99 CONTINUE END * * * * SUBROUTINE INIT_GDF_OUTPUT * INCLUDE 'inc:xpar.inc' INCLUDE 'inc:format.inc' INCLUDE 'inc:memory.inc' INCLUDE 'const.inc' INCLUDE 'convert.inc' INCLUDE 'parameter.inc' * * Initialization for Gildas Images X_NDIM = 3 X_DIM(1) = NX_RADEC X_DIM(2) = NY_RADEC X_DIM(3) = 2 ! data and weight X_DIM(4) = 1 X_SIZE = X_DIM(1)*X_DIM(2)*X_DIM(3) * X_TYPE = 'GILDAS_IMAGE' X_NAME = SNAM X_FORM = FMT_R4 X_GENE = 29 ! size of general section X_BLAN = 2 ! length of blanking section X_BVAL = BLANKING X_EVAL = 1. X_EXTR = 10 ! length of extrema section X_MIN3 = 1 X_MAX3 = 1 X_MIN4 = 1 X_MAX4 = 1 * X_DESC = 18 ! description section X_POSI = 12 ! position section X_RA = SLAM*DEG_TO_RAD X_DEC = SBET*DEG_TO_RAD * X_PROJ = 9 ! size of projection section X_SPEC = 12 ! size of spectroscopy section X_RESO = 3 ! size of resolution section * X_PTYP = 3 ! type of projection (3=AZIMUTHAL) X_EPOC = EPOCHFR X_SYST = 'EQUATORIAL' X_XAXI = 1 X_YAXI = 2 X_CODE(1) = 'RA' X_CODE(2) = 'DEC' X_FREQ = FREQUENCY/1.D6 ! in Mhz END *