Skip to content

Commit

Permalink
Committing all the code as received from Jan
Browse files Browse the repository at this point in the history
  • Loading branch information
J Todd committed May 24, 2018
1 parent 50e3c33 commit 06a7a03
Show file tree
Hide file tree
Showing 35 changed files with 11,114 additions and 0 deletions.
674 changes: 674 additions & 0 deletions LICENSE

Large diffs are not rendered by default.

142 changes: 142 additions & 0 deletions amat.f
Original file line number Diff line number Diff line change
@@ -0,0 +1,142 @@
SUBROUTINE AMAT(E,W,G,X1,Y1,Z1,X2,Y2,Z2,L,DUT,N1,N2,I,RY,CT)

INCLUDE 'param.dat'
REAL*8 RK(12,12),B(NODC),CT(NODC)
REAL*8 T(12,12),TT(12,12),DUT(NODM)
REAL*8 F(12),X1,Y1,Z1,X2,Y2,Z2
REAL*8 E,W,L,G,SPRK,SRK,SF
INTEGER I,J,S,N1,N2,RY,myid
c COMMON /KM/ RK
c COMMON /BT/ T
c COMMON /BTT/ TT
c COMMON /CT/ CT
PARAMETER(ZERO = 0.0E+0)


c OPEN(UNIT=20,FILE='TEST',STATUS='UNKNOWN')

c write(20,*) (X1+X2)/2.0, L
c IF (L.LT.0.01) L=0.01
c write(*,*) 'E=',E
c L=1.0

CALL TMAT(X1,Y1,Z1,X2,Y2,Z2,RY,T)
CALL KMAT(E,G,W,L,RY,RK)


B(12*I-11)=
1 T(1,1)*DUT(6*N1-5) + T(1,2)*DUT(6*N1-4)
1 + T(1,3)*DUT(6*N1-3)

B(12*I-10)=
1 T(2,1)*DUT(6*N1-5) + T(2,2)*DUT(6*N1-4)
1 + T(2,3)*DUT(6*N1-3)

B(12*I-9)=
1 T(3,1)*DUT(6*N1-5) + T(3,2)*DUT(6*N1-4)
1 + T(3,3)*DUT(6*N1-3)

B(12*I-8)=
1 T(4,4)*DUT(6*N1-2)
1 + T(4,5)*DUT(6*N1-1) + T(4,6)*DUT(6*N1-0)

B(12*I-7)=
1 T(5,4)*DUT(6*N1-2)
1 + T(5,5)*DUT(6*N1-1) + T(5,6)*DUT(6*N1-0)

B(12*I-6)=
1 T(6,4)*DUT(6*N1-2)
1 + T(6,5)*DUT(6*N1-1) + T(6,6)*DUT(6*N1-0)

B(12*I-5)=
1 T(7,7)*DUT(6*N2-5) + T(7,8)*DUT(6*N2-4)
1 + T(7,9)*DUT(6*N2-3)

B(12*I-4)=
1 T(8,7)*DUT(6*N2-5) + T(8,8)*DUT(6*N2-4)
1 + T(8,9)*DUT(6*N2-3)

B(12*I-3)=
1 T(9,7)*DUT(6*N2-5) + T(9,8)*DUT(6*N2-4)
1 + T(9,9)*DUT(6*N2-3)

B(12*I-2)=
1 T(10,10)*DUT(6*N2-2)
1 + T(10,11)*DUT(6*N2-1) + T(10,12)*DUT(6*N2-0)

B(12*I-1)=
1 T(11,10)*DUT(6*N2-2)
1 + T(11,11)*DUT(6*N2-1) + T(11,12)*DUT(6*N2-0)

B(12*I-0)=
1 T(12,10)*DUT(6*N2-2)
1 + T(12,11)*DUT(6*N2-1) + T(12,12)*DUT(6*N2-0)
c----------------------------------------------------------------
CT(12*I-11)= CT(12*I-11)
1 + RK(1,1)*B(12*I-11)+ RK(1,7)*B(12*I-5)

