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.
99 lines
2.0 KiB
Fortran
99 lines
2.0 KiB
Fortran
5 years ago
|
!IPK LAST UPDATE SEP 23 2015 ADD NEW FORMAT TO 6 DEC
|
||
|
|
Subroutine MMap
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
!
|
||
|
|
CALL OPENMP
|
||
|
|
|
||
|
|
CALL SVELEM(IYES)
|
||
|
|
|
||
|
|
rewind 99
|
||
|
|
|
||
|
|
! if IYES .eq. 1 save as an element format
|
||
|
|
|
||
|
|
valmap=0.
|
||
|
|
mapno=2
|
||
|
|
IF(IYES .EQ. 1) THEN
|
||
|
|
do n=1,ne
|
||
|
|
write(99,6001)
|
||
|
|
6001 format(' 3,9999.')
|
||
|
|
if(imat(n) .gt. 0) then
|
||
|
|
ncn=ncorn(n)
|
||
|
|
do m=1,ncn
|
||
|
|
j=nop(n,m)
|
||
|
|
if(j .gt. 0) then
|
||
|
|
write(99,'(3f16.3)') xusr(j),yusr(j),wd(j)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
j=nop(n,1)
|
||
|
|
if(j .gt. 0) then
|
||
|
|
write(99,'(3f16.3)') xusr(j),yusr(j),wd(j)
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
write(99,6000)
|
||
|
|
6000 format('END')
|
||
|
|
enddo
|
||
|
|
|
||
|
|
! if IYES .eq. 0 save as a nodal list
|
||
|
|
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
write(99,6002)
|
||
|
|
6002 format(' 2,0')
|
||
|
|
do j=1,np
|
||
|
|
if(inew(j) .eq. 1) then
|
||
|
|
write(99,'(3f16.6)') xusr(j),yusr(j),wd(j)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
write(99,6000)
|
||
|
|
ENDIF
|
||
|
|
write(99,6000)
|
||
|
|
close (99)
|
||
|
|
return
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine openmp
|
||
|
|
|
||
|
|
use winteracter
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
include 'd.inc'
|
||
|
|
CHARACTER(LEN=255) :: FNAME
|
||
|
|
CHARACTER(LEN=3) :: SUB
|
||
|
|
|
||
|
|
!
|
||
|
|
! Declare window-type and message variables
|
||
|
|
!
|
||
|
|
TYPE(WIN_STYLE) :: WINDOW
|
||
|
|
|
||
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
||
|
|
|
||
|
|
CALL WSelectFile(ID_STRING7,SaveDialog+PromptOn,FNAME,'Save Network as Mapfile')
|
||
|
|
|
||
|
|
IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
|
||
|
|
|
||
|
|
SUB='map'
|
||
|
|
CALL ADDSUB(FNAME,SUB)
|
||
|
|
open(99,file=fname, form='formatted', status='unknown')
|
||
|
|
ENDIF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE SVELEM(IYES)
|
||
|
|
|
||
|
|
USE WINTERACTER
|
||
|
|
|
||
|
|
INCLUDE 'D.INC'
|
||
|
|
|
||
|
|
CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save element layout?'//&
|
||
|
|
CHAR(13)//' ','Map option')
|
||
|
|
!
|
||
|
|
! If answer 'No', return
|
||
|
|
!
|
||
|
|
iyes=1
|
||
|
|
IF (WInfoDialog(4).EQ.2) iyes=0
|
||
|
|
return
|
||
|
|
end
|
||
|
|
|