SUBROUTINE MCON C C Merge contexts for a set of context images. C C The contexts are assumed to be in the headers of the images. C C They are read one by one, merged and then the headers and context C images themselves are updated one by one. C C History: C C Tested on WFI data and bug fix for V0.1, 31st March 1999 C IMPLICIT NONE C Global storage for the context image INTEGER*2 MEMS(1) COMMON /MEM/MEMS INTEGER MAXEN,MAXIM,NX,NY,DIMS(7),DATTYP,NDIMS INTEGER ID,USEOF,N,MAXHCN PARAMETER (MAXEN=20000,MAXIM=1000,MAXHCN=20,USEOF=-2) INTEGER A(MAXIM,MAXEN),B(MAXIM,MAXEN),T(MAXEN) INTEGER ISTAT,NEA,NEB,MT(MAXEN),IMLD,PIM,I,I1,I2 CHARACTER*80 IMAGES,IMAGE,MASCON C Banner CALL UMSPUT('+ MCON Version 0.1 (March 31st 1999)', : 1,0,ISTAT) C Read the image name template as a string CALL UCLGST('conims',IMAGES,ISTAT) C Pass number 1 - read all context information from headers and C merge it... C Open template processing CALL TIMOTP(IMAGES,IMLD,ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT('! Unable to obtain image template list', : 1,0,ISTAT) GO TO 99 ENDIF C Get the names of the input data images C Start of main loop N=0 DO WHILE(.TRUE.) N=N+1 CALL TIMXTP(IMLD,IMAGE,ISTAT) IF(ISTAT.EQ.USEOF) GO TO 88 CALL UIMOPN(IMAGE,2,ID,ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT('! Unable to access image '//IMAGE, : 1,0,ISTAT) GO TO 88 ENDIF C Read context from header IF(N.EQ.1) THEN CALL GTCOIN(ID,B,MAXIM,MAXEN,NEB,ISTAT) ELSE CALL GTCOIN(ID,A,MAXIM,MAXEN,NEA,ISTAT) ENDIF IF(ISTAT.NE.0) THEN CALL UMSPUT( : '! Unable to read context from header of '//IMAGE(1:20), : 1,0,ISTAT) ELSE CALL UMSPUT( : '-Read context from header of '//IMAGE(1:20),1,0,ISTAT) ENDIF C Merge context IF(N.GT.1) CALL MERCON(A,B,MAXIM,MAXEN,NEA,NEB,MT,ISTAT) C Close the image CALL UIMCLO(ID,ISTAT) ENDDO 88 CONTINUE CALL TIMCTP(IMLD,ISTAT) C Write out the master context text table CALL UCLGST('mascon',MASCON,ISTAT) CALL PTGLCO(MASCON,B,MAXIM,MAXEN,NEB,ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT('! Failed to write master context file', : 1,0,ISTAT) ELSE CALL UMSPUT( : '-Writing master context table '//MASCON(1:20), : 1,0,ISTAT) ENDIF C Pass number 2 - update headers and images with merged context C information C Open template processing for the second time CALL TIMOTP(IMAGES,IMLD,ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT('! Unable to obtain image template list', : 1,0,ISTAT) GO TO 99 ENDIF C Get the names of the input data images C Start of main loop N=0 DO WHILE(.TRUE.) N=N+1 CALL TIMXTP(IMLD,IMAGE,ISTAT) IF(ISTAT.EQ.USEOF) GO TO 888 CALL UIMOPN(IMAGE,2,ID,ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT('! Unable to access image '//IMAGE, : 1,0,ISTAT) GO TO 888 ENDIF C Get size and shape CALL UIMGID(ID,DATTYP,NDIMS,DIMS,ISTAT) IF(ISTAT.NE.0 .OR. NDIMS.NE.2) THEN CALL UMSPUT('! Warning, image has strange size/shape?', : 1,0,ISTAT) GO TO 888 ELSE NX=DIMS(1) NY=DIMS(2) ENDIF C Read context from header CALL GTCOIN(ID,A,MAXIM,MAXEN,NEA,ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT( : '! Unable to read context from header of '//IMAGE(1:20), : 1,0,ISTAT) ENDIF C Merge context and write it back to the image header CALL MERCON(A,B,MAXIM,MAXEN,NEA,NEB,MT,ISTAT) C Now we want to replace the old number of pixels C with a given context, first make a temporary copy DO I=1,NEB T(I)=B(2,I) B(2,I)=0 ENDDO C Now copy the old values DO I=1,NEA IF(A(2,I).NE.0) B(2,MT(I))=A(2,I) ENDDO C Write this version to the header CALL LENSTR(IMAGE,I1,I2) CALL PTCOIN(ID,IMAGE(I1:I2)//'.CON',MAXHCN, : B,MAXIM,MAXEN,NEB,ISTAT) CALL UMSPUT('-Updated context in header of '//IMAGE, : 1,0,ISTAT) C Copy back the temporary version DO I=1,NEB B(2,I)=T(I) ENDDO C Now we need to update the actual data values C First allocate memory for the image CALL UDMGET(NX*NY,3,PIM,ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT('! Unable to allocate memory',1,0,ISTAT) GO TO 888 ENDIF C Read in the image DO I=1,NY CALL UIGL2S(ID,I,MEMS(PIM+(I-1)*NX),ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT( : '! Failed to read context image', : 1,0,ISTAT) ENDIF ENDDO C Update the context image CALL CONUP(MEMS(PIM),NX,NY,MT,NEA) C Write the image back DO I=1,NY CALL UIPL2S(ID,I,MEMS(PIM+(I-1)*NX),ISTAT) IF(ISTAT.NE.0) THEN CALL UMSPUT( : '! Failed to write context image', : 1,0,ISTAT) ENDIF ENDDO CALL UMSPUT('-Updated values in image '//IMAGE(1:20), : 1,0,ISTAT) C Close the image CALL UIMCLO(ID,ISTAT) C Free the memory CALL UDMFRE(PIM,3,ISTAT) ENDDO 888 CONTINUE CALL TIMCTP(IMLD,ISTAT) 99 CONTINUE RETURN END