CT(12*I-10)= CT(12*I-10)
1 + RK(2,2)*B(12*I-10)
1 + RK(2,6)*B(12*I-6)
1 + RK(2,8)*B(12*I-4)
1 + RK(2,12)*B(12*I-0)

CT(12*I-9)= CT(12*I-9)
1 + RK(3,3)*B(12*I-9)
1 + RK(3,5)*B(12*I-7)
1 + RK(3,9)*B(12*I-3)
1 + RK(3,11)*B(12*I-1)

CT(12*I-8)= CT(12*I-8)
1 + RK(4,4)*B(12*I-8)
1 + RK(4,10)*B(12*I-2)


CT(12*I-7)= CT(12*I-7)
1 + RK(5,3)*B(12*I-9)
1 + RK(5,5)*B(12*I-7)
1 + RK(5,9)*B(12*I-3)
1 + RK(5,11)*B(12*I-1)

CT(12*I-6)= CT(12*I-6)
1 + RK(6,2)*B(12*I-10)
1 + RK(6,6)*B(12*I-6)
1 + RK(6,8)*B(12*I-4)
1 + RK(6,12)*B(12*I-0)

CT(12*I-5)= CT(12*I-5)
1 + RK(7,1)*B(12*I-11)
1 + RK(7,7)*B(12*I-5)

CT(12*I-4)= CT(12*I-4)
1 + RK(8,2)*B(12*I-10)
1 + RK(8,6)*B(12*I-6)
1 + RK(8,8)*B(12*I-4)
1 + RK(8,12)*B(12*I-0)

CT(12*I-3)= CT(12*I-3)
1 + RK(9,3)*B(12*I-9)
1 + RK(9,5)*B(12*I-7)
1 + RK(9,9)*B(12*I-3)
1 + RK(9,11)*B(12*I-1)

CT(12*I-2)= CT(12*I-2)
1 + RK(10,4)*B(12*I-8)
1 + RK(10,10)*B(12*I-2)


CT(12*I-1)= CT(12*I-1)
1 + RK(11,3)*B(12*I-9)
1 + RK(11,5)*B(12*I-7)
1 + RK(11,9)*B(12*I-3)
1 + RK(11,11)*B(12*I-1)

CT(12*I-0)= CT(12*I-0)
1 + RK(12,2)*B(12*I-10)
1 + RK(12,6)*B(12*I-6)
1 + RK(12,8)*B(12*I-4)
1 + RK(12,12)*B(12*I-0)
c-----------------------------------------------------------

RETURN
END
93 changes: 93 additions & 0 deletions ave.f
Original file line number Diff line number Diff line change
@@ -0,0 +1,93 @@
PROGRAM STAND

REAL AFIL(2000),NFIL(2000),DX,DY,J,LJ,DR,DT
REAL STR
INTEGER IDX,N,T,I,SDX
CHARACTER*2 na(0:64)
data na/'00','01','02','03','04','05','06','07','08',
1 '09','10','11','12','13','14','15','16','17',
1 '18','19','20','21','22','23','24','25','26',
1 '27','28','29','30','31','32','33','34','35',
1 '36','37','38','39','40','41','42','43','44',
1 '45','46','47','48','49','50','51','52','53',
1 '54','55','56','57','58','59','60','61','62','63','64'/
CHARACTER*20 INFI

2 FORMAT (A)
c WRITE(*,*) 'N?'
WRITE(*,*) 'INFI?,N'
READ(*,2) INFI
READ(*,*) N

SDX=0
OPEN(UNIT=10,FILE=INFI,STATUS='OLD')
OPEN(UNIT=700,FILE='AR',STATUS='UNKNOWN')

DO 5 I=1,2000
AFIL(I)=0.0
NFIL(I)=0.0
5 CONTINUE


