SUBROUTINE ADDMAP ! ! ROUTINE TO ADD TWO MAPS FILES TOGETHER ! USE WINTERACTER USE BLKMAP USE BLK1MOD USE BLK2MOD include 'd.inc' CHARACTER(LEN=255) :: FNAME,FNAMGE,FNAMRM,FNAMEB CHARACTER(LEN=3) :: SUB,SUB1 ! FIRST WRITE EXISTING MAP TO SCRATCH close(99) OPEN(99,FORM='BINARY',STATUS='SCRATCH') ! SAVE THE CONTROL INFORMATION KEEP1=klint JEEP1=jlint CALL WRTMAP(99) REWIND 99 ! NEXT READ NEW MAP AND ALSO WRITE TO A SECOND SCRATCH ! FIRST OPEN A MAP FILE CALL WSelectFile(ID_STRING1,PromptOn,FNAME,'Load Map File') IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN CALL IlowerCase(FNAME) CALL GETSUB(FNAME,SUB) IF(SUB .EQ. 'map') then IMP=9 OPEN(9,FILE=FNAME,STATUS='OLD') ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then IMP=94 OPEN(94,FILE=FNAME,STATUS='OLD') ELSEIF(SUB .EQ. 'mpb') then imp=92 OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read') ELSEIF(SUB .EQ. 'mbb') then imp=92 OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read') ENDIF ENDIF CALL RDMAP(2,IMP,0,0) NEWMAXK=KEEP1+klint NEWMAXPL=JEEP1+jlint IF(NEWMAXPL .GT. MAXPL) THEN !! ! NOW OPEN THE FILE FOR SAVING OPEN(98,FORM='BINARY',STATUS='SCRATCH') CALL WRTMAP(98) REWIND 98 ! WORK OUT SIZES AND ALLOCATE ARRAYS deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS) allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL)) ALLOCATE (imap(maxpl),NCRS(MAXPL)) CALL RDMAP(2,98,0,0) ! XXXXX CLOSE(98) ENDIF ! READ IN AND MERGE MAP FILES JSTT=JLINT KSTT=KLINT CALL RDMAP(2,99,JSTT,KSTT) CLOSE(99) call PLOTOT(0) CALL HEDR RETURN END