You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
86 lines
2.0 KiB
Fortran
86 lines
2.0 KiB
Fortran
5 years ago
|
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
|