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.
92 lines
1.5 KiB
Fortran
92 lines
1.5 KiB
Fortran
5 years ago
|
SUBROUTINE SWMAP
|
||
|
|
|
||
|
|
USE BLKMAP
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
|
||
|
|
|
||
|
|
LOGICAL OPENTS
|
||
|
|
CHARACTER*1 iflag
|
||
|
|
|
||
|
|
ISWAP=IBAK
|
||
|
|
IBAK=15
|
||
|
|
|
||
|
|
! Write out RM1 file
|
||
|
|
|
||
|
|
INQUIRE(IBAK, OPENED=OPENTS)
|
||
|
|
IF(.NOT. OPENTS) THEN
|
||
|
|
OPEN(IBAK,STATUS='SCRATCH',FORM='UNFORMATTED')
|
||
|
|
ENDIF
|
||
|
|
REWIND IBAK
|
||
|
|
CALL WRTOUT(0)
|
||
|
|
REWIND IBAK
|
||
|
|
IBAK=ISWAP
|
||
|
|
|
||
|
|
! Now put map data into RM1 position
|
||
|
|
|
||
|
|
NE=NELTS
|
||
|
|
DO J=1,NE
|
||
|
|
DO K=1,8
|
||
|
|
NOP(J,K)=0.
|
||
|
|
ENDDO
|
||
|
|
IF(NOPEL(J,1) .GT. 0) THEN
|
||
|
|
NOP(J,1)=NOPEL(J,1)
|
||
|
|
NOP(J,3)=NOPEL(J,2)
|
||
|
|
NOP(J,5)=NOPEL(J,3)
|
||
|
|
NCORN(J)=6
|
||
|
|
IMAT(J)=1
|
||
|
|
IESKP(J) = 0
|
||
|
|
ELSE
|
||
|
|
NCORN(J)=0
|
||
|
|
IMAT(J)=0
|
||
|
|
IESKP(J) = 1
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
NP=MAXPTS
|
||
|
|
DO J=1,NP
|
||
|
|
XUSR(J)=XMAP(J)
|
||
|
|
YUSR(J)=YMAP(J)
|
||
|
|
CORD(J,1) = XUSR(J)
|
||
|
|
CORD(J,2) = YUSR(J)
|
||
|
|
WD(J)=VAL(J)
|
||
|
|
INSKP(J)=0
|
||
|
|
IF (CORD(J,1) .GT. VDX) THEN
|
||
|
|
INEW(J) = 1
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
NLST=0
|
||
|
|
NENTRY=0
|
||
|
|
NLAYD=0
|
||
|
|
NCLM=0
|
||
|
|
CALL RESCAL
|
||
|
|
CALL HEDR
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE SWRM1
|
||
|
|
|
||
|
|
USE BLKMAP
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
|
||
|
|
DO N=1,NE
|
||
|
|
IF(IMAT(N) .GT. 0) THEN
|
||
|
|
NOPEL(N,1)=NOP(N,1)
|
||
|
|
NOPEL(N,2)=NOP(N,3)
|
||
|
|
NOPEL(N,3)=NOP(N,5)
|
||
|
|
ELSE
|
||
|
|
NOPEL(N,1)=0
|
||
|
|
NOPEL(N,2)=0
|
||
|
|
NOPEL(N,3)=0
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
CALL RDRST(1,15)
|
||
|
|
CALL RDRST(2,15)
|
||
|
|
CALL RDRST(3,15)
|
||
|
|
REWIND 15
|
||
|
|
CALL RESCAL
|
||
|
|
CALL HEDR
|
||
|
|
RETURN
|
||
|
|
END
|