!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