diff --git a/.gitignore b/.gitignore index 4f45054..6cab745 100644 --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/RMAGEN/Resource1.rc b/RMAGEN/Resource1.rc new file mode 100644 index 0000000..2dec9fa --- /dev/null +++ b/RMAGEN/Resource1.rc @@ -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 diff --git a/RMAGEN/TRANSFER/RMAGENV83G.exe b/RMAGEN/TRANSFER/RMAGENV83H.exe similarity index 50% rename from RMAGEN/TRANSFER/RMAGENV83G.exe rename to RMAGEN/TRANSFER/RMAGENV83H.exe index 1d40d87..0386114 100644 Binary files a/RMAGEN/TRANSFER/RMAGENV83G.exe and b/RMAGEN/TRANSFER/RMAGENV83H.exe differ diff --git a/src/D.INC b/src/D.INC index 135319c..4f34d89 100644 --- a/src/D.INC +++ b/src/D.INC @@ -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 diff --git a/src/EVENT.F90 b/src/EVENT.F90 index c6c62a5..8614e3d 100644 --- a/src/EVENT.F90 +++ b/src/EVENT.F90 @@ -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') diff --git a/src/INOUT.F90 b/src/INOUT.F90 index 0888a57..f612486 100644 --- a/src/INOUT.F90 +++ b/src/INOUT.F90 @@ -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 \ No newline at end of file + 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 + \ No newline at end of file diff --git a/src/READSHP.FOR b/src/READSHP.FOR index f3e8262..b4cdf9f 100644 --- a/src/READSHP.FOR +++ b/src/READSHP.FOR @@ -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) diff --git a/src/UTIL.F90 b/src/UTIL.F90 index bae20fb..e9adbca 100644 --- a/src/UTIL.F90 +++ b/src/UTIL.F90 @@ -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