UPATE TO ADD 2DM (mesh FORMATS AS INPUT GEOMETRY

.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

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

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

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')

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    
+      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
+	  do jjj=1,80
-	    if(alin(i:i) .eq. char(9)) then
+	    if(alin(jjj:jjj) .eq. char(9)) then
-		  alin(i:i)=','
+		  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
@@ -2536,3 +2620,80 @@
       enddo
       RETURN
     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
+    

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
+          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)

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