You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
107 lines
2.1 KiB
Fortran
107 lines
2.1 KiB
Fortran
5 years ago
|
SUBROUTINE WRTBIN
|
||
|
|
||
|
USE BLK1MOD
|
||
|
! INCLUDE 'BLK1.COM'
|
||
|
|
||
|
DIMENSION IREC(40),FREC(40)
|
||
|
|
||
|
CHARACTER*4 IPACKB(1200),IPACKT(77)
|
||
|
|
||
|
DATA (IREC(I),I=1,40) / 40*0 /
|
||
|
DATA (FREC(I),I=1,40) / 40*0. /
|
||
|
|
||
|
! Write GFGEN banners
|
||
|
|
||
|
IREC(1) = 435
|
||
|
MFLG = 100
|
||
|
WRITE(IOT1) MFLG,IREC(1),NP,NE
|
||
|
IWRT1 = 1200
|
||
|
DO I=11,1200
|
||
|
IPACKB(I)=' '
|
||
|
ENDDO
|
||
|
IPACKB(1)='RMA '
|
||
|
IPACKB(2)='IMPL'
|
||
|
IPACKB(3)='EMEN'
|
||
|
IPACKB(4)='TATI'
|
||
|
IPACKB(5)='ON O'
|
||
|
IPACKB(6)='F SM'
|
||
|
IPACKB(7)='S OU'
|
||
|
IPACKB(8)='TPUT'
|
||
|
IPACKB(9)=' FOR'
|
||
|
IPACKB(10)='MAT '
|
||
|
|
||
|
WRITE (IOT1) IWRT1, (IPACKB(I),I= 1,IWRT1)
|
||
|
|
||
|
IWRT2 = 40
|
||
|
IWRT3 = 40
|
||
|
WRITE (IOT1) IWRT2, IWRT3,(IREC(I),I=1, IWRT2), (FREC(I),I=1,IWRT3)
|
||
|
DO I=1,77
|
||
|
IPACKT(I)=' '
|
||
|
IF(I .LT. 73) THEN
|
||
|
IPACKT(I)(1:1)=TITLE(I:I)
|
||
|
ENDIF
|
||
|
ENDDO
|
||
|
IWRT4 = 77
|
||
|
WRITE (IOT1) IWRT4, (IPACKT(I),I= 1,IWRT4)
|
||
|
|
||
|
DO J=1,NP
|
||
|
!IPK FEB05
|
||
|
CORDSN(J,1)=XUSR(J)
|
||
|
CORDSN(J,2)=YUSR(J)
|
||
|
ENDDO
|
||
|
DO J=1,NE
|
||
|
IMATL(J)=IMAT(J)
|
||
|
ENDDO
|
||
|
ALPHA=0.
|
||
|
WRITE(IOT1) NP,NE,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,NP)&
|
||
|
,((NOP(J,K),K=1,8),IMATL(J),THTA(J),IEM(J),J=1,NE)
|
||
|
WRITE(IOT1) (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,NP)
|
||
|
|
||
|
|
||
|
RETURN
|
||
|
END
|
||
|
|
||
|
|
||
|
SUBROUTINE RDBIN(IIIN)
|
||
|
|
||
|
USE BLK1MOD
|
||
|
! INCLUDE 'BLK1.COM'
|
||
|
|
||
|
IIN=IIIN
|
||
|
|
||
|
! Read GFGEN banners
|
||
|
|
||
|
READ(IIN) MFLG,IREC,N,M
|
||
|
READ(IIN) IWRT1,(IDUM,I=1,IWRT1)
|
||
|
READ(IIN) IWRT2,IWRT3,(IDUM,I=1,IWRT2),(FDUM,I=1,IWRT3)
|
||
|
READ(IIN) IWRT4,(IDUM,I=1,IWRT4)
|
||
|
|
||
|
READ(IIN) N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1),&
|
||
|
((NOP(J,K),K=1,8),IMATL(J),TH0,I3,J=1,M1)
|
||
|
READ(IIN) (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
|
||
|
|
||
|
DO J=1,N1
|
||
|
DO K=1,2
|
||
|
CORD(J,K)=CORDSN(J,K)
|
||
|
ENDDO
|
||
|
XUSR(J)=CORD(J,1)
|
||
|
YUSR(J)=CORD(J,2)
|
||
|
ENDDO
|
||
|
|
||
|
DO J=1,M1
|
||
|
IMAT(J)=IMATL(J)
|
||
|
!ipk feb08
|
||
|
ncorn(j)=0
|
||
|
DO K=1,8
|
||
|
if(nop(j,k) .gt. 0) ncorn(j)=k
|
||
|
ENDDO
|
||
|
ENDDO
|
||
|
NP=N1
|
||
|
NE=M1
|
||
|
|
||
|
|
||
|
CLOSE(IIN)
|
||
|
|
||
|
RETURN
|
||
|
END
|