DO 20 T=1,N
READ(10,*) DX,DR
DX=(DX*50.0*50.0)/1000.0
! DX=(DX*50.0*50.0*50.0)**0.667
! DR=DR**0.5
IF (DX.LT.10) THEN
IDX=DX
AFIL(IDX)=AFIL(IDX)+DR
GOTO 20
ENDIF

DO 10 I=1,200
J=I-50
c J=(I+1)/7.0
c LJ=(I-1)/7.0
RI=EXP(J/6.0)
ORI=EXP((J-1)/6.0)
IF (DX.GE.ORI.AND.DX.LT.RI) THEN
AFIL(I)=AFIL(I)+DR
NFIL(I)=NFIL(I)+1.0
ENDIF
10 CONTINUE
20 CONTINUE


! DO 23 T=1,9
! WRITE(700,*) T,AFIL(T)
! 23 CONTINUE


SM=0
DO 30 T=1,200
J=T-50
IF (NFIL(T).GE.1) THEN
c write(*,*) NFIL(T)
c WRITE(70,*) (EXP(J/10.)+EXP((J-1)/10.))/2.,(AFIL(T)/NFIL(T))
WRITE(700,*) EXP((T-50.0-0.5)/6.0),
1 AFIL(T)/(EXP((J)/6.)-EXP((J-1.0)/6.))
ENDIF
30 CONTINUE

STOP
END



















90 changes: 90 additions & 0 deletions ave2.f
Original file line number Diff line number Diff line change
@@ -0,0 +1,90 @@
PROGRAM STAND

REAL AFIL(2000),NFIL(2000),DX,DY,J,LJ,DR,DT
REAL STR
INTEGER IDX,N,T,I,SDX
CHARACTER*2 na(0:64)
data na/'00','01','02','03','04','05','06','07','08',
1 '09','10','11','12','13','14','15','16','17',
1 '18','19','20','21','22','23','24','25','26',
1 '27','28','29','30','31','32','33','34','35',
1 '36','37','38','39','40','41','42','43','44',
1 '45','46','47','48','49','50','51','52','53',
1 '54','55','56','57','58','59','60','61','62','63','64'/
CHARACTER*20 INFI

2 FORMAT (A)
c WRITE(*,*) 'N?'
WRITE(*,*) 'INFI?,N'
READ(*,2) INFI
READ(*,*) N

SDX=0
OPEN(UNIT=10,FILE=INFI,STATUS='OLD')
OPEN(UNIT=700,FILE='AR',STATUS='UNKNOWN')

DO 5 I=1,2000
AFIL(I)=0.0
NFIL(I)=0.0
5 CONTINUE


DO 20 T=1,N
READ(10,*) DX,DR
IF (DX.LT.10) THEN
IDX=DX
AFIL(IDX)=AFIL(IDX)+DR
GOTO 20
ENDIF

DO 10 I=1,200
J=I-50
c J=(I+1)/7.0
c LJ=(I-1)/7.0
RI=EXP(J/3.0)
ORI=EXP((J-1)/3.0)
IF (DX.GE.ORI.AND.DX.LT.RI) THEN
AFIL(I)=AFIL(I)+DR
NFIL(I)=NFIL(I)+1.0
ENDIF
10 CONTINUE
20 CONTINUE


DO 23 T=1,9
WRITE(700,*) T,AFIL(T)
23 CONTINUE


SM=0
DO 30 T=10,200
J=T-50
IF (NFIL(T).GE.1) THEN
c write(*,*) NFIL(T)
c WRITE(70,*) (EXP(J/10.)+EXP((J-1)/10.))/2.,(AFIL(T)/NFIL(T))
WRITE(700,*) EXP((T-50.0-0.5)/3.0),
1 AFIL(T)/(EXP((J)/3.)-EXP((J-1.0)/3.))
ENDIF
30 CONTINUE

STOP
END



















Loading

0 comments on commit 06a7a03

Please sign in to comment.