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

update to version 84 oct 23rd 2021

Browse Source
master
Ian P King 3 years ago
parent b235079663
commit 601f33fc45
15 changed files with 296 additions and 71 deletions
Show Stats Download Patch File Download Diff File

4
RMAGENV84/RMAGENV84.vfproj
Unescape Escape View File

@ -13,8 +13,8 @@
<Tool Name="VFPreBuildEventTool"/> <Tool Name="VFPreBuildEventTool"/>
<Tool Name="VFPostBuildEventTool"/> <Tool Name="VFPostBuildEventTool"/>
<Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration> <Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration>
<Configuration Name="Release|Win32" TargetName="rmagenv84C"> <Configuration Name="Release|Win32" TargetName="rmagenv84D-OCT23">
<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" BufferedIO="true" UseWindowsLibs="true"/> <Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" BufferedIO="true" FloatingPointExceptionHandling="fpe0" UseWindowsLibs="true"/>
<Tool Name="VFLinkerTool" SuppressStartupBanner="true" AdditionalLibraryDirectories="C:\WINT\LIB.IF8" SubSystem="subSystemWindows" StackReserveSize="10000000" StackCommitSize="6000000" AdditionalDependencies="WINTER.LIB COMDLG32.LIB WINSPOOL.LIB WINMM.LIB SHELL32.LIB ADVAPI32.LIB VERSION.LIB HTMLHELP.LIB opengl32.lib glu32.lib"/> <Tool Name="VFLinkerTool" SuppressStartupBanner="true" AdditionalLibraryDirectories="C:\WINT\LIB.IF8" SubSystem="subSystemWindows" StackReserveSize="10000000" StackCommitSize="6000000" AdditionalDependencies="WINTER.LIB COMDLG32.LIB WINSPOOL.LIB WINMM.LIB SHELL32.LIB ADVAPI32.LIB VERSION.LIB HTMLHELP.LIB opengl32.lib glu32.lib"/>
<Tool Name="VFResourceCompilerTool"/> <Tool Name="VFResourceCompilerTool"/>
<Tool Name="VFMidlTool" SuppressStartupBanner="true"/> <Tool Name="VFMidlTool" SuppressStartupBanner="true"/>

6
SRC84/ADD999.F90
Unescape Escape View File

@ -25,7 +25,8 @@
IUSEDM=0 IUSEDM=0
DO N=1,NE DO N=1,NE
IF(IMAT(N) .NE. 999) CYCLE IF(IMAT(N) .NE. 999) CYCLE
CALL KCON(0) ISWW=0
CALL KCON(ISWW)
GO TO 75 GO TO 75
ENDDO ENDDO
GO TO 90 GO TO 90
@ -290,7 +291,8 @@
NELCT=2 NELCT=2
400 CONTINUE 400 CONTINUE
CALL FILM(1) CALL FILM(1)
call KCON(0) ISWW=0
CALL KCON(ISWW)
do n=1,ne do n=1,ne

3
SRC84/D.INC
Unescape Escape View File

@ -1,4 +1,4 @@
! Winteracter resource identifiers. Created : 10/Jul/2021 17:03:10 ! Winteracter resource identifiers. Created : 23/Oct/2021 16:23:24
! !
! This file is generated by the Winteracter resource editor. ! This file is generated by the Winteracter resource editor.
! It should not be edited manually. It is also not advisable to load this ! It should not be edited manually. It is also not advisable to load this
@ -411,3 +411,4 @@
INTEGER, PARAMETER :: ID_RESTORELEV = 40153 INTEGER, PARAMETER :: ID_RESTORELEV = 40153
INTEGER, PARAMETER :: ID_UPDTWGHT = 40154 INTEGER, PARAMETER :: ID_UPDTWGHT = 40154
INTEGER, PARAMETER :: IDD_PLTSHP = 172 INTEGER, PARAMETER :: IDD_PLTSHP = 172
INTEGER, PARAMETER :: IDD_NOCONNECT = 173

3
SRC84/GRIDSB.F90
Unescape Escape View File

