iank
/
RMAGEN
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

UPATE TO ADD 2DM (mesh FORMATS AS INPUT GEOMETRY

Browse Source
master
Ian P King 6 years ago
parent b0071b464a
commit 3a4c900e71
8 changed files with 308 additions and 19 deletions
Show Stats Download Patch File Download Diff File

14
.gitignore vendored
Unescape Escape View File

@ -252,3 +252,17 @@ ModelManifest.xml
/src/RMAGENV81.rc
/src/RMAGENV83I.zip
/src/RMAGENV83c.res
/RMAGEN/TRANSFER/ELT.BAK
/RMAGEN/TRANSFER/RMAGENV83GORIG.exe
/RMAGEN/TRANSFER/RMAGENV83GA.exe
/RMAGEN/TRANSFER/RMAGENV83G3.zip
/RMAGEN/TRANSFER/RMAGENV83G-temp.EXE
/RMAGEN/TRANSFER/RMAGENV83G2.exe
/RMAGEN/TRANSFER/RMAGENV83G2.zip
/RMAGEN/TRANSFER/RMAGENV83G3.exe
/RMAGEN/TRANSFER/README-RMAGEN83G.txt
/RMAGEN/TRANSFER/messgen.out
/RMAGEN/TRANSFER/RMAGEN83G.pdf
/RMAGEN/RCa18976
/src/NEWRMGN-demo.F90
/src/RMAGENV83e-demo.rc

82
RMAGEN/Resource1.rc
Unescape Escape View File

@ -0,0 +1,82 @@
//Microsoft Developer Studio generated resource script.
//
#define APSTUDIO_READONLY_SYMBOLS
/////////////////////////////////////////////////////////////////////////////
//
// Generated from the TEXTINCLUDE 2 resource.
//
#include "winres.h"
#include "winver.h"
/////////////////////////////////////////////////////////////////////////////
#undef APSTUDIO_READONLY_SYMBOLS
/////////////////////////////////////////////////////////////////////////////
// Neutral resources
#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU)
#ifdef _WIN32
LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL
#pragma code_page(1252)
#endif //_WIN32
#endif // Neutral resources
/////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////
// English (U.S.) resources
#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU)
#ifdef _WIN32
LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US
#pragma code_page(1252)
#endif //_WIN32
#ifdef APSTUDIO_INVOKED
/////////////////////////////////////////////////////////////////////////////
//
// TEXTINCLUDE
//
1 TEXTINCLUDE
BEGIN
END
2 TEXTINCLUDE
BEGIN
"#include ""winres.h""\r\n"
"#include ""winver.h""\r\n"
"\0"
END
3 TEXTINCLUDE
BEGIN
"\r\n"
"\0"
END
#endif // APSTUDIO_INVOKED
/////////////////////////////////////////////////////////////////////////////
//
// String Table
//
STRINGTABLE
BEGIN
0 " "
END
#endif // English (U.S.) resources
/////////////////////////////////////////////////////////////////////////////
#ifndef APSTUDIO_INVOKED
/////////////////////////////////////////////////////////////////////////////
//
// Generated from the TEXTINCLUDE 3 resource.
//
/////////////////////////////////////////////////////////////////////////////
#endif // not APSTUDIO_INVOKED

BIN
RMAGEN/TRANSFER/RMAGENV83G.exe → RMAGEN/TRANSFER/RMAGENV83H.exe
View File

Binary file not shown.

2
src/D.INC
Unescape Escape View File

@ -1,4 +1,4 @@
! Winteracter resource identifiers. Created : 19/Oct/2017 10:30:12
! Winteracter resource identifiers. Created : 14/Sep/2018 14:52:39
!
! This file is generated by the Winteracter resource editor.
! It should not be edited manually. It is also not advisable to load this

18
src/EVENT.F90
Unescape Escape View File

@ -349,7 +349,7 @@
! WRITE(90,*) 'WINTER AT ITEM13'
INQUIRE(20, OPENED=OPENED)
if(.not. opened) then
Filter='Network Files|*.rm1;*.gfg;*.ele|Rm1 file -- *.rm1|*.rm1|gfg file -- *.gfg|*.gfg|TRIANG file -- *.ele|*.ele|'
Filter='Network Files|*.rm1;*.gfg;*.ele;*.2dm|Rm1 file -- *.rm1|*.rm1|gfg file -- *.gfg|*.gfg|TRIANG file -- *.ele|*.ele|2dm file -- *.2dm|*.2dm|'
CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
@ -407,6 +407,13 @@
ENDDO
220 continue
CLOSE (IOT)
OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
elseif(sub .eq. '2dm') then
igfgsw=0
OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
itrianout=0
call wrtout(3)
CLOSE (IOT)
OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
else
igfgsw=1
@ -565,7 +572,7 @@
CASE (ID_ITEM15) ! Save As option
Filter='Network Files|*.rm1;*.gfg;*.ele|Rm1 file -- *.rm1|*.rm1|GFGEN file -- *.gfg|*.gfg|TRIANG file -- *.ele|*.ele|'
Filter='Network Files|*.rm1;*.gfg;*.ele;*.2dm|Rm1 file -- *.rm1|*.rm1|GFGEN file -- *.gfg|*.gfg|TRIANG file -- *.ele|*.ele|2dm file -- *.2dm|*.2dm|'
CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
@ -625,6 +632,13 @@
CLOSE (IOT)
OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
elseif(sub .eq. '2dm') then
igfgsw=0
OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
itrianout=0
call wrtout(3)
CLOSE (IOT)
OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
elseif(sub .eq. 'gfg') then
igfgsw=1
OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')

177
src/INOUT.F90
Unescape Escape View File

@ -25,10 +25,61 @@
CHARACTER*60 LIND
CHARACTER*32 IJNK
!
DATA ISET /2/,ZERO/0.0/
DATA ISET /2/,ZERO/0.0/,VDXX/-1.E19/
!ipk oct95 copy IFO from IFOM
!ipk feb99 IOT=20
!ipk feb99 IOT1=22
!ipk feb99 IOT1=22
if(ifom .eq. 3) then
write(iot,'(''MESH2D'')')
WRITE(IOT,'(''MESHNAME'')')
do n=1,ne
if(imat(n) .lt. 1) cycle
if(ncorn(n) .lt. 6) then
return
endif
if(ncorn(n) .eq. 8) then
if(nop(n,2) .eq. 0) then
write(iot,'(''E4Q'',6i10)') N,(NOP(N,K),K=1,7,2),IMAT(N)
else
write(iot,'(''E8Q'',10i10)') N,(NOP(N,K),K=1,8),IMAT(N)
endif
elseif(ncorn(n) .eq. 6) then
if(nop(n,2) .eq. 0) then
write(iot,'(''E3T'',5i10)') N,(NOP(N,K),K=1,5,2),IMAT(N)
else
write(iot,'(''E6T'',8i10)') N,(NOP(N,K),K=1,6),IMAT(N)
endif
elseif(ncorn(n) .eq. 3) then
if(nop(n,2) .eq. 0) then
write(iot,'(''E2L'',4i10)') N,(NOP(N,K),K=1,3,2),IMAT(N)
else
write(iot,'(''E3L'',5i10)') N,(NOP(N,K),K=1,3),IMAT(N)
endif
endif
enddo
DO N=1,NP
IF(XUSR(N) .LT. VDXX) CYCLE
WRITE(IOT,'(''ND'',I8,1P3E16.8)') N,XUSR(N),YUSR(N),WD(N)
ENDDO
IF(NCLM .EQ. 0) RETURN
DO K=1,NCLM
IF(ICCLN(K,1) .EQ. 0) CYCLE
DO J=1,LLIST(K)
ILIST(K,J)=ICCLN(K,J)
ENDDO
ILIST(K,LLIST(K))=-ILIST(K,LLIST(K))
ILIST(K,LLIST(K)+1)=K
DO JJ=1,LLIST(K)+1,10
IF(JJ+9 .GT. LLIST(K)+1) THEN
WRITE(IOT,'(''NS'',10I8)') (ILIST(K,J),J=JJ,LLIST(K)+1)
ELSE
WRITE(IOT,'(''NS'',10I8)') (ILIST(K,J),J=JJ,JJ+9)
ENDIF
ENDDO
ENDDO
return
endif
IF((IFOM .EQ. 2 .AND. IOT1 .EQ. 0) .OR. &
& (IFOM .EQ. 1 .AND. IOT .EQ. 0)) THEN
@ -765,7 +816,7 @@
CHARACTER*3 ID
character*80 dlin
!ipk feb02 expand to 110
character*150 dlin1
character*150 dlin1,DLIN1OUT
! INCLUDE 'BLK1.COM'
DATA IFIRST / 0 /
data blank/' '/
@ -839,6 +890,11 @@
!ipk jun02 Allow for GFGEN input
DO ICOUNTC=1,1000000
IF(ICOUNTC .EQ. 1) THEN
NLST=0
ILIST=0
KST=1
ENDIF
DO JJ=1,150
DLIN1(JJ:JJ)=' '
ENDDO
@ -875,6 +931,30 @@
ELSEIF(ID(1:2) .EQ. 'ND') THEN
ICOUNT=4
go to 90
ELSEIF(ID(1:2) .EQ. 'NS') THEN
CALL PARSELIN(DLIN1,DLIN1OUT,ICLON,NCHARBL)
READ(DLIN1OUT,*) (ILIST(NLST+1,KK),KK=KST,KST+NCHARBL-1)
IF(ILIST(NLST+1,KST+NCHARBL-1) .LT. 0) THEN
NLST=NLST+1
LLIST(NLST)=NST+NCHARBL-1
DO K=1,LLIST(NLST)
ICCLN(NLST,K)=ABS(ILIST(NLST,K))
ENDDO
NCLM=MAX(NLST,NCLM)
KST=1
ELSEIF(ILIST(NLST+1,KST+NCHARBL-2) .LT. 0) THEN
LTD=ILIST(NLST+1,KST+NCHARBL-1)
NLST=NLST+1
LLIST(NLST)=KST+NCHARBL-2
DO K=1,KST+NCHARBL-2
ICCLN(LTD,K)=ABS(ILIST(NLST,K))
ENDDO
NCLM=MAX(LTD,NCLM)
KST=1
ELSE
KST=KST+NCHARBL
ENDIF
ENDIF
ENDDO
90 CONTINUE
@ -1235,9 +1315,9 @@
!ipk sep05
do i=1,80
if(alin(i:i) .eq. char(9)) then
alin(i:i)=','
do jjj=1,80
if(alin(jjj:jjj) .eq. char(9)) then
alin(jjj:jjj)=','
endif
enddo
@ -1716,7 +1796,11 @@
ELSEIF(IGFG .EQ. 3) THEN
IF(ICOUNT .EQ. 4) THEN
READ(DLIN1,*) J, (NTMP(K),K=1,7,2)
IF(NTMP(7) .EQ. 0) NTMP(9)=1
IF(NTMP(7) .EQ. 0) then
NTMP(9)=1
else
ntmp(9)=ntmp(7)
endif
NTMP(2)=0
NTMP(4)=0
NTMP(6)=0
@ -2535,4 +2619,81 @@
j=ikp
enddo
RETURN
END
END
SUBROUTINE PARSELIN(DLININ,DLIN,ICLON,NCHARBL)
CHARACTER*150 DLIN,DLININ
CHARACTER*1 CTYPE(6)
INTEGER ICLON
DATA CTYPE/' ',',','\',':','/','&'/
IBAS=0
IPREV=1
ICLON=0
NCHARBL=0
DO K=1,75
DLIN(K:K)=CTYPE(1)
ENDDO
DO K=1,75
! IF DLININ = '&' RETURN
IF(DLININ(K:K) .EQ. CTYPE(6)) THEN
IF(IBAS .EQ. 0) RETURN
IF(DLIN(IBAS:IBAS) .EQ. CTYPE(2)) THEN
DLIN(IBAS:IBAS)= CTYPE(1)
ELSE
IBAS=IBAS+1
DLIN(IBAS:IBAS) =CTYPE(1)
NCHARBL=NCHARBL+1
ENDIF
RETURN
ENDIF
! IF(DLININ = BLANK
IF(DLININ(K:K) .EQ. CTYPE(1)) THEN
! TEST FOR PREVIOUS BLANK IF SO MOVE ON
IF(IPREV .EQ. 1) GO TO 200
! IF NO PREVIOUS THEN WE HAVE AN END OF CHARACTER STREAM ADD A COMMA TO DLIN
IPREV=1
IF(DLIN(IBAS:IBAS) .NE. CTYPE(2)) THEN
IBAS=IBAS+1
DLIN(IBAS:IBAS)=CTYPE(2)
NCHARBL=NCHARBL+1
ENDIF
ELSE
! WE HAVE NUMBER OR A COMMA OR \ OR / CHARACTER
DO J=2,5
IF(DLININ(K:K) .EQ. CTYPE(J)) THEN
! FOUND SOMETHING ADD A COMMA
IPREV=0
IBAS=IBAS+1
IF(J .EQ. 4) THEN
ICLON=1
ENDIF
DLIN(IBAS:IBAS)=CTYPE(2)
NCHARBL=NCHARBL+1
GO TO 100
ENDIF
ENDDO
! NOTHING FOUND MUST BE LETTER OR NUMBER COPY IT OVER
IPREV=0
IBAS=IBAS+1
DLIN(IBAS:IBAS)=DLININ(K:K)
! MOVE ON TO NEXT CHARACTER
100 CONTINUE
ENDIF
200 ENDDO
RETURN
END

33
src/READSHP.FOR
Unescape Escape View File

@ -3,7 +3,8 @@
USE BLKMAP
USE BLK1MOD
character*4 temp
character*100 header,field
character*100 header
character*256 field
character*4 ai7,aai7,ai8
integer status,i1,i2,i3,i4,i5,i6,i7,i8,i9
integer*2 i1s,i2s,i3s
@ -11,6 +12,7 @@
real*8 fp1,fp2,fp3,fp4,fp5,fp6,fp7,fp8,vtemp(20)
character*11 label(20),fomat(20)
character*1 type(20),a2,a3,a4
character*2 a32
equivalence (aai7,ia7),(aai8,ia8)
c read header
@ -36,10 +38,20 @@ c now process labels
do k=1,nrecsh
read(114) label(k),type(k),i3,i1vs(k),i2vs(k),i3s,i4,i5,i6
if(type(k) .eq. 'F' .or. type(k) .eq. 'N') then
write(fomat(k),6000) i1vs(k),i2vs(k)
6000 format('(F',i2,'.',i1,')')
if(i2vs(k) .gt. 9) then
write(fomat(k),5999) i1vs(k),i2vs(k)
5999 format('(F',i2,'.',i2,')')
else
write(fomat(k),6000) i1vs(k),i2vs(k)
6000 format('(F',i2,'.',i1,')')
endif
else
if(i1vs (k) .lt. 10) then
if(i1vs(k) .lt. 0) then
itemp= i1vs(k)+256
write(fomat(k),60011) itemp
60011 format('(A',i3,')')
elseif(i1vs (k) .lt. 10) then
write(fomat(k),6001) i1vs(k)
6001 format('(A',i1,')')
else
@ -49,7 +61,7 @@ c now process labels
endif
nfl=nfl+i1vs(k)
enddo
read(114) a3
read(114) a32
call choosrec(label,nrecsh,nchs)
@ -57,7 +69,7 @@ c now process labels
JK=0
JL=0
if(i9 .eq. 1) then
do JJ=1,100000
do JJ=1,200000
read(113,end=300) ai7,ai8
CALL BTOL(AI7,IA7)
CALL BTOL(AI8,IA8)
@ -105,14 +117,19 @@ c VAL(JJ)=-2.
!call choosrec(label,nrecsh,nchs)
do j=1,nrecs
do k=1,nrecsh
read(114) field(1:i1vs(k))
if(i1vs(k) .lt. 0) then
itemp=i1vs(k)+256
else
itemp=i1vs(k)
endif
read(114) field(1:itemp)
read(field,fomat(k)) vtemp(k)
enddo
val(j)=vtemp(NCHS)
read(114) a3
enddo
else
do JJ=1,100000
do JJ=1,200000
read(113,end=500) ai7,ai8
CALL BTOL(AI7,IA7)
CALL BTOL(AI8,IA8)

1
src/UTIL.F90
Unescape Escape View File

@ -1094,6 +1094,7 @@
ENDIF
25 END DO
IF (NCN .EQ. 3 .OR. NCN .EQ. 5) NCN = 4
IF(NCN .LT. 9) THEN
XC(J) = 2.*XXC/NCN
YC(J) = 2.*YYC/NCN

Write Preview
Loading…
Cancel
Save