@ -802,7 +802,8 @@
USE BLK1MOD USE BLK1MOD
USE BLK2MOD USE BLK2MOD
DIST(N,M)=(cord(n,1)-cord(m,1))**2+(cord(n,2)-cord(m,2))**2 DIST(N,M)=(cord(n,1)-cord(m,1))**2+(cord(n,2)-cord(m,2))**2
CALL KCON(0) ISWW=0
CALL KCON(ISWW)
MCOUNT=0 MCOUNT=0
MCOUNTF=0 MCOUNTF=0
DO N=1,NP DO N=1,NP

48
SRC84/INOUT.F90
Unescape Escape View File

@ -704,7 +704,7 @@
ELSEIF(IGFG .EQ. 3) THEN ELSEIF(IGFG .EQ. 3) THEN
DO I=1,10000 DO I=1,10000
READ(IIN,'(A8,A77)') ID8,DLIN READ(IIN,'(A8,A77)') ID8,DLIN
IF(ID8 .EQ. 'MESHNAME') THEN IF(ID8 .EQ. 'MESHNAME' .OR. ID8(1:8) .EQ. 'MESH2D') THEN
TITLE(1:77)=DLIN TITLE(1:77)=DLIN
GO TO 140 GO TO 140
ENDIF ENDIF
@ -891,7 +891,7 @@
!ipk jun02 Allow for GFGEN input !ipk jun02 Allow for GFGEN input
DO ICOUNTC=1,1000000 DO ICOUNTC=1,1000000
IF(ICOUNTC .EQ. 1) THEN IF(ICOUNTC .EQ. 1 .and. ID(1:2) .EQ. 'NS') THEN
NLST=0 NLST=0
ILIST=0 ILIST=0
KST=1 KST=1
@ -899,7 +899,9 @@
DO JJ=1,150 DO JJ=1,150
DLIN1(JJ:JJ)=' ' DLIN1(JJ:JJ)=' '
ENDDO ENDDO
70 CONTINUE
READ(IUNIT,'(A3,A150)', END=400) ID,DLIN1 READ(IUNIT,'(A3,A150)', END=400) ID,DLIN1
if(ID(1:2) .NE. 'ND' .AND. IGFG .EQ. 3) GO TO 70
IF(ID .EQ. 'GNN' .OR. ID .EQ. 'GWN') THEN IF(ID .EQ. 'GNN' .OR. ID .EQ. 'GWN') THEN
! Count the number of variables ! Count the number of variables
I=0 I=0
@ -1224,7 +1226,11 @@
! IGUNIT=0 ! IGUNIT=0
ielvsw=0 ielvsw=0
! IF (IFIRST .EQ. 0) THEN ! IF (IFIRST .EQ. 0) THEN
IF(IFIRST .EQ. 2) IMP=IMPP IF(IFIRST .EQ. 2) THEN
IMP=IMPP
JSTT=JLINT
KSTT=KLINT
ENDIF
VOID = - 1.0E+10 VOID = - 1.0E+10
VDX = -1.0E+9 VDX = -1.0E+9
CXO=VDX CXO=VDX
@ -1725,7 +1731,7 @@
!IPK FEB02 SCALE NEW VALUES !IPK FEB02 SCALE NEW VALUES
IF(IFIRST .EQ. 2) THEN IF(IFIRST .EQ. 2 .and. IMP .NE. 113) THEN
DO K=JSTT+1,MAXPTS DO K=JSTT+1,MAXPTS
IF (CMAP(K,1) .GT. VDX) THEN IF (CMAP(K,1) .GT. VDX) THEN
CMAP(K,1) = (CMAP(K,1)+XS)/TXSCAL CMAP(K,1) = (CMAP(K,1)+XS)/TXSCAL
@ -1840,11 +1846,17 @@
ENDIF ENDIF
ELSE ELSE
!ipk jun02 Allow for GFGEN input !ipk jun02 Allow for GFGEN input
NUMMAT=0
DO ICOUNTC=1,700000 DO ICOUNTC=1,700000
DO JJ=1,150 DO JJ=1,150
DLIN1(JJ:JJ)=' ' DLIN1(JJ:JJ)=' '
ENDDO ENDDO
READ(IUNIT,'(A3,A150)', END=175) ID,DLIN1 READ(IUNIT,'(A3,A150)', END=175) ID,DLIN1
IF(ID(1:3) .EQ. 'NUM') THEN
READ(DLIN1(20:40),*) NUMMAT
NUMMAT=NUMMAT-1
ENDIF
IF(ID(1:2) .EQ. 'ND') CYCLE
IF(ID .EQ. 'GE ') THEN IF(ID .EQ. 'GE ') THEN
! Count the number of variables ! Count the number of variables
I=0 I=0
@ -1875,16 +1887,16 @@
GO TO 80 GO TO 80
ENDIF ENDIF
ELSEIF(ID .EQ. 'E3T') THEN ELSEIF(ID .EQ. 'E3T') THEN
ICOUNT=4 ICOUNT=4+NUMMAT
GO TO 90 GO TO 90
ELSEIF(ID .EQ. 'E4Q') THEN ELSEIF(ID .EQ. 'E4Q') THEN
ICOUNT=5 ICOUNT=5+NUMMAT
GO TO 90 GO TO 90
ELSEIF(ID .EQ. 'E6T') THEN ELSEIF(ID .EQ. 'E6T') THEN
ICOUNT=7 ICOUNT=7+NUMMAT
GO TO 90 GO TO 90
ELSEIF(ID .EQ. 'E8Q') THEN ELSEIF(ID .EQ. 'E8Q') THEN
ICOUNT=9 ICOUNT=9+NUMMAT
GO TO 90 GO TO 90
ENDIF ENDIF
ENDDO ENDDO
@ -1892,7 +1904,15 @@
IF(ICOUNT .GT. 10) THEN IF(ICOUNT .GT. 10) THEN
READ(DLIN1,*) J, (NTMP(K),K=1,9),THT READ(DLIN1,*) J, (NTMP(K),K=1,9),THT
ELSEIF(IGFG .EQ. 3) THEN ELSEIF(IGFG .EQ. 3) THEN
IF(ICOUNT .EQ. 4) THEN IF(ICOUNT .EQ. 3) THEN
READ(DLIN1,*) J, (NTMP(K),K=1,5,2)
NTMP(9)=1
NTMP(2)=0
NTMP(4)=0
NTMP(6)=0
NTMP(7)=0
NTMP(8)=0
ELSEIF(ICOUNT .EQ. 4 .AND. NUMMAT .EQ. 0) THEN
READ(DLIN1,*) J, (NTMP(K),K=1,7,2) READ(DLIN1,*) J, (NTMP(K),K=1,7,2)
IF(NTMP(7) .EQ. 0) then IF(NTMP(7) .EQ. 0) then
NTMP(9)=1 NTMP(9)=1
@ -1904,6 +1924,14 @@
NTMP(6)=0 NTMP(6)=0
NTMP(7)=0 NTMP(7)=0
NTMP(8)=0 NTMP(8)=0
ELSEIF(ICOUNT .EQ. 4 .AND. NUMMAT .LT. 0) THEN
READ(DLIN1,*) J, (NTMP(K),K=1,7,2)
NTMP(9)=1
NTMP(2)=0
NTMP(4)=0
NTMP(6)=0
NTMP(7)=0
NTMP(8)=0
ELSEIF(ICOUNT .EQ. 5) THEN ELSEIF(ICOUNT .EQ. 5) THEN
READ(DLIN1,*) J, (NTMP(K),K=1,9,2) READ(DLIN1,*) J, (NTMP(K),K=1,9,2)
IF(NTMP(9) .EQ. 0) NTMP(9)=1 IF(NTMP(9) .EQ. 0) NTMP(9)=1
@ -2181,6 +2209,8 @@
IDUP=0 IDUP=0
ISWW=1
CALL KCON(ISWW)
call kcon(1) call kcon(1)
do n=1,ne do n=1,ne
if(imat(n) .lt. 900 .and. imat(n) .gt. 0) then if(imat(n) .lt. 900 .and. imat(n) .gt. 0) then

3
SRC84/JOINEL.F90
Unescape Escape View File

@ -38,7 +38,8 @@
NBRRSV=NBRR NBRRSV=NBRR
! get starting elements ! get starting elements
CALL KCON(0) ISWW=0
CALL KCON(ISWW)
DO N=1,NE DO N=1,NE
DO M=1,8 DO M=1,8
NOPSV(N,M)=NOP(N,M) NOPSV(N,M)=NOP(N,M)

127
SRC84/RDOUTLIN.F90
Unescape Escape View File

@ -82,36 +82,121 @@
RETURN RETURN
END END
SUBROUTINE RDSHP5(IMP1) SUBROUTINE RDSHP5(IMP1)
use blkmap use blkmap
USE BLK1MOD USE BLK1MOD
include 'TXFRM.COM' include 'TXFRM.COM'
INTEGER STATUS,I1,I2,I3,I4,I5,I6,I7,I8,I9,NREC,NARS,ISTYP,J2,J3,J4,IADB(1000) INTEGER STATUS,I1,I2,I3,I4,I5,I6,I7,I8,I9,NREC,NARS,ISTYP,J2,J3,J4,IADB(1000)
REAL*8 AXMN,AYMN,AXMX,AYMX,FZ,BXMN,BYMN,BXMX,BYMX integer*2 i1s,i2s,i3s,i3vs(20)
integer*1 i1vs(20),i2vs(20),i1s1,i1s2,i2s1,i2s2
character*1 type(20),a2,a3,a4
character*4 ai1s,ai2s
character*11 label(20),fomat(20)
character*256 field
character*2 a32
REAL*8 AXMN,AYMN,AXMX,AYMX,FZ,BXMN,BYMN,BXMX,BYMX,vtemp(20)
DATA IFIRST/0/
! process dbf file for labels
IASK=0
read(114) i1,i2,i1s1,i1s2,i2s1,i2s2,i3,i4,i5,i6,i7
! limited to small lengths
nrecs=i2
nbytesh=i1s1
nrecsh=nbytesh/32-1
ndytesrec=i2s1
nfl=0
! now process labels
do k=1,nrecsh
read(114) label(k),type(k),i3,i1vs(k),i2vs(k),i3s,i4,i5,i6
if(k .eq. 1) i3vs(k)=1
i3vs(k+1)=i3vs(k)+i1vs(k)
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. 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
write(fomat(k),6002) i1vs(k)
6002 format('(A',i2,')')
endif
endif
enddo
read(114) a32
call choosrec(label,nrecsh,nchs)
ierrrd=0
do k=1,nrecs
if(nchs .eq. 0) then
vtemp(k)=-9999.0
cycle
endif
read(114) field(1:ndytesrec)
l1=i3vs(nchs)
l2=i3vs(nchs+1)
read(field(l1:l2),fomat(nchs),err=450) vtemp(k)
cycle
450 write(90,*)'error reading bed level value set = 0., data = ',field(1:i1vs(k))
ierrrd=1
enddo
if(ierrrd .eq. 1) CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Errors reading bed level','BED LEVEL SET = 0.0')
! read(114) a3
IF(IFIRST .GT. 0) THEN
IS=MAXPTS-1
IP=KLINT+1
ELSE
1 IS=0
IP=2
ENDIF
READ(IMP1) I1,I2,I3,I4,I5,I6,I7,I8,I9,AXMN,AYMN,AXMX,AYMX,FZ,FZ,FZ,FZ READ(IMP1) I1,I2,I3,I4,I5,I6,I7,I8,I9,AXMN,AYMN,AXMX,AYMX,FZ,FZ,FZ,FZ
READ(IMP1) NREC,NARS 100 READ(IMP1,END=200) NREC,NARS
! NREC = RECORD NUMBER
! NARS = RECORD LENGTH
READ(IMP1) ISTYP,BXMN,BYMN,BXMX,BYMX,J2,J3 READ(IMP1) ISTYP,BXMN,BYMN,BXMX,BYMX,J2,J3
! J2 = NUMBER OF PARTS
! J3 = NUMBER OF POINTS
READ(IMP1) (IADB(I),I=1,J2) READ(IMP1) (IADB(I),I=1,J2)
IF( .NOT. ALLOCATED(CMAP)) THEN IF( .NOT. ALLOCATED(CMAP)) THEN
MAXPL=J3 MAXPL=J3
ALLOCATE (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL)) ALLOCATE (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
ENDIF ENDIF
IS=0
IP=2
LINTYP(IP-1)=0 LINTYP(IP-1)=0
DO I=1,J3 DO I=1,J3
IF(I .GT. IADB(IP)) THEN !IF(IADB(IP) .GT. 0) THEN
IS=IS+1 ! IF(I .GT. IADB(IP)) THEN
XMAP(IS)=VOID ! IS=IS+1
YMAP(IS)=VOID ! XMAP(IS)=VOID
CMAP(IS,1)=VOID ! YMAP(IS)=VOID
CMAP(IS,2)=VOID ! CMAP(IS,1)=VOID
VAL(IS)=VOID ! CMAP(IS,2)=VOID
IP=IP+1 ! VAL(IS)=VOID
LINTYP(IP-1)=0 ! IP=IP+1
ENDIF ! LINTYP(IP-1)=0
! ENDIF
!ENDIF
IS=IS+1 IS=IS+1
READ(IMP1) CMAP(IS,1),CMAP(IS,2) READ(IMP1) CMAP(IS,1),CMAP(IS,2)
XMAP(IS)=CMAP(IS,1) XMAP(IS)=CMAP(IS,1)
@ -119,10 +204,24 @@
CMAP(IS,1) = (CMAP(IS,1) + XS) /TXSCAL CMAP(IS,1) = (CMAP(IS,1) + XS) /TXSCAL
CMAP(IS,2) = (CMAP(IS,2) + YS) /TXSCAL CMAP(IS,2) = (CMAP(IS,2) + YS) /TXSCAL
VAL(IS)=-9999. VAL(IS)=-9999.
VAL(IS)=VTEMP(IP-1)
ENDDO ENDDO
IS=IS+1
XMAP(IS)=VOID
YMAP(IS)=VOID
CMAP(IS,1)=VOID
CMAP(IS,2)=VOID
VAL(IS)=VOID
IP=IP+1
LINTYP(IP-1)=0
MAXPTS=IS+1 MAXPTS=IS+1
XMAP(MAXPTS)= VOID XMAP(MAXPTS)= VOID
JLINT=MAXPTS JLINT=MAXPTS
KLINT=IP KLINT=IP
GO TO 100
200 CONTINUE
IFIRST=1
RETURN RETURN
END END

5
SRC84/READSHP.FOR
Unescape Escape View File

@ -246,7 +246,7 @@ c8887 format('lin'/(2i8))
include 'D.inc' include 'D.inc'
SAVE SAVE
character*11 label(*) character*11 label(*)
INTEGER NRECSH,NCHS,IERR,N INTEGER NRECSH,NCHS,IERR,N,icbox
! !
@ -258,6 +258,7 @@ c8887 format('lin'/(2i8))
call wdialogload(IDD_CHSTYP) call wdialogload(IDD_CHSTYP)
ierr=infoerror(1) ierr=infoerror(1)
call wdialogputcheckBox(idf_check1,icbox)
do n=1,NRECSH do n=1,NRECSH
write(90,'(a)') 'file',n,LABEL(N) write(90,'(a)') 'file',n,LABEL(N)
@ -272,7 +273,9 @@ c8887 format('lin'/(2i8))
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
call wdialogGetradiobutton(idf_radio1,NCHS) call wdialogGetradiobutton(idf_radio1,NCHS)
call wdialogGetcheckBox(idf_check1,icbox)
ENDIF ENDIF
if(icbox .eq. 1) nchs=0
RETURN RETURN
END END

3
SRC84/REATTACH.F90
Unescape Escape View File

@ -9,7 +9,8 @@
DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
! SETUP CONNECTIVITY TABLE ! SETUP CONNECTIVITY TABLE
CALL KCON(0) ISWW=0
CALL KCON(ISWW)
! SELECT FIRST ELEMENT ! SELECT FIRST ELEMENT
10 CONTINUE 10 CONTINUE
NHTPSV=NHTP NHTPSV=NHTP

48
SRC84/REORD.F90
Unescape Escape View File

@ -15,7 +15,8 @@
! !
! GET TABLE OF ELEMENT CONNECTIONS ! GET TABLE OF ELEMENT CONNECTIONS
! !
CALL KCON(0) ISWW=0
CALL KCON(ISWW)
ISWALL=0 ISWALL=0
nmess=47 nmess=47
IF(.NOT. ALLOCATED(NKEY1)) THEN IF(.NOT. ALLOCATED(NKEY1)) THEN
@ -335,7 +336,9 @@
! !
! GET TABLE OF ELEMENT CONNECTIONS ! GET TABLE OF ELEMENT CONNECTIONS
! !
CALL KCON(0) ISWW=0
CALL KCON(ISWW)
IF(ISWW .EQ. -1) RETURN
! !
! SETUP NELIM. IDENTIFIES 3 NODE ELEMENTS OR JUNCTIONS WHEN = 1 ! SETUP NELIM. IDENTIFIES 3 NODE ELEMENTS OR JUNCTIONS WHEN = 1
! !
@ -890,13 +893,25 @@
RETURN RETURN
END END
SUBROUTINE KCON(isw1) SUBROUTINE KCON(isw1)
! use winteracter
! ESTABLISH ELEMENT CONNECTED TO ELEMENT TABLE
!
USE BLK1MOD USE BLK1MOD
USE BLK2MOD USE BLK2MOD
! INCLUDE 'BLK1.COM' ! INCLUDE 'BLK1.COM'
! INCLUDE 'BLK2.COM' ! INCLUDE 'BLK2.COM'
! implicit none
include 'D.inc'
!
! Declare window-type and message variables
!
TYPE(WIN_STYLE) :: WINDOW
TYPE(WIN_MESSAGE) :: MESSAGE
!
! ESTABLISH ELEMENT CONNECTED TO ELEMENT TABLE
!
! !
! INITIALIZE ! INITIALIZE
! !
@ -985,8 +1000,27 @@
! !
! END LOOP FOR THIS NODE ! END LOOP FOR THIS NODE
! !
600 END DO 600 END DO
DO M=1,NE
IF(IMAT(M) .LT. 1) CYCLE
IF(ICON(M,1) .EQ. 0) THEN
call wdialogload(IDD_NOCONNECT)
CALL WDialogSelect(IDD_NOCONNECT)
ierr=infoerror(1)
CALL WDialogPutInteger(idf_integer1,m)
CALL WDialogShow(-1,-1,0,Modal)
ierr=infoerror(1)
do
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
ISW1=-1
RETURN
ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
ENDIF
ENDDO
ENDIF
610 CONTINUE
ENDDO
! do n=1,ne ! do n=1,ne
! write(86,'(31i6)') n,(icon(n,j),j=1,ncmi) ! write(86,'(31i6)') n,(icon(n,j),j=1,ncmi)
! enddo ! enddo

3
SRC84/RESETWHGT.f90
Unescape Escape View File

@ -18,7 +18,8 @@
K1=0 K1=0
levrem=0 levrem=0
WHGT=-9999. WHGT=-9999.
call kcon(1) ISWW=1
CALL KCON(ISWW)
CALL PANELWHT(IWTYP,ISWL,R1,R2) CALL PANELWHT(IWTYP,ISWL,R1,R2)
IF(IWTYP .LE. 0) RETURN IF(IWTYP .LE. 0) RETURN
IF(ISWL .EQ. 2) GO TO 300 IF(ISWL .EQ. 2) GO TO 300

21
SRC84/RMAGEN.F90
Unescape Escape View File

@ -256,12 +256,16 @@
! Read in existing elements ! Read in existing elements
WRITE(90,*) 'GOING TO RDELEM' WRITE(90,*) 'GOING TO RDELEM'
call second(timc)
CALL RDELEM(IIN) CALL RDELEM(IIN)
call second(timd)
write(90,*) 'time in element read',timd-timc
! Read in nodal coordinates ! Read in nodal coordinates
WRITE(90,*) 'GOING TO RDCORD' WRITE(90,*) 'GOING TO RDCORD'
CALL RDCORD(IIN) CALL RDCORD(IIN)
call second(timee)
write(90,*) 'time in node read',timee-timd
WRITE(90,*) 'RMAGEN-243 NCLM',NCLM WRITE(90,*) 'RMAGEN-243 NCLM',NCLM
@ -711,3 +715,18 @@
return return
end end
SUBROUTINE SECOND(TA)
SAVE
!C This version is for microsoft fortran
DATA ITIM/0/
CALL GETTIM(IHR,IMIN,ISEC,IHUN)
TA=3600.*IHR+60.*IMIN+ISEC+ FLOAT(IHUN)/100.
IF(ITIM .EQ. 0) THEN
TOLD=TA
ITIM=1
ENDIF
TA=TA-TOLD
RETURN
END

79
SRC84/RMAGENV83e.rc
Unescape Escape View File

@ -8,7 +8,7 @@
// //
// Winteracter resource script. // Winteracter resource script.
// //
// Modified : 10/Jul/2021 17:03:10 // Modified : 23/Oct/2021 16:23:24
// //
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //
@ -421,6 +421,7 @@
#define ID_RESTORELEV 40153 #define ID_RESTORELEV 40153
#define ID_UPDTWGHT 40154 #define ID_UPDTWGHT 40154
#define IDD_PLTSHP 172 #define IDD_PLTSHP 172
#define IDD_NOCONNECT 173
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //
@ -1954,32 +1955,33 @@ BEGIN
,0 ,0
END END
IDD_CHSTYP DIALOG 0, 0, 181, 224 IDD_CHSTYP DIALOG 0, 0, 273, 241
STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
FONT 8, "MS Sans Serif" FONT 9, "MS Sans Serif"
CAPTION "SELECT DATA SET" CAPTION "SELECT DATA SET"
BEGIN BEGIN
CONTROL "",IDF_STRING25,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 36, 80, 12 CONTROL "",IDF_STRING25,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 24, 170, 12
CONTROL "",IDF_STRING26,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 50, 80, 12 CONTROL "",IDF_STRING26,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 38, 170, 12
CONTROL "",IDF_STRING27,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 64, 80, 12 CONTROL "",IDF_STRING27,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 52, 170, 12
CONTROL "",IDF_STRING28,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 78, 80, 12 CONTROL "",IDF_STRING28,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 66, 170, 12
CONTROL "",IDF_STRING29,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 92, 80, 12 CONTROL "",IDF_STRING29,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 80, 170, 12
CONTROL "",IDF_STRING30,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 106, 80, 12 CONTROL "",IDF_STRING30,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 94, 170, 12
CONTROL "",IDF_STRING31,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 120, 80, 12 CONTROL "",IDF_STRING31,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 108, 170, 12
CONTROL "",IDF_STRING32,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 134, 80, 12 CONTROL "",IDF_STRING32,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 122, 170, 12
CONTROL "",IDF_STRING33,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 148, 80, 12 CONTROL "",IDF_STRING33,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 136, 170, 12
CONTROL "",IDF_STRING34,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 162, 80, 12 CONTROL "",IDF_STRING34,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 150, 170, 12
CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 71, 196, 40, 14 CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 116, 210, 40, 14
CONTROL "",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 36, 20, 12 CONTROL "",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 24, 20, 12
CONTROL "",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 50, 20, 12 CONTROL "",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 38, 20, 12
CONTROL "",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 64, 20, 12 CONTROL "",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 52, 20, 12
CONTROL "",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 78, 20, 12 CONTROL "",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 66, 20, 12
CONTROL "",IDF_RADIO5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 92, 20, 12 CONTROL "",IDF_RADIO5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 80, 20, 12
CONTROL "",IDF_RADIO6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 106, 20, 12 CONTROL "",IDF_RADIO6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 94, 20, 12
CONTROL "",IDF_RADIO7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 120, 20, 12 CONTROL "",IDF_RADIO7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 108, 20, 12
CONTROL "",IDF_RADIO8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 134, 20, 12 CONTROL "",IDF_RADIO8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 122, 20, 12
CONTROL "",IDF_RADIO9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 148, 20, 12 CONTROL "",IDF_RADIO9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 136, 20, 12
CONTROL "",IDF_RADIO10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 162, 20, 12 CONTROL "",IDF_RADIO10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 215, 150, 20, 12
CONTROL "Ignore all Options Apply no Bed Elevation",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 44, 180, 188, 14
END END
IDD_CHSTYP RCDATA IDD_CHSTYP RCDATA
@ -1995,6 +1997,9 @@ BEGIN
" 1054 0 \n" " 1054 0 \n"
" 1055 0 \n" " 1055 0 \n"
" 1056 0 \n" " 1056 0 \n"
" 1036 0 \n"
"[Fonts] \n"
" 1036 9 MS Sans Serif, 700 0 \n"
"[Colours] \n" "[Colours] \n"
" 1106 256 256 256 255 255 128 \n" " 1106 256 256 256 255 255 128 \n"
" 1107 256 256 256 255 255 128 \n" " 1107 256 256 256 255 255 128 \n"
@ -2264,6 +2269,30 @@ BEGIN
,0 ,0
END END
IDD_NOCONNECT DIALOG 0, 0, 263, 122
STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
FONT 8, "MS Sans Serif"
CAPTION "ERROR IN REORDERING"
BEGIN
CONTROL "NO CONNECTIONS TO ELEMENT TERMINATE ORDERING?",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_MULTILINE, 50, 20, 162, 28
CONTROL "YES",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 54, 80, 40, 14
CONTROL "NO",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 166, 80, 40, 14
CONTROL "ELEMENT NUMBER",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 62, 52, 98, 14
CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 164, 52, 40, 14
END
IDD_NOCONNECT RCDATA
BEGIN
"[Ranges] \n"
"[Fonts] \n"
" 1013 10 MS Sans Serif, 700 0 \n"
" 1 10 MS Sans Serif, 700 0 \n"
" 2 10 MS Sans Serif, 700 0 \n"
" 1014 10 MS Sans Serif, 700 0 \n"
" 1057 10 MS Sans Serif, 700 0 \n"
,0
END
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //
// Menus // Menus
@ -2675,4 +2704,4 @@ END
//*WI* FILENAME D.INC //*WI* FILENAME D.INC
//*WI* FMODNAME //*WI* FMODNAME
//*WI* LASTTYPE 2 //*WI* LASTTYPE 2
//*WI* LASTRES 72 //*WI* LASTRES 73

BIN
SRC84/RMAGENV83e.res
View File

Binary file not shown.

10
SRC84/addmap.f90
Unescape Escape View File

@ -56,7 +56,9 @@
OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read') OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
ENDIF ENDIF
ENDIF ENDIF
CALL RDMAP(2,IMP,0,0) JZER=0
KZER=0
CALL RDMAP(2,IMP,JZER,KZER)
NEWMAXK=KEEP1+klint NEWMAXK=KEEP1+klint
NEWMAXPL=JEEP1+jlint NEWMAXPL=JEEP1+jlint
IF(NEWMAXPL .GT. MAXPL) THEN IF(NEWMAXPL .GT. MAXPL) THEN
@ -84,8 +86,10 @@
JSTT=JLINT JSTT=JLINT
KSTT=KLINT KSTT=KLINT
CALL RDMAP(2,99,JSTT,KSTT) IF(IMP .NE. 113) THEN
CLOSE(99) CALL RDMAP(2,99,JSTT,KSTT)
CLOSE(99)
ENDIF
call PLOTOT(0) call PLOTOT(0)
CALL HEDR CALL HEDR
RETURN RETURN

Write Preview
Loading…
Cancel
Save