├── 2
└── LINESLIDER.F90
├── 3
└── SURFACESLIDER.F90
├── 4
└── JOURNAL.f90
├── 5
├── SQUARESQUEEZE.F90
├── CIRCULARSQUEEZE.F90
└── JOURNALSQUEEZE.F90
├── 6
└── DYNAMICBEARING.F90
├── 7
├── GASSLIDER.F90
├── GASJOURNAL.f90
└── GASSURFACE.f90
├── 8
└── RARIFIEDGAS.F90
├── 9
└── GREASESLIDER.F90
├── 10
├── LINETHERM.F90
└── SURFACETHERM.F90
├── 11
└── JOURNALTHERM.f90
├── 12
├── VI（LINE）.F90
├── VI£¨LINE£©.F90
├── VI(POINT).F90
├── LINE.f90
└── POINT.F90
├── 13
└── LINEEHL.f90
├── 14
└── POINTEHL.f90
├── 15
└── GREASELINEEHL.f90
├── 16
└── GREASEPOINTEHL.f90
├── 17
└── LINEEHLT.F90
├── 18
└── POINTEHLT.f90
├── 19
└── GREASELINETHERMEHL.f90
├── 20
└── GREASEPOINTEHLT.F90
├── 21
├── HBFA.F90
├── HBFA.opt
├── Script1.rc
├── bitmap3.bmp
├── bitmap5.bmp
├── Debug
│ ├── DF60.PDB
│ ├── HBFA.exe
│ ├── HBFA.obj
│ ├── HBFA.pdb
│ ├── TAIDA8.obj
│ └── Script1.res
├── resource.hm
├── HBFA.plg
├── HBFA.dsw
├── TAIDA8.PLG
├── resource.fd
└── HBFA.dsp
├── 22
├── HBOA.F90
├── HBOA.opt
├── Script1.rc
├── Debug
│ ├── DF60.PDB
│ ├── HBOA.exe
│ ├── HBOA.obj
│ ├── HBOA.pdb
│ └── Script1.res
├── resource.hm
├── HBOA.plg
├── HBOA.dsw
├── resource.h
├── HBOA.dsp
└── resource.fd
├── 23
└── MAGNETICHEAD.F90
├── 24
└── FH.F90
└── README.md
/24/FH.F90:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/24/FH.F90
--------------------------------------------------------------------------------
/21/HBFA.F90:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/HBFA.F90
--------------------------------------------------------------------------------
/21/HBFA.opt:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/HBFA.opt
--------------------------------------------------------------------------------
/22/HBOA.F90:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/HBOA.F90
--------------------------------------------------------------------------------
/22/HBOA.opt:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/HBOA.opt
--------------------------------------------------------------------------------
/21/Script1.rc:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/Script1.rc
--------------------------------------------------------------------------------
/21/bitmap3.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/bitmap3.bmp
--------------------------------------------------------------------------------
/21/bitmap5.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/bitmap5.bmp
--------------------------------------------------------------------------------
/22/Script1.rc:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/Script1.rc
--------------------------------------------------------------------------------
/21/Debug/DF60.PDB:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/Debug/DF60.PDB
--------------------------------------------------------------------------------
/21/Debug/HBFA.exe:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/Debug/HBFA.exe
--------------------------------------------------------------------------------
/21/Debug/HBFA.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/Debug/HBFA.obj
--------------------------------------------------------------------------------
/21/Debug/HBFA.pdb:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/Debug/HBFA.pdb
--------------------------------------------------------------------------------
/21/Debug/TAIDA8.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/Debug/TAIDA8.obj
--------------------------------------------------------------------------------
/22/Debug/DF60.PDB:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/Debug/DF60.PDB
--------------------------------------------------------------------------------
/22/Debug/HBOA.exe:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/Debug/HBOA.exe
--------------------------------------------------------------------------------
/22/Debug/HBOA.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/Debug/HBOA.obj
--------------------------------------------------------------------------------
/22/Debug/HBOA.pdb:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/Debug/HBOA.pdb
--------------------------------------------------------------------------------
/5/SQUARESQUEEZE.F90:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/5/SQUARESQUEEZE.F90
--------------------------------------------------------------------------------
/21/Debug/Script1.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/21/Debug/Script1.res
--------------------------------------------------------------------------------
/22/Debug/Script1.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/22/Debug/Script1.res
--------------------------------------------------------------------------------
/5/CIRCULARSQUEEZE.F90:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/5/CIRCULARSQUEEZE.F90
--------------------------------------------------------------------------------
/5/JOURNALSQUEEZE.F90:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/5/JOURNALSQUEEZE.F90
--------------------------------------------------------------------------------
/6/DYNAMICBEARING.F90:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/cfdcoach/lubrication-num/HEAD/6/DYNAMICBEARING.F90
--------------------------------------------------------------------------------
/21/resource.hm:
--------------------------------------------------------------------------------
1 | // Microsoft Developer Studio generated Help ID include file.
2 | // Used by Script1.rc
3 | //
4 | #define HIDC_STATIC 0x8065ffff // IDD_DIALOG1
5 |
--------------------------------------------------------------------------------
/22/resource.hm:
--------------------------------------------------------------------------------
1 | // Microsoft Developer Studio generated Help ID include file.
2 | // Used by Script1.rc
3 | //
4 | #define HIDC_STATIC 0x8065ffff // IDD_DIALOG1
5 |
--------------------------------------------------------------------------------
/12/VI（LINE）.F90:
--------------------------------------------------------------------------------
1 | SUBROUTINE VI(N,DX,P,V)
2 | DIMENSION P(N),V(N)
3 | COMMON /COMAK/AK(0:1100)
4 | PAI1=0.318309886
5 | C=ALOG(DX)
6 | DO 10 I=1,N
7 | V(I)=0.0
8 | DO 10 J=1,N
9 | IJ=IABS(I-J)
10 | 10 V(I)=V(I)+(AK(IJ)+C)*DX*P(J)
11 | DO I=1,N
12 | V(I)=-PAI1*V(I)
13 | ENDDO
14 | RETURN
15 | END
16 | SUBROUTINE SUBAK(MM)
17 | COMMON /COMAK/AK(0:1100)
18 | DO 10 I=0,MM
19 | 10 AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
20 | RETURN
21 | END
22 |
--------------------------------------------------------------------------------
/12/VI£¨LINE£©.F90:
--------------------------------------------------------------------------------
1 | SUBROUTINE VI(N,DX,P,V)
2 | DIMENSION P(N),V(N)
3 | COMMON /COMAK/AK(0:1100)
4 | PAI1=0.318309886
5 | C=ALOG(DX)
6 | DO 10 I=1,N
7 | V(I)=0.0
8 | DO 10 J=1,N
9 | IJ=IABS(I-J)
10 | 10 V(I)=V(I)+(AK(IJ)+C)*DX*P(J)
11 | DO I=1,N
12 | V(I)=-PAI1*V(I)
13 | ENDDO
14 | RETURN
15 | END
16 | SUBROUTINE SUBAK(MM)
17 | COMMON /COMAK/AK(0:1100)
18 | DO 10 I=0,MM
19 | 10 AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
20 | RETURN
21 | END
22 |
--------------------------------------------------------------------------------
/21/HBFA.plg:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Build Log
5 |
6 | --------------------Configuration: HBFA - Win32 Debug--------------------
7 |
8 | Command Lines
9 | Creating command line "link.exe kernel32.lib /nologo /subsystem:console /incremental:no /pdb:"Debug/HBFA.pdb" /debug /machine:I386 /out:"Debug/HBFA.exe" /pdbtype:sept .\Debug\Script1.res .\Debug\HBFA.OBJ "
10 | Output Window
11 | Linking...
12 |
13 |
14 |
15 | Results
16 | HBFA.exe - 0 error(s), 0 warning(s)
17 |
18 |
19 |
20 |
--------------------------------------------------------------------------------
/22/HBOA.plg:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Build Log
5 |
6 | --------------------Configuration: HBOA - Win32 Debug--------------------
7 |
8 | Command Lines
9 | Creating command line "link.exe kernel32.lib /nologo /subsystem:console /incremental:no /pdb:"Debug/HBOA.pdb" /debug /machine:I386 /out:"Debug/HBOA.exe" /pdbtype:sept .\Debug\HBOA.OBJ .\Debug\Script1.res "
10 | Output Window
11 | Linking...
12 |
13 |
14 |
15 | Results
16 | HBOA.exe - 0 error(s), 0 warning(s)
17 |
18 |
19 |
20 |
--------------------------------------------------------------------------------
/21/HBFA.dsw:
--------------------------------------------------------------------------------
1 | Microsoft Developer Studio Workspace File, Format Version 6.00
2 | # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
3 |
4 | ###############################################################################
5 |
6 | Project: "HBFA"=.\HBFA.dsp - Package Owner=<4>
7 |
8 | Package=<5>
9 | {{{
10 | }}}
11 |
12 | Package=<4>
13 | {{{
14 | }}}
15 |
16 | ###############################################################################
17 |
18 | Global:
19 |
20 | Package=<5>
21 | {{{
22 | }}}
23 |
24 | Package=<3>
25 | {{{
26 | }}}
27 |
28 | ###############################################################################
29 |
30 |
--------------------------------------------------------------------------------
/22/HBOA.dsw:
--------------------------------------------------------------------------------
1 | Microsoft Developer Studio Workspace File, Format Version 6.00
2 | # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
3 |
4 | ###############################################################################
5 |
6 | Project: "HBOA"=.\HBOA.dsp - Package Owner=<4>
7 |
8 | Package=<5>
9 | {{{
10 | }}}
11 |
12 | Package=<4>
13 | {{{
14 | }}}
15 |
16 | ###############################################################################
17 |
18 | Global:
19 |
20 | Package=<5>
21 | {{{
22 | }}}
23 |
24 | Package=<3>
25 | {{{
26 | }}}
27 |
28 | ###############################################################################
29 |
30 |
--------------------------------------------------------------------------------
/12/VI(POINT).F90:
--------------------------------------------------------------------------------
1 | SUBROUTINE VI(N,DX,P,V)
2 | DIMENSION P(N,N),V(N,N)
3 | COMMON /COMAK/AK(0:65,0:65)
4 | PAI1=0.2026423
5 | DO 40 I=1,N
6 | DO 40 J=1,N
7 | H0=0.0
8 | DO 30 K=1,N
9 | IK=IABS(I-K)
10 | DO 30 L=1,N
11 | JL=IABS(J-L)
12 | 30 H0=H0+AK(IK,JL)*P(K,L)
13 | 40 V(I,J)=H0*DX*PAI1
14 | RETURN
15 | END
16 | SUBROUTINE SUBAK(MM)
17 | COMMON /COMAK/AK(0:65,0:65)
18 | S(X,Y)=X+SQRT(X**2+Y**2)
19 | DO 10 I=0,MM
20 | XP=I+0.5
21 | XM=I-0.5
22 | DO 10 J=0,I
23 | YP=J+0.5
24 | YM=J-0.5
25 | A1=S(YP,XP)/S(YM,XP)
26 | A2=S(XM,YM)/S(XP,YM)
27 | A3=S(YM,XM)/S(YP,XM)
28 | A4=S(XP,YP)/S(XM,YP)
29 | AK(I,J)=XP*ALOG(A1)+YM*ALOG(A2)+XM*ALOG(A3)+YP*ALOG(A4)
30 | 10 AK(J,I)=AK(I,J)
31 | RETURN
32 | END
33 |
--------------------------------------------------------------------------------
/21/TAIDA8.PLG:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Build Log
5 |
6 | --------------------Configuration: TAIDA8 - Win32 Debug--------------------
7 |
8 | Command Lines
9 | Creating temporary file "E:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\RSP21.tmp" with contents
10 | [
11 | /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt /module:"Debug/" /object:"Debug/" /pdbfile:"Debug/DF60.PDB"
12 | "E:\Documents and Settings\Administrator\My Documents\HBFA\TAIDA8.F90"
13 | ]
14 | Output Window
15 | Compiling Fortran...
16 | E:\Documents and Settings\Administrator\My Documents\HBFA\TAIDA8.F90
17 |
18 |
19 |
20 | Results
21 | TAIDA8.OBJ - 0 error(s), 0 warning(s)
22 |
23 |
24 |
25 |
--------------------------------------------------------------------------------
/12/LINE.f90:
--------------------------------------------------------------------------------
1 | DIMENSION P(1000),H0(1000),H(1000),V(1000),X(1000)
2 | OPEN (8,FILE='DATA.DAT',STATUS='UNKNOWN')
3 | N=129
4 | X1=1.4
5 | X0=-4.0
6 | DX=(X1-X0)/(N-1.0)
7 | DO I=1,N
8 | X(I)=-4.0+(I-1)*DX
9 | H0(I)=0.5*X(I)*X(I)
10 | H(I)=H0(I)
11 | P(I)=0.0
12 | IF(X(I).GE.-1.0.AND.X(I).LE.1.0)THEN
13 | P(I)=SQRT(1-X(I)*X(I))
14 | ENDIF
15 | ENDDO
16 | CALL SUBAK(N)
17 | CALL VI(N,DX,P,V)
18 | DO I=1,N
19 | H(I)=H(I)+V(I)
20 | WRITE(*,*)X(I),P(I),V(I),H0(I),H(I)
21 | WRITE(8,*)X(I),P(I),V(I),H0(I),H(I)
22 | ENDDO
23 | STOP
24 | END
25 | SUBROUTINE VI(N,DX,P,V)
26 | DIMENSION P(N),V(N)
27 | COMMON /COMAK/AK(0:1100)
28 | PAI1=0.318309886
29 | C=ALOG(DX)
30 | DO 10 I=1,N
31 | V(I)=0.0
32 | DO 10 J=1,N
33 | IJ=IABS(I-J)
34 | 10 V(I)=V(I)+(AK(IJ)+C)*DX*P(J)
35 | DO I=1,N
36 | V(I)=-PAI1*V(I)
37 | ENDDO
38 | RETURN
39 | END
40 | SUBROUTINE SUBAK(MM)
41 | COMMON /COMAK/AK(0:1100)
42 | DO 10 I=0,MM
43 | 10 AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
44 | RETURN
45 | END
46 |
47 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | ## 使用说明
2 |
3 | 本光盘为《润滑数值计算方法》一书的配套光盘，光盘中含有从2到24的23个子目录（子文件夹），包括31个独立的润滑计算程序。其中，每个子目录的编号与《润滑数值计算方法》一书的章号相对应。在相应的子目录中，程序源文件和算例结果均在书中给出，读者可参考使用。
4 |
5 | 本光盘的源程序均用FORTRAN语言编写，对应的版本是FORTRAN90。除子目录21和22中的程序包外，凡兼容FORTRAN90的通用软件工具均可对这些源程序进行编译和链接。编译和链接后形成的执行程序（*.exe）可在Windows或DOS环境下运行。
6 |
7 | 为调试方便，大多数程序对计算变量进行了直接赋值，如果用户需要调整这些参数，可将原程序中的计算变量所赋之值进行更改。如果用户既希望获得不同赋值变量的计算结果，又不用修改程序，则可采用读入数据文件的形式进行数据输入，此时应将相应的赋初值的字段或语句删除，并在程序的相应位置（一般是开始处）加入读入语句，从而实现计算变量的多次变化。
8 |
9 | 子目录21和22中的程序包需要在VisualFortran6.5或更高版本的兼容工具软件下运行。这里提供了可直接运行的文件，建议不熟悉的用户不要随意更改。在VisualFortran6.5环境下，用户可直接运行相应的*.dsw文件，并通过界面输入或更改变量的数值，从而得到所需的计算结果。具体的变量单位及含义可参考书中对应的章节。
10 |
11 | 本光盘中只有子目录24中的程序需要提供磁头形貌的离散数据文件fort.20，该文件的格式可参考《润滑数值计算方法》一书的第24章。为了方便读者使用，在该子目录下我们提供了一个fort.20文件，供参考和调试。另外，本光盘提供的磁头形貌通常不是读者所需的，因此请读者务必在撰写完自己的磁头形貌离散数据文件后，将原来的fort.20文件删除或改名，并将其自己的数据文件更名为fort.20。用户也可以更改源文件中对应的语句，从而更改输入数据文件的名称。
12 |
13 | 为适应不同读者的需要，程序运行结果以输出文件的形式给出，用户可直接打开输出文件浏览计算结果，也可以通过绘图工具软件读取这些输出文件从而绘制成线图或三维图。其中，最简单的方法是利用Excel读取输出文件，并利用其绘图功能来绘制相应的图形。如果用户希望采用专门的绘图工具软件读取输出数据，则需要在源程序中找到相应的输出语句，并按该绘图工具软件要求的格式对这些输出语句进行改写。
14 |
15 | 我们在《润滑数值计算方法》一书的对应章节中对所有源程序的使用方法做了较为详尽的介绍，因此建议用户在使用或改写程序时，首先仔细地阅读该书的相关内容，再进行操作。
16 |
17 | 黄平
18 |
19 | 2012-4-2
20 |
21 |
--------------------------------------------------------------------------------
/10/LINETHERM.F90:
--------------------------------------------------------------------------------
1 | PROGRAM LINETHERM
2 | DIMENSION X(200),P(200),H(200),T(200)
3 | DATA U,AL,EDA0,RO,C,AJ,H1,H2/1.0,0.01,0.05,890.0,1870.0,4.184,5.5E-6,5.E-6/
4 | OPEN(8,FILE='OUT.DAT',STATUS='UNKNOWN')
5 | N=129
6 | A=U*AL*EDA0/2.0/AJ/RO/C/H2**2
7 | T0=303.0/A
8 | DX=1./(N-1.0)
9 | HH=H1/H2
10 | DH=HH-1.0
11 | DO I=1,N
12 | X(I)=(I-1)*DX
13 | H(I)=HH-DH*X(I)
14 | P(I)=-(-1.0/(H(I))+HH/(HH+1.0)/H(I)**2+1.0/(HH+1.0))/DH
15 | T(I)=T0
16 | ENDDO
17 | P(1)=0.0
18 | P(N)=0.0
19 | CALL THERM(N,A,DX,T0,X,P,H,T)
20 | CALL OUTPUT(N,A,T0,X,H,P,T)
21 | STOP
22 | END
23 | SUBROUTINE THERM(N,A,DX,T0,X,P,H,T)
24 | DIMENSION X(N),P(N),H(N),T(N)
25 | 10 ERT=0.0
26 | DO I=2,N
27 | TOLD=T(I)
28 | EDA=EXP(-0.03*A*(T(I)-T0))
29 | QX=0.5*H(I)-0.5*H(I)**3*((P(I)-P(I-1))/DX)
30 | T(I)=T(I-1)+DX*(2.0*EDA/H(I)+6.0*H(I)/EDA*((P(I)-P(I-1))/DX)**2)/QX
31 | T(I)=0.5*(TOLD+T(I))
32 | ERT=ERT+ABS(T(I)-TOLD)
33 | ENDDO
34 | ERT=A*ERT/(303.0*(N-1))
35 | WRITE(*,*)ERT
36 | IF(ERT.GT.1.E-6)GOTO 10
37 | RETURN
38 | END
39 | SUBROUTINE OUTPUT(N,A,T0,X,H,P,T)
40 | DIMENSION X(N),H(N),P(N),T(N)
41 | DO I=1,N
42 | T(I)=A*(T(I)-T0)
43 | END DO
44 | DO I=1,N
45 | WRITE(8,30)X(I),H(I),P(I),T(I)
46 | ENDDO
47 | 30 FORMAT(4(1X,E12.6))
48 | RETURN
49 | END
50 |
--------------------------------------------------------------------------------
/9/GREASESLIDER.F90:
--------------------------------------------------------------------------------
1 | PROGRAM GREASESLIDER
2 | DIMENSION X(121),H(121),P(121)
3 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX,P0
4 | DATA N,U,X1,X2,H1,H2,EDA,AL/121,1.0,0.0,1.0,1.0,0.5,0.08,0.01/
5 | OPEN(7,FILE='GREASESLIDER.DAT',STATUS='UNKNOWN')
6 | WRITE(*,*)'n=?'
7 | READ(*,*)AN
8 | P0=2.0*EDA*AL*(U*(4.0+2.0/AN)/H2**2)**AN
9 | CALL SUBH(N,X,H)
10 | H0=0.5*(H(1)+H(N))
11 | DH=1.E-4*H0
12 | CALL SUBP(N,AN,H0,DH,X,H,P)
13 | CALL OUTPUT(KG,N,AN,X,H,P)
14 | STOP
15 | END
16 | SUBROUTINE SUBH(N,X,H)
17 | DIMENSION X(N),H(N)
18 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX,P0
19 | DX=1./(N-1.0)
20 | DO I=1,N
21 | X(I)=X1-(I-1)*DX*(X1-X2)
22 | H(I)=H1/H2-(H1/H2-1.0)*X(I)
23 | ENDDO
24 | RETURN
25 | END
26 | SUBROUTINE SUBP(N,AN,H0,DH,X,H,P)
27 | DIMENSION X(N),H(N),P(N)
28 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX,P0
29 | P(1)=0.0
30 | 10 DO I=2,N
31 | IF(H(I)-H0.GT.0.0)THEN
32 | A=H(I)-H0
33 | P(I)=P(I-1)+A**AN*DX/H(I)**(2.0*AN+1.0)
34 | ENDIF
35 | IF(H(I)-H0.LT.0.0)THEN
36 | A=H0-H(I)
37 | P(I)=P(I-1)-A**AN*DX/H(I)**(2.0*AN+1.0)
38 | ENDIF
39 | IF(H(I)-H0.EQ.0.0)P(I)=P(I-1)
40 | ENDDO
41 | IF(ABS(P(N)).GT.1.E-6)THEN
42 | IF(P(N).GT.0.0)THEN
43 | H0=H0+DH
44 | IF(KG.EQ.0)DH=DH/2.0
45 | KG=1
46 | ENDIF
47 | IF(P(N).LT.0.0)THEN
48 | H0=H0-DH
49 | IF(KG.EQ.1)DH=DH/2.0
50 | KG=0
51 | ENDIF
52 | WRITE(*,*)P(N)
53 | GOTO 10
54 | ENDIF
55 | RETURN
56 | END
57 | SUBROUTINE OUTPUT(KG,N,AN,X,H,P)
58 | DIMENSION X(N),H(N),P(N)
59 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX,P0
60 | X0=0.0
61 | ALOAD=0.0
62 | DO I=1,N
63 | ALOAD=ALOAD+P(I)
64 | X0=X0+P(I)*X(I)
65 | ENDDO
66 | X0=X0*AL
67 | ALOAD=P0*AL*ALOAD*DX
68 | WRITE(*,*)AN,ALOAD,X0
69 | DO I=1,N
70 | WRITE(7,40) X(I),H(I),P(I)
71 | END DO
72 | 40 FORMAT(1X,3(E12.6,1X))
73 | RETURN
74 | END
--------------------------------------------------------------------------------
/12/POINT.F90:
--------------------------------------------------------------------------------
1 | DIMENSION P(4500),H(4500),V(4500),X(65),Y(65)
2 | OPEN (8,FILE='PRESS.DAT',STATUS='UNKNOWN')
3 | OPEN (10,FILE='FILM.DAT',STATUS='UNKNOWN')
4 | N=33
5 | CALL SUBAK(N)
6 | CALL PCAL(N,X,Y,P,H,V)
7 | STOP
8 | END
9 | SUBROUTINE PCAL(N,X,Y,P,H,V)
10 | DIMENSION P(N,N),H(N,N),X(N),Y(N),V(N,N)
11 | COMMON /COMAK/AK(0:65,0:65)
12 | KL=ALOG(N-1.)/ALOG(2.)-1.99
13 | DX=2.4/(N-1.0)
14 | DO I=1,N
15 | X(I)=-1.2+DX*(I-1)
16 | A=X(I)*X(I)
17 | DO J=1,N
18 | Y(J)=-1.2+DX*(J-1)
19 | P(I,J)=0.0
20 | H(I,J)=0.5*A+0.5*Y(J)*Y(J)
21 | ENDDO
22 | ENDDO
23 | M=0
24 | DO I=1,N
25 | DO J=1,N
26 | A=1.0-X(I)*X(I)-Y(J)*Y(J)
27 | IF(A.GE.0.0) P(I,J)=SQRT(A)
28 | ENDDO
29 | ENDDO
30 | CALL VI(N,DX,P,V)
31 | DO 10 I=1,N
32 | DO 10 J=1,N
33 | H(I,J)=H(I,J)+V(I,J)
34 | 10 CONTINUE
35 | XP=1.0
36 | WRITE(8,20)XP,(Y(I),I=1,N)
37 | WRITE(10,20)XP,(Y(I),I=1,N)
38 | DO I=1,N
39 | WRITE(8,20)X(I),(P(I,J),J=1,N)
40 | WRITE(10,20)X(I),(H(I,J),J=1,N)
41 | ENDDO
42 | 20 FORMAT(1X,34(F6.3,1X))
43 | STOP
44 | END
45 | SUBROUTINE VI(N,DX,P,V)
46 | DIMENSION P(N,N),V(N,N)
47 | COMMON /COMAK/AK(0:65,0:65)
48 | PAI1=0.2026423
49 | DO 40 I=1,N
50 | DO 40 J=1,N
51 | H0=0.0
52 | DO 30 K=1,N
53 | IK=IABS(I-K)
54 | DO 30 L=1,N
55 | JL=IABS(J-L)
56 | 30 H0=H0+AK(IK,JL)*P(K,L)
57 | 40 V(I,J)=H0*DX*PAI1
58 | RETURN
59 | END
60 | SUBROUTINE SUBAK(MM)
61 | COMMON /COMAK/AK(0:65,0:65)
62 | S(X,Y)=X+SQRT(X**2+Y**2)
63 | DO 10 I=0,MM
64 | XP=I+0.5
65 | XM=I-0.5
66 | DO 10 J=0,I
67 | YP=J+0.5
68 | YM=J-0.5
69 | A1=S(YP,XP)/S(YM,XP)
70 | A2=S(XM,YM)/S(XP,YM)
71 | A3=S(YM,XM)/S(YP,XM)
72 | A4=S(XP,YP)/S(XM,YP)
73 | AK(I,J)=XP*ALOG(A1)+YM*ALOG(A2)+XM*ALOG(A3)+YP*ALOG(A4)
74 | 10 AK(J,I)=AK(I,J)
75 | RETURN
76 | END
--------------------------------------------------------------------------------
/2/LINESLIDER.F90:
--------------------------------------------------------------------------------
1 | PROGRAM SLIDER
2 | DIMENSION X(121),H(121),P(121)
3 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
4 | DATA N,U,X1,X2,H1,H2,EDA,AL/121,1.0,0.0,1.0,1.0,0.5,0.02,0.01/
5 | OPEN(7,FILE='SLIDER.DAT',STATUS='UNKNOWN')
6 | WRITE(*,*)'If KG=1: Straight slider; KG=2: Curve slider; Input KG='
7 | READ(*,*)KG
8 | IF(KG.EQ.2)THEN
9 | X1=-1.0
10 | X2=1.0
11 | ELSE
12 | KG=1
13 | ENDIF
14 | CALL SUBH(KG,N,X,H)
15 | CALL SUBP(N,X,H,P)
16 | CALL OUTPUT(KG,N,X,H,P)
17 | STOP
18 | END
19 | SUBROUTINE OUTPUT(KG,N,X,H,P)
20 | DIMENSION X(N),H(N),P(N)
21 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
22 | X0=0.0
23 | DO I=1,N
24 | X0=X0+P(I)*X(I)
25 | ENDDO
26 | X0=X0*AL
27 | ALOAD=ALOAD*DX*AL*6.0*U*EDA*AL/H2**2
28 | WRITE(*,*)N,ALOAD,X0
29 | DO I=1,N
30 | IF(KG.EQ.1)THEN
31 | P0=-(-1.0/(H(I)*H2)+H1*H2/(H1+H2)/(H2*H(I))**2+1.0/(H1+H2))/(H1/H2-1.0)*H2
32 | WRITE(7,40) X(I),H(I),P(I),P0
33 | ELSE
34 | WRITE(7,40) X(I),H(I),P(I)
35 | ENDIF
36 | END DO
37 | 40 FORMAT(1X,4(E12.6,1X))
38 | RETURN
39 | END
40 | SUBROUTINE SUBH(KG,N,X,H)
41 | DIMENSION X(N),H(N)
42 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
43 | DX=1./(N-1.0)
44 | DO I=1,N
45 | IF(KG.EQ.1) THEN
46 | X(I)=X1-(I-1)*DX*(X1-X2)
47 | H(I)=H1/H2-(H1/H2-1.0)*X(I)
48 | ELSE
49 | X(I)=X1-(I-1)*DX*(X1-X2)
50 | H(I)=1.0+(H1/H2-1.0)*X(I)*X(I)
51 | ENDIF
52 | ENDDO
53 | RETURN
54 | END
55 | SUBROUTINE SUBP(N,X,H,P)
56 | DIMENSION X(N),H(N),P(N)
57 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
58 | DO I=2,N-1
59 | P(I)=0.5
60 | ENDDO
61 | P(1)=0.0
62 | P(N)=0.0
63 | IK=0
64 | 10 C1=0.0
65 | ALOAD=0.0
66 | DO I=2,N-1
67 | A1=(0.5*(H(I+1)+H(I)))**3
68 | A2=(0.5*(H(I)+H(I-1)))**3
69 | PD=P(I)
70 | P(I)=(-0.5*DX*(H(I+1)-H(I-1))+A1*P(I+1)+A2*P(I-1))/(A1+A2)
71 | P(I)=0.3*PD+0.7*P(I)
72 | IF(P(I).LT.0.0)P(I)=0.0
73 | C1=C1+ABS(P(I)-PD)
74 | ALOAD=ALOAD+P(I)
75 | ENDDO
76 | ERO=C1/ALOAD
77 | IK=IK+1
78 | IF(ERO.GT.1.E-7)GOTO 10
79 | RETURN
80 | END
81 |
--------------------------------------------------------------------------------
/4/JOURNAL.f90:
--------------------------------------------------------------------------------
1 | PROGRAM JOURNAL
2 | DIMENSION H(61,21),P(61,21)
3 | DATA B,R,C0,AN,EDA,EPSON/60.0E-3,25.0E-3,5.0E-5,6.0E4,0.05,0.7/
4 | OPEN(9,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
5 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
6 | PI=3.1415926
7 | N=61
8 | M=21
9 | DX=2.0*PI/FLOAT(N-1)
10 | DY=1./FLOAT(M-1)
11 | OMEGA=AN*2.0*PI/60.0
12 | U=OMEGA*R
13 | ALFA=(R/B*DX/DY)**2
14 | CALL SUBH(N,M,DX,EPSON,H)
15 | CALL SUBP(N,M,DX,EPSON,ALFA,H,P)
16 | CALL OUTPUT(N,M,DX,DY,H,P)
17 | STOP
18 | END
19 | SUBROUTINE SUBH(N,M,DX,EPSON,H)
20 | DIMENSION H(N,M)
21 | DO I=1,N
22 | SETA=(I-1.0)*DX
23 | DO J=1,M
24 | H(I,J)=1.0+EPSON*COS(SETA)
25 | ENDDO
26 | ENDDO
27 | RETURN
28 | END
29 | SUBROUTINE SUBP(N,M,DX,EPSON,ALFA,H,P)
30 | DIMENSION H(N,M),P(N,M)
31 | DO I=1,N
32 | DO J=2,M-1
33 | P(I,J)=0.5
34 | ENDDO
35 | ENDDO
36 | DO J=1,M
37 | P(1,J)=0.0
38 | P(N,J)=0.0
39 | ENDDO
40 | DO I=1,N
41 | P(I,1)=0.0
42 | P(I,M)=0.0
43 | ENDDO
44 | IK=0
45 | 10 C1=0.0
46 | ALOAD=0.0
47 | DO I=2,N-1
48 | I1=I-1
49 | I2=I+1
50 | DO J=2,M-1
51 | PD=P(I,J)
52 | J1=J-1
53 | J2=J+1
54 | A1=(0.5*(H(I2,J)+H(I,J)))**3
55 | A2=(0.5*(H(I,J)+H(I1,J)))**3
56 | A3=ALFA*(0.5*(H(I,J2)+H(I,J)))**3
57 | A4=ALFA*(0.5*(H(I,J)+H(I,J1)))**3
58 | P(I,J)=(-DX*(H(I2,J)-H(I1,J))+A1*P(I2,J)+A2*P(I1,J)+A3*P(I,J2)+A4*P(I,J1))/(A1+A2+A3+A4)
59 | P(I,J)=0.7*PD+0.3*P(I,J)
60 | IF(P(I,J).LT.0.0)P(I,J)=0.0
61 | C1=C1+ABS(P(I,J)-PD)
62 | ALOAD=ALOAD+P(I,J)
63 | 20 CONTINUE
64 | ENDDO
65 | ENDDO
66 | IK=IK+1
67 | C1=C1/ALOAD
68 | WRITE(*,*)IK,C1,ALOAD
69 | IF(C1.GT.1.E-7)GOTO 10
70 | RETURN
71 | END
72 | SUBROUTINE OUTPUT(N,M,DX,DY,H,P)
73 | DIMENSION Y(21),H(N,M),P(N,M)
74 | DO J=1,M
75 | Y(J)=(J-1.)*DY-0.5
76 | ENDDO
77 | WRITE(8,40)Y(1),(Y(J),J=1,M)
78 | WRITE(9,40)Y(1),(Y(J),J=1,M)
79 | DO I=1,N
80 | AX=(I-1.0)*360.0/(N-1.0)
81 | WRITE(8,40)AX,(H(I,J),J=1,M)
82 | WRITE(9,40)AX,(P(I,J),J=1,M)
83 | ENDDO
84 | 40 FORMAT(22(E12.6,1X))
85 | STOP
86 | END
87 |
--------------------------------------------------------------------------------
/7/GASSLIDER.F90:
--------------------------------------------------------------------------------
1 | PROGRAM GASSLIDER
2 | DIMENSION X(121),H(121),P(121)
3 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
4 | DATA N,U,X1,X2,H1,H2,EDA,AL/121,1.0,0.0,1.0,1.0,0.5,1.79E-5,0.01/
5 | OPEN(7,FILE='SLIDER.DAT',STATUS='UNKNOWN')
6 | WRITE(*,*)'If KG=1: Straight slider; KG=2: Curve slider; Input KG='
7 | READ(*,*)KG
8 | IF(KG.EQ.2)THEN
9 | X1=-1.0
10 | X2=1.0
11 | ELSE
12 | KG=1
13 | ENDIF
14 | CALL SUBH(KG,N,X,H)
15 | CALL SUBP(N,X,H,P)
16 | CALL OUTPUT(KG,N,X,H,P)
17 | STOP
18 | END
19 | SUBROUTINE OUTPUT(KG,N,X,H,P)
20 | DIMENSION X(N),H(N),P(N)
21 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
22 | X0=0.0
23 | DO I=1,N
24 | X0=X0+P(I)*X(I)
25 | ENDDO
26 | X0=X0*AL
27 | ALOAD=ALOAD*DX*AL*6.0*U*EDA*AL/H2**2
28 | WRITE(*,*)N,ALOAD,X0
29 | DO I=1,N
30 | IF(KG.EQ.1)THEN
31 | P0=-(-1.0/(H(I)*H2)+H1*H2/(H1+H2)/(H2*H(I))**2+1.0/(H1+H2))/(H1/H2-1.0)*H2
32 | WRITE(7,40) X(I),H(I),P(I),P0
33 | ELSE
34 | WRITE(7,40) X(I),H(I),P(I)
35 | ENDIF
36 | END DO
37 | 40 FORMAT(1X,4(E12.6,1X))
38 | RETURN
39 | END
40 | SUBROUTINE SUBH(KG,N,X,H)
41 | DIMENSION X(N),H(N)
42 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
43 | DX=1./(N-1.0)
44 | DO I=1,N
45 | IF(KG.EQ.1) THEN
46 | X(I)=X1-(I-1)*DX*(X1-X2)
47 | H(I)=H1/H2-(H1/H2-1.0)*X(I)
48 | ELSE
49 | X(I)=X1-(I-1)*DX*(X1-X2)
50 | H(I)=1.0+(H1/H2-1.0)*X(I)*X(I)
51 | ENDIF
52 | ENDDO
53 | RETURN
54 | END
55 | SUBROUTINE SUBP(N,X,H,P)
56 | DIMENSION X(N),H(N),P(N)
57 | COMMON /COM1/X1,X2,H1,H2,U,EDA,AL,ALOAD,DX
58 | DATA PA/1.013E5/
59 | ALENDA=6.0*EDA*U*AL/PA/(H2*1.0E-6)**2
60 | DO I=2,N-1
61 | P(I)=0.5
62 | ENDDO
63 | P(1)=1.0
64 | P(N)=1.0
65 | IK=0
66 | 10 C1=0.0
67 | ALOAD=0.0
68 | DO I=2,N-1
69 | A1=(0.5*(H(I+1)+H(I)))**3
70 | A2=(0.5*(H(I)+H(I-1)))**3
71 | PD=P(I)
72 | P(I)=(-DX*ALENDA*(P(I+1)*H(I+1)-P(I-1)*H(I-1))+A1*P(I+1)**2+A2*P(I-1)**2)/(A1+A2)
73 | IF(P(I).LT.0.0)P(I)=0.0
74 | P(I)=SQRT(P(I))
75 | P(I)=0.5*PD+0.5*P(I)
76 | C1=C1+ABS(P(I)-PD)
77 | ALOAD=ALOAD+P(I)
78 | ENDDO
79 | ERO=C1/ALOAD
80 | IK=IK+1
81 | IF(ERO.GT.1.E-7)GOTO 10
82 | RETURN
83 | END
84 |
--------------------------------------------------------------------------------
/7/GASJOURNAL.f90:
--------------------------------------------------------------------------------
1 | PROGRAM GASJOURNAL
2 | DIMENSION H(61,21),P(61,21)
3 | DATA B,R,C0,AN,PA,EDA,EPSON/60.0E-3,25.0E-3,5.0E-5,6.0E4,1.013E5,1.79E-5,0.7/
4 | OPEN(9,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
5 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
6 | PI=3.1415926
7 | N=61
8 | M=21
9 | DX=2.0*PI/FLOAT(N-1)
10 | DY=1./FLOAT(M-1)
11 | OMEGA=AN*2.0*PI/60.0
12 | U=OMEGA*R
13 | ALENDA=6.0*EDA*U*R/PA/C0**2
14 | ALFA=(R/B*DX/DY)**2
15 | CALL SUBH(N,M,DX,EPSON,H)
16 | CALL SUBP(N,M,DX,EPSON,ALFA,ALENDA,H,P)
17 | CALL OUTPUT(N,M,DX,DY,H,P)
18 | STOP
19 | END
20 | SUBROUTINE SUBH(N,M,DX,EPSON,H)
21 | DIMENSION H(N,M)
22 | DO I=1,N
23 | SETA=(I-1.0)*DX
24 | DO J=1,M
25 | H(I,J)=1.0+EPSON*COS(SETA)
26 | ENDDO
27 | ENDDO
28 | RETURN
29 | END
30 | SUBROUTINE SUBP(N,M,DX,EPSON,ALFA,ALENDA,H,P)
31 | DIMENSION H(N,M),P(N,M)
32 | DO I=2,N-1
33 | DO J=2,M-1
34 | P(I,J)=1.1
35 | ENDDO
36 | ENDDO
37 | DO I=1,N
38 | P(I,1)=1.0
39 | P(I,M)=1.0
40 | ENDDO
41 | DO J=1,M
42 | P(1,J)=1.0
43 | P(N,J)=1.0
44 | ENDDO
45 | IK=0
46 | 10 C1=0.0
47 | ALOAD=0.0
48 | DO I=2,N-1
49 | I1=I-1
50 | I2=I+1
51 | DO J=2,M-1
52 | J1=J-1
53 | J2=J+1
54 | PD=P(I,J)
55 | A1=(0.5*(H(I2,J)+H(I,J)))**3
56 | A2=(0.5*(H(I,J)+H(I1,J)))**3
57 | A3=ALFA*(0.5*(H(I,J2)+H(I,J)))**3
58 | A4=ALFA*(0.5*(H(I,J)+H(I,J1)))**3
59 | P(I,J)=(-DX*ALENDA*(P(I+1,J)*H(I+1,J)-P(I-1,J)*H(I-1,J))+A1*P(I2,J)**2+A2*P(I1,J)**2+A3*P(I,J2)**2+A4*P(I,J1)**2)/(A1+A2+A3+A4)
60 | IF(P(I,J).LT.0.0)P(I,J)=0.0
61 | P(I,J)=SQRT(P(I,J))
62 | P(I,J)=0.7*PD+0.3*P(I,J)
63 | IF(P(I,J).LT.0.0)P(I,J)=0.0
64 | C1=C1+ABS(P(I,J)-PD)
65 | ALOAD=ALOAD+P(I,J)
66 | ENDDO
67 | ENDDO
68 | IK=IK+1
69 | C1=C1/ALOAD
70 | WRITE(*,*)IK,C1,ALOAD
71 | IF(C1.GT.1.E-7)GOTO 10
72 | RETURN
73 | END
74 | SUBROUTINE OUTPUT(N,M,DX,DY,H,P)
75 | DIMENSION Y(21),H(N,M),P(N,M)
76 | DO J=1,M
77 | Y(J)=(J-1.)*DY-0.5
78 | ENDDO
79 | WRITE(8,40)Y(1),(Y(J),J=1,M)
80 | WRITE(9,40)Y(1),(Y(J),J=1,M)
81 | DO I=1,N
82 | AX=(I-1.0)*360.0/(N-1.0)
83 | WRITE(8,40)AX,(H(I,J),J=1,M)
84 | WRITE(9,40)AX,(P(I,J),J=1,M)
85 | ENDDO
86 | 40 FORMAT(22(E12.6,1X))
87 | STOP
88 | END
89 |
--------------------------------------------------------------------------------
/10/SURFACETHERM.F90:
--------------------------------------------------------------------------------
1 | PROGRAM SURFACETHERM
2 | DIMENSION X(200),Y(200),P(20000),H(20000),T(20000)
3 | DATA U,ALX,ALY,EDA0,RO,C,AJ,H1,H2/1.0,0.01,0.01,0.05,890.0,1870.0,4.184,1.1E-6,1.E-6/
4 | OPEN(7,FILE='FILM.DAT',STATUS='UNKNOWN')
5 | OPEN(8,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
6 | OPEN(9,FILE='TEM.DAT',STATUS='UNKNOWN')
7 | N=129
8 | M=65
9 | A=U*ALX*EDA0/2.0/AJ/RO/C/H2**2
10 | T0=303.0/A
11 | DX=1./(N-1.0)
12 | DY=1./(M-1.0)
13 | HH=H1/H2
14 | DH=HH-1.0
15 | ALFA1=ALX/ALY
16 | CALL INIT(N,M,DX,DY,HH,DH,T0,X,Y,H,P,T)
17 | CALL THERM(N,M,A,ALFA1,DX,DY,T0,X,Y,P,H,T)
18 | CALL OUTPUT(N,M,A,T0,X,Y,H,P,T)
19 | STOP
20 | END
21 | SUBROUTINE INIT(N,M,DX,DY,HH,DH,T0,X,Y,H,P,T)
22 | DIMENSION X(N),Y(M),H(N,M),P(N,M),T(N,M)
23 | DO I=1,N
24 | X(I)=(I-1)*DX
25 | ENDDO
26 | DO J=1,M
27 | Y(J)=-0.5+(J-1)*DY
28 | ENDDO
29 | DO I=1,N
30 | DO J=1,M
31 | H(I,J)=HH-DH*X(I)
32 | P(I,J)=-(-1.0/(H(I,J))+HH/(HH+1.0)/H(I,J)**2+1.0/(HH+1.0))/DH*(1.0-4.0*Y(J)*Y(J))
33 | T(I,J)=T0
34 | ENDDO
35 | ENDDO
36 | DO I=1,N
37 | P(I,1)=0.0
38 | P(I,M)=0.0
39 | ENDDO
40 | DO J=1,M
41 | P(1,J)=0.0
42 | P(N,J)=0.0
43 | ENDDO
44 | RETURN
45 | END
46 | SUBROUTINE THERM(N,M,A,ALFA1,DX,DY,T0,X,Y,P,H,T)
47 | DIMENSION X(N),Y(M),H(N,M),P(N,M),T(N,M)
48 | 10 ERT=0.0
49 | DO I=2,N
50 | DO J=M/2+1,1,-1
51 | TOLD=T(I,J)
52 | EDA=EXP(-0.03*A*(T(I,J)-T0))
53 | DPDX=(P(I,J)-P(I-1,J))/DX
54 | IF(J.EQ.M/2+1)THEN
55 | DPDY=0.0
56 | DTDY=0.0
57 | ELSE
58 | DPDY=(P(I,J+1)-P(I,J))/DY
59 | DTDY=(T(I,J+1)-T(I,J))/DY
60 | ENDIF
61 | QX=0.5*H(I,J)-0.5*H(I,J)**3*DPDX
62 | QY=-0.5*H(I,J)**3*DPDY
63 | AA=-0.5*ALFA1*QY*DTDY
64 | AB=2.0*EDA/H(I,J)
65 | AC=6.0*H(I,J)/EDA*(DPDX**2+ALFA1**2*DPDY**2)
66 | BA=QX/DX-ALFA1*QY/DY
67 | BB=QX/DX*T(I-1,J)-ALFA1*QY/DY*T(I,J+1)
68 | T(I,J)=(BB+AB+AC)/BA
69 | T(I,J)=0.7*TOLD+0.3*T(I,J)
70 | ERT=ERT+ABS(T(I,J)-TOLD)
71 | ENDDO
72 | ENDDO
73 | ERT=A*ERT/(303.0*(N-1)*(M-1))
74 | WRITE(*,*)ERT
75 | IF(ERT.GT.1.E-8)GOTO 10
76 | DO I=2,N
77 | DO J=1,M/2
78 | T(I,M-J+1)=T(I,J)
79 | ENDDO
80 | ENDDO
81 | RETURN
82 | END
83 | SUBROUTINE OUTPUT(N,M,A,T0,X,Y,H,P,T)
84 | DIMENSION X(N),Y(M),H(N,M),P(N,M),T(N,M)
85 | DO I=1,N
86 | DO J=1,M
87 | T(I,J)=A*(T(I,J)-T0)
88 | END DO
89 | ENDDO
90 | WRITE(7,30)X(1),(Y(J),J=1,M)
91 | WRITE(8,30)X(1),(Y(J),J=1,M)
92 | WRITE(9,30)X(1),(Y(J),J=1,M)
93 | DO I=1,N
94 | WRITE(7,30)X(I),(H(I,J),J=1,M)
95 | WRITE(8,30)X(I),(P(I,J),J=1,M)
96 | WRITE(9,30)X(I),(T(I,J),J=1,M)
97 | ENDDO
98 | 30 FORMAT(130(1X,E12.6))
99 | RETURN
100 | END
101 |
--------------------------------------------------------------------------------
/7/GASSURFACE.f90:
--------------------------------------------------------------------------------
1 | PROGRAM GASSURFACE
2 | DIMENSION X(121),Y(121),H(121,121),P(121,121)
3 | COMMON /COM1/DX,ALFA,X1,X2,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
4 | DATA N,EDA,ALX,ALY,U,H1,H2,X1,X2/121,1.79E-5,0.03,0.024,1.0,0.1,0.05,0.0,1.0/
5 | OPEN(8,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
6 | OPEN(9,FILE='FILM.DAT',STATUS='UNKNOWN')
7 | WRITE(*,*)'If KG=1: Plane surface; KG=2: Curve surface; Input KG='
8 | READ(*,*)KG
9 | CALL SUBH(KG,N,X,Y,H)
10 | CALL SUBP(N,X,Y,H,P)
11 | CALL OUTPUT(N,X,Y,H,P)
12 | STOP
13 | END
14 | SUBROUTINE SUBH(KG,N,X,Y,H)
15 | DIMENSION X(N),Y(N),H(N,N)
16 | COMMON /COM1/DX,ALFA,X1,X2,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
17 | IF(KG.EQ.2)THEN
18 | X1=-1.0
19 | X2=1.0
20 | ELSE
21 | KG=1
22 | ENDIF
23 | DX=1.0/(N-1.0)
24 | ALFA=(ALX/ALY)**2
25 | DO I=1,N
26 | X(I)=X1-(I-1)*DX*(X1-X2)
27 | IF(KG.EQ.1)Y(I)=-0.5-(I-1)*DX*(X1-X2)
28 | IF(KG.EQ.2)Y(I)=-1.0-(I-1)*DX*(X1-X2)
29 | ENDDO
30 | DO I=1,N
31 | DO J=1,N
32 | IF(KG.EQ.1)H(I,J)=H1/H2-X(I)*(H1/H2-1.0)
33 | IF(KG.EQ.2)H(I,J)=1.0+(X(I)*X(I)+Y(J)*Y(J))*(H1/H2-1.0)
34 | ENDDO
35 | ENDDO
36 | RETURN
37 | END
38 | SUBROUTINE SUBP(N,X,Y,H,P)
39 | DIMENSION X(N),Y(N),H(N,N),P(N,N)
40 | COMMON /COM1/DX,ALFA,X1,X2,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
41 | DATA PA/1.013E5/
42 | ALENDA=6.0*EDA*U*ALX/PA/(H2*1.0E-5)**2
43 | DO I=1,N
44 | P(I,1)=1.0
45 | P(I,N)=1.0
46 | P(1,I)=1.0
47 | P(N,I)=1.0
48 | ENDDO
49 | DO I=2,N-1
50 | DO J=2,N-1
51 | P(I,J)=1.5
52 | ENDDO
53 | ENDDO
54 | IK=0
55 | 10 C1=0.0
56 | ALOAD=0.0
57 | DO I=2,N-1
58 | I1=I-1
59 | I2=I+1
60 | DO J=2,N-1
61 | J1=J-1
62 | J2=J+1
63 | PD=P(I,J)
64 | A1=(0.5*(H(I2,J)+H(I,J)))**3
65 | A2=(0.5*(H(I,J)+H(I1,J)))**3
66 | A3=ALFA*(0.5*(H(I,J2)+H(I,J)))**3
67 | A4=ALFA*(0.5*(H(I,J)+H(I,J1)))**3
68 | P(I,J)=(-DX*ALENDA*(P(I+1,J)*H(I+1,J)-P(I-1,J)*H(I-1,J))+A1*P(I2,J)**2+A2*P(I1,J)**2+A3*P(I,J2)**2+A4*P(I,J1)**2)/(A1+A2+A3+A4)
69 | IF(P(I,J).LT.0.0)P(I,J)=0.0
70 | P(I,J)=SQRT(P(I,J))
71 | P(I,J)=0.7*PD+0.3*P(I,J)
72 | IF(P(I,J).LT.0.0)P(I,J)=0.0
73 | C1=C1+ABS(P(I,J)-PD)
74 | ALOAD=ALOAD+P(I,J)
75 | ENDDO
76 | ENDDO
77 | IK=IK+1
78 | C1=C1/ALOAD
79 | WRITE(*,*)IK,C1,ALOAD
80 | IF(C1.GT.1.E-7)GOTO 10
81 | RETURN
82 | END
83 | SUBROUTINE OUTPUT(N,X,Y,H,P)
84 | DIMENSION X(N),Y(N),H(N,N),P(N,N)
85 | COMMON /COM1/DX,ALFA,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
86 | ALENDA=6.0*U*EDA*ALX/H2**2
87 | ALOAD=ALOAD*ALENDA*DX*DX*ALX*ALY/(N-1.0)/(N-1.0)
88 | WRITE(8,40)Y(1),(Y(I),I=1,N)
89 | DO I=1,N
90 | WRITE(8,40)X(I),(P(I,J),J=1,N)
91 | ENDDO
92 | WRITE(9,40)Y(1),(Y(I),I=1,N)
93 | DO I=1,N
94 | WRITE(9,40)X(I),(H(I,J),J=1,N)
95 | ENDDO
96 | 40 FORMAT(122(E12.6,1X))
97 | STOP
98 | END
99 |
--------------------------------------------------------------------------------
/3/SURFACESLIDER.F90:
--------------------------------------------------------------------------------
1 | PROGRAM SURFACESLIDER
2 | DIMENSION X(121),Y(121),H(121,121),P(121,121)
3 | COMMON /COM1/DX,DY,ALFA,X1,X2,Y1,Y2,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
4 | DATA N,M,EDA,ALX,ALY,U,H1,H2,X1,X2,Y1,Y2/121,121,0.02,0.03,0.024,1.0,0.1,0.05,0.0,1.0,-0.5,0.5/
5 | OPEN(8,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
6 | OPEN(9,FILE='FILM.DAT',STATUS='UNKNOWN')
7 | WRITE(*,*)'If KG=1: Plane surface; KG=2: Curve surface; Input KG='
8 | READ(*,*)KG
9 | CALL SUBH(KG,N,M,X,Y,H)
10 | CALL SUBP(N,M,X,Y,H,P)
11 | CALL OUTPUT(N,M,X,Y,H,P)
12 | STOP
13 | END
14 | SUBROUTINE SUBH(KG,N,M,X,Y,H)
15 | DIMENSION X(N),Y(N),H(N,M)
16 | COMMON /COM1/DX,DY,ALFA,X1,X2,Y1,Y2,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
17 | IF(KG.EQ.2)THEN
18 | X1=-1.0
19 | X2=1.0
20 | Y1=-1.0
21 | Y2=1.0
22 | ELSE
23 | KG=1
24 | ENDIF
25 | DX=1.0/(N-1.0)
26 | DY=1.0/(M-1.0)
27 | ALFA=(ALX/ALY)**2
28 | DO I=1,N
29 | X(I)=X1-(I-1)*DX*(X1-X2)
30 | ENDDO
31 | DO J=1,M
32 | IF(KG.EQ.1)Y(J)=-0.5-(J-1)*DY*(Y1-Y2)
33 | IF(KG.EQ.2)Y(J)=-1.0-(J-1)*DY*(Y1-Y2)
34 | ENDDO
35 | DO I=1,N
36 | DO J=1,M
37 | IF(KG.EQ.1)H(I,J)=H1/H2-X(I)*(H1/H2-1.0)
38 | IF(KG.EQ.2)H(I,J)=1.0+(X(I)*X(I)+Y(J)*Y(J))*(H1/H2-1.0)
39 | ENDDO
40 | ENDDO
41 | RETURN
42 | END
43 | SUBROUTINE SUBP(N,M,X,Y,H,P)
44 | DIMENSION X(N),Y(N),H(N,M),P(N,M)
45 | COMMON /COM1/DX,DY,ALFA,X1,X2,Y1,Y2,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
46 | DO I=1,N
47 | P(I,1)=0.0
48 | P(I,N)=0.0
49 | ENDDO
50 | DO J=1,M
51 | P(1,J)=0.0
52 | P(N,J)=0.0
53 | ENDDO
54 | DO I=2,N-1
55 | DO J=2,M-1
56 | P(I,J)=0.05
57 | ENDDO
58 | ENDDO
59 | IK=0
60 | 10 C1=0.0
61 | ALOAD=0.0
62 | DO I=2,N-1
63 | I1=I-1
64 | I2=I+1
65 | DO J=2,M-1
66 | J1=J-1
67 | J2=J+1
68 | PD=P(I,J)
69 | A1=(0.5*(H(I2,J)+H(I,J)))**3
70 | A2=(0.5*(H(I,J)+H(I1,J)))**3
71 | A3=ALFA*(0.5*(H(I,J2)+H(I,J)))**3
72 | A4=ALFA*(0.5*(H(I,J)+H(I,J1)))**3
73 | P(I,J)=(-0.5*DX*(H(I2,J)-H(I1,J))+A1*P(I2,J)+A2*P(I1,J)+A3*P(I,J2)+A4*P(I,J1))/(A1+A2+A3+A4)
74 | P(I,J)=0.5*PD+0.5*P(I,J)
75 | IF(P(I,J).LT.0.0)P(I,J)=0.0
76 | C1=C1+ABS(P(I,J)-PD)
77 | ALOAD=ALOAD+P(I,J)
78 | ENDDO
79 | ENDDO
80 | IK=IK+1
81 | C1=C1/ALOAD
82 | WRITE(*,*)IK,C1,ALOAD
83 | IF(C1.GT.1.E-7)GOTO 10
84 | RETURN
85 | END
86 | SUBROUTINE OUTPUT(N,M,X,Y,H,P)
87 | DIMENSION X(N),Y(M),H(N,M),P(N,M)
88 | COMMON /COM1/DX,DY,ALFA,X1,X2,Y1,Y2,H1,H2,ALOAD,U,EDA,ALX,ALY,ALENDA
89 | ALENDA=6.0*U*EDA*ALX/H2**2
90 | ALOAD=ALOAD*ALENDA*DX*DY*ALX*ALY/(N-1.0)/(M-1.0)
91 | WRITE(8,40)Y(1),(Y(J),J=1,M)
92 | DO I=1,N
93 | WRITE(8,40)X(I),(P(I,J),J=1,M)
94 | ENDDO
95 | WRITE(9,40)Y(1),(Y(J),J=1,M)
96 | DO I=1,N
97 | WRITE(9,40)X(I),(H(I,J),J=1,M)
98 | ENDDO
99 | 40 FORMAT(122(E12.6,1X))
100 | STOP
101 | END
102 |
--------------------------------------------------------------------------------
/8/RARIFIEDGAS.F90:
--------------------------------------------------------------------------------
1 | PROGRAM RARIFIEDGAS
2 | IMPLICIT REAL*8 (A-H,O-Z)
3 | DIMENSION P(161,161),H(161,161),X(161),Y(161),F(161,161),QW(161,161)
4 | DATA AL,B,H0,U,EDA,PA,ALFA,R,T0/4.0E-6,3.3E-6,5.0E-9,25.0,1.8060E-5,1.0135E5,0.01,287.03,293.0/
5 | DATA N,M/161,161/
6 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
7 | OPEN(9,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
8 | PI=3.1415926
9 | BETA1=0.01
10 | ALENDA=6.0*EDA*U*AL/(H0**2*PA)
11 | DELTA=AL*DSIN(ALFA)/H0
12 | A=AL/B
13 | D0=PA*H0/EDA/DSQRT(2.0*R*T0)
14 | DX=1.0/FLOAT(N-1)
15 | DY=1.0/FLOAT(M-1)
16 | CALL SUBH(N,M,DX,DY,DELTA,X,Y,H)
17 | CALL SUBP(N,M,DX,DY,D0,A,ALENDA,BETA1,U,X,Y,H,P,F,QW)
18 | CALL OUTPUT(N,M,A,ALFA,D0,H0,PA,AL,B,U,X,Y,H,P)
19 | STOP
20 | END
21 | SUBROUTINE SUBH(N,M,DX,DY,DELTA,X,Y,H)
22 | IMPLICIT REAL*8 (A-H,O-Z)
23 | DIMENSION X(N),Y(M),H(N,M)
24 | DO I=1,N
25 | X(I)=(I-1)*DX
26 | ENDDO
27 | DO J=1,M
28 | Y(J)=(J-1)*DY-0.5
29 | ENDDO
30 | DO I=1,N
31 | DO J=1,M
32 | H(I,J)=1.0+DELTA*(1.0-X(I))
33 | ENDDO
34 | ENDDO
35 | RETURN
36 | END
37 | SUBROUTINE SUBP(N,M,DX,DY,D0,A,ALENDA,BETA1,U,X,Y,H,P,F,QW)
38 | IMPLICIT REAL*8 (A-H,O-Z)
39 | DIMENSION X(N),Y(M),H(N,M),P(N,M),F(N,M),QW(N,M)
40 | DO I=1,N
41 | DO J=1,M
42 | P(I,J)=1.0
43 | F(I,J)=0.0
44 | QW(I,J)=1.0
45 | ENDDO
46 | ENDDO
47 | DO I=2,N-1
48 | DO J=2,M-1
49 | P(I,J)=P(I-1,J)*H(I-1,J)/H(I,J)
50 | ENDDO
51 | ENDDO
52 | K=0
53 | DO WHILE(K<10000)
54 | DO I=1,N
55 | DO J=1,M
56 | DR=D0*P(I,J)*H(I,J)
57 | QC=DR/6.0
58 | QP=QC+1.0162+0.40134*DLOG(1.0+1.2477/DR)
59 | QW(I,J)=QP/QC
60 | ENDDO
61 | ENDDO
62 | ERR=0.0
63 | DO J=2,M-1
64 | DO I=2,N-1
65 | C0=2.0*ALENDA*H(I,J)/DX
66 | C5=2.0*ALENDA*P(I-1,J)*H(I-1,J)/DX
67 | TMP1=QW(I+1,J)*H(I+1,J)**3
68 | TMP2=QW(I,J)*H(I,J)**3
69 | QHP1=0.5*(TMP1+TMP2)
70 | TMP1=QW(I-1,J)*H(I-1,J)**3
71 | QHM1=0.5*(TMP1+TMP2)
72 | C1=P(I,J)*(QHP1+ QHM1)/DX**2
73 | C3=(P(I+1,J)**2*QHP1+P(I-1,J)**2*QHM1)/DX**2
74 | TMP1=QW(I,J+1)*H(I,J+1)**3
75 | QHP1=0.5*(TMP1+TMP2)
76 | TMP1=QW(I,J-1)*H(I,J-1)**3
77 | QHM1=0.5*(TMP1+TMP2)
78 | C2=A**2*P(I,J)*(QHP1+ QHM1)/DY**2
79 | C4=A**2*(P(I,J+1)*P(I,J+1)*QHP1+P(I,J-1)*P(I,J-1)*QHM1)/DY**2
80 | TMP=(C5+C3+C4)/(C0+C1+C2)
81 | P(I,J)=P(I,J)+BETA1*(TMP-P(I,J))
82 | F(I,J)=P(I,J)*(C0+C1+C2)-C3-C4-C5
83 | IF(ABS(F(I,J)).GT.ERR)ERR=ABS(F(I,J))
84 | ENDDO
85 | ENDDO
86 | K=K+1
87 | WRITE(*,"('K=',I6,6X,'ERR=',E12.6)")K,ERR
88 | IF(ERR.LT.1.E-5) EXIT
89 | IF(K.GT.500)BETA1=0.1
90 | IF(K.GT.2000)BETA1=0.5
91 | IF(K.GT.3000)BETA1=0.75
92 | IF(K.GT.5000)BETA1=0.95
93 | ENDDO
94 | RETURN
95 | END
96 | SUBROUTINE OUTPUT(N,M,A,ALFA,D0,H0,PA,AL,B,U,X,Y,H,P)
97 | IMPLICIT REAL*8 (A-H,O-Z)
98 | DIMENSION X(N),Y(M),H(N,M),P(N,M)
99 | N2=N/2
100 | SM=0.0
101 | X0=0.0
102 | AM0=0.0
103 | PMAX=0.0
104 | PMIN=0.0
105 | DO I=1,N
106 | DO J=1,M
107 | P(I,J)=P(I,J)-1.0
108 | SM=SM+P(I,J)
109 | AM0=AM0+P(I,J)*(X(N2)-X(I))
110 | IF(P(I,J).GT.PMAX)THEN
111 | PMAX=P(I,J)
112 | IMAX=I
113 | JMAX=J
114 | ENDIF
115 | IF(P(I,J).LT.PMIN)PMIN=P(I,J)
116 | H(I,J)=H0*H(I,J)
117 | ENDDO
118 | ENDDO
119 | X0=AM0/SM+X(N2)
120 | AM0=AM0*PA*AL**2*B/(N-1)/(M-1)
121 | SM=SM*PA*AL*B/(N-1)/(M-1)
122 | WRITE(8,40)Y(1),(Y(J),J=1,M)
123 | WRITE(8,40)(X(I),(H(I,J),J=1,M),I=1,N)
124 | WRITE(9,40)Y(1),(Y(J),J=1,M)
125 | WRITE(9,40)(X(I),(P(I,J),J=1,M),I=1,N)
126 | 40 FORMAT(162(E12.6,1X))
127 | RETURN
128 | END
--------------------------------------------------------------------------------
/22/resource.h:
--------------------------------------------------------------------------------
1 | //{{NO_DEPENDENCIES}}
2 | // Microsoft Developer Studio generated include file.
3 | // Used by Script1.rc
4 | //
5 | #define IDD_DIALOG1 101
6 | #define IDD_TAIDA 101
7 | #define IDD_DIALOG2 102
8 | #define IDB_BITMAP1 111
9 | #define IDB_BITMAP2 112
10 | #define IDB_BITMAP3 113
11 | #define IDB_BITMAP4 114
12 | #define IDC_EDIT1 1000
13 | #define IDC_EDIT_DD 1000
14 | #define IDC_EDIT2 1001
15 | #define IDC_EDIT_D 1001
16 | #define IDC_EDIT3 1002
17 | #define IDC_EDIT_AL 1002
18 | #define IDC_EDIT4 1003
19 | #define IDC_EDIT_AN 1003
20 | #define IDC_EDIT5 1004
21 | #define IDC_EDIT_SUM 1004
22 | #define IDC_EDIT6 1005
23 | #define IDC_EDIT_AI 1005
24 | #define IDC_EDIT_ALF2 1005
25 | #define IDC_EDIT7 1006
26 | #define IDC_EDIT_Q 1006
27 | #define IDC_EDIT_Q0 1006
28 | #define IDC_EDIT8 1007
29 | #define IDC_EDIT_M 1007
30 | #define IDC_EDIT9 1008
31 | #define IDC_EDIT_ALF 1008
32 | #define IDC_EDIT_MAXALF 1008
33 | #define IDC_EDIT10 1009
34 | #define IDC_EDIT_RLGL 1009
35 | #define IDC_EDIT_MAXRLGL 1009
36 | #define IDC_EDIT11 1010
37 | #define IDC_EDIT_EPSON 1010
38 | #define IDC_EDIT12 1011
39 | #define IDC_EDIT_CG 1011
40 | #define IDC_EDIT_MAXCG 1011
41 | #define IDC_EDIT13 1012
42 | #define IDC_EDIT_Q1 1012
43 | #define IDC_EDIT_RLGL2 1012
44 | #define IDC_EDIT14 1013
45 | #define IDC_EDIT_DT 1013
46 | #define IDC_EDIT_CG2 1013
47 | #define IDC_BUTTON1 1014
48 | #define IDC_BUTTON_CALCULATE 1014
49 | #define IDC_CALCULATE 1014
50 | #define IDC_EDIT_SUM2 1015
51 | #define IDC_CANCEL 1016
52 | #define IDC_CLEAR 1017
53 | #define IDC_EDIT_DEDA 1018
54 | #define IDC_EDIT_EPSON2 1019
55 | #define IDC_EDIT_RO 1020
56 | #define IDC_EDIT_CO 1021
57 | #define IDC_EDIT_AS 1022
58 | #define IDC_EDIT19 1023
59 | #define IDC_EDIT_MINRLGL 1023
60 | #define IDC_EDIT_MINALF 1024
61 | #define IDC_EDIT_MINCG 1025
62 | #define IDC_RADIO_EPSON 1035
63 | #define IDC_RADIO_SUM 1036
64 | #define IDC_EDIT_E 1037
65 | #define IDC_LIST1 1042
66 | #define IDC_RADIO1_LOAD 1043
67 | #define IDC_RADIO_LOAD 1043
68 | #define IDC_RADIO_FLUX 1044
69 | #define IDC_CONTINUE 1045
70 | #define IDC_RADIO_CONTINUE 1046
71 | #define IDC_RADIO_DYNAMIC 1049
72 | #define IDC_RADIO_STATIC 1050
73 |
74 | // Next default values for new objects
75 | //
76 | #ifdef APSTUDIO_INVOKED
77 | #ifndef APSTUDIO_READONLY_SYMBOLS
78 | #define _APS_NEXT_RESOURCE_VALUE 116
79 | #define _APS_NEXT_COMMAND_VALUE 40001
80 | #define _APS_NEXT_CONTROL_VALUE 1051
81 | #define _APS_NEXT_SYMED_VALUE 101
82 | #endif
83 | #endif
84 |
--------------------------------------------------------------------------------
/21/resource.fd:
--------------------------------------------------------------------------------
1 | !MS$FREEFORM
2 | ! Microsoft Developer Studio generated include file.
3 | ! Used by Script1.rc
4 | !
5 | integer, parameter :: IDD_DIALOG1 = 101
6 | integer, parameter :: IDD_TAIDA = 101
7 | integer, parameter :: IDD_DIALOG2 = 102
8 | integer, parameter :: IDB_BITMAP1 = 111
9 | integer, parameter :: IDB_BITMAP2 = 112
10 | integer, parameter :: IDB_BITMAP3 = 113
11 | integer, parameter :: IDB_BITMAP4 = 114
12 | integer, parameter :: IDB_BITMAP5 = 116
13 | integer, parameter :: IDB_BITMAP6 = 118
14 | integer, parameter :: IDC_EDIT1 = 1000
15 | integer, parameter :: IDC_EDIT_DD = 1000
16 | integer, parameter :: IDC_EDIT2 = 1001
17 | integer, parameter :: IDC_EDIT_D = 1001
18 | integer, parameter :: IDC_EDIT3 = 1002
19 | integer, parameter :: IDC_EDIT_AL = 1002
20 | integer, parameter :: IDC_EDIT4 = 1003
21 | integer, parameter :: IDC_EDIT_AN = 1003
22 | integer, parameter :: IDC_EDIT5 = 1004
23 | integer, parameter :: IDC_EDIT_SUM = 1004
24 | integer, parameter :: IDC_EDIT6 = 1005
25 | integer, parameter :: IDC_EDIT_AI = 1005
26 | integer, parameter :: IDC_EDIT7 = 1006
27 | integer, parameter :: IDC_EDIT_Q = 1006
28 | integer, parameter :: IDC_EDIT_Q0 = 1006
29 | integer, parameter :: IDC_EDIT8 = 1007
30 | integer, parameter :: IDC_EDIT_M = 1007
31 | integer, parameter :: IDC_EDIT9 = 1008
32 | integer, parameter :: IDC_EDIT_ALF = 1008
33 | integer, parameter :: IDC_EDIT10 = 1009
34 | integer, parameter :: IDC_EDIT_RLGL = 1009
35 | integer, parameter :: IDC_EDIT11 = 1010
36 | integer, parameter :: IDC_EDIT_EPSON = 1010
37 | integer, parameter :: IDC_EDIT12 = 1011
38 | integer, parameter :: IDC_EDIT_CG = 1011
39 | integer, parameter :: IDC_EDIT13 = 1012
40 | integer, parameter :: IDC_EDIT_Q1 = 1012
41 | integer, parameter :: IDC_EDIT14 = 1013
42 | integer, parameter :: IDC_EDIT_DT = 1013
43 | integer, parameter :: IDC_BUTTON1 = 1014
44 | integer, parameter :: IDC_BUTTON_CALCULATE = 1014
45 | integer, parameter :: IDC_CALCULATE = 1014
46 | integer, parameter :: IDC_EDIT_SUM2 = 1015
47 | integer, parameter :: IDC_CANCEL = 1016
48 | integer, parameter :: IDC_CLEAR = 1017
49 | integer, parameter :: IDC_EDIT_DEDA = 1018
50 | integer, parameter :: IDC_EDIT_EPSON2 = 1019
51 | integer, parameter :: IDC_EDIT_RO = 1020
52 | integer, parameter :: IDC_EDIT_CO = 1021
53 | integer, parameter :: IDC_EDIT_AS = 1022
54 | integer, parameter :: IDC_EDIT19 = 1023
55 | integer, parameter :: IDC_RADIO_EPSON = 1035
56 | integer, parameter :: IDC_RADIO_SUM = 1036
57 | integer, parameter :: IDC_EDIT_E = 1037
58 | integer, parameter :: IDC_LIST1 = 1042
59 | integer, parameter :: IDC_PICTURE1 = 1047
60 | integer, parameter :: IDC_COMBO_LOAD = 1050
61 | integer, parameter :: IDC_CHECK_STATIC = 1053
62 | integer, parameter :: IDC_CHECK_DYNAMIC = 1056
63 |
--------------------------------------------------------------------------------
/22/HBOA.dsp:
--------------------------------------------------------------------------------
1 | # Microsoft Developer Studio Project File - Name="HBOA" - Package Owner=<4>
2 | # Microsoft Developer Studio Generated Build File, Format Version 6.00
3 | # ** DO NOT EDIT **
4 |
5 | # TARGTYPE "Win32 (x86) Console Application" 0x0103
6 |
7 | CFG=HBOA - Win32 Debug
8 | !MESSAGE This is not a valid makefile. To build this project using NMAKE,
9 | !MESSAGE use the Export Makefile command and run
10 | !MESSAGE
11 | !MESSAGE NMAKE /f "HBOA.mak".
12 | !MESSAGE
13 | !MESSAGE You can specify a configuration when running NMAKE
14 | !MESSAGE by defining the macro CFG on the command line. For example:
15 | !MESSAGE
16 | !MESSAGE NMAKE /f "HBOA.mak" CFG="HBOA - Win32 Debug"
17 | !MESSAGE
18 | !MESSAGE Possible choices for configuration are:
19 | !MESSAGE
20 | !MESSAGE "HBOA - Win32 Release" (based on "Win32 (x86) Console Application")
21 | !MESSAGE "HBOA - Win32 Debug" (based on "Win32 (x86) Console Application")
22 | !MESSAGE
23 |
24 | # Begin Project
25 | # PROP AllowPerConfigDependencies 0
26 | # PROP Scc_ProjName ""
27 | # PROP Scc_LocalPath ""
28 | CPP=cl.exe
29 | F90=df.exe
30 | RSC=rc.exe
31 |
32 | !IF "$(CFG)" == "HBOA - Win32 Release"
33 |
34 | # PROP BASE Use_MFC 0
35 | # PROP BASE Use_Debug_Libraries 0
36 | # PROP BASE Output_Dir "Release"
37 | # PROP BASE Intermediate_Dir "Release"
38 | # PROP BASE Target_Dir ""
39 | # PROP Use_MFC 0
40 | # PROP Use_Debug_Libraries 0
41 | # PROP Output_Dir "Release"
42 | # PROP Intermediate_Dir "Release"
43 | # PROP Target_Dir ""
44 | # ADD BASE F90 /compile_only /nologo /warn:nofileopt
45 | # ADD F90 /compile_only /nologo /warn:nofileopt
46 | # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
47 | # ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
48 | # ADD BASE RSC /l 0x804 /d "NDEBUG"
49 | # ADD RSC /l 0x804 /d "NDEBUG"
50 | BSC32=bscmake.exe
51 | # ADD BASE BSC32 /nologo
52 | # ADD BSC32 /nologo
53 | LINK32=link.exe
54 | # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
55 | # ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
56 |
57 | !ELSEIF "$(CFG)" == "HBOA - Win32 Debug"
58 |
59 | # PROP BASE Use_MFC 0
60 | # PROP BASE Use_Debug_Libraries 1
61 | # PROP BASE Output_Dir "Debug"
62 | # PROP BASE Intermediate_Dir "Debug"
63 | # PROP BASE Target_Dir ""
64 | # PROP Use_MFC 0
65 | # PROP Use_Debug_Libraries 1
66 | # PROP Output_Dir "Debug"
67 | # PROP Intermediate_Dir "Debug"
68 | # PROP Target_Dir ""
69 | # ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
70 | # ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
71 | # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
72 | # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
73 | # ADD BASE RSC /l 0x804 /d "_DEBUG"
74 | # ADD RSC /l 0x804 /d "_DEBUG"
75 | BSC32=bscmake.exe
76 | # ADD BASE BSC32 /nologo
77 | # ADD BSC32 /nologo
78 | LINK32=link.exe
79 | # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
80 | # ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /pdbtype:sept
81 |
82 | !ENDIF
83 |
84 | # Begin Target
85 |
86 | # Name "HBOA - Win32 Release"
87 | # Name "HBOA - Win32 Debug"
88 | # Begin Group "Source Files"
89 |
90 | # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
91 | # Begin Source File
92 |
93 | SOURCE=.\HBOA.F90
94 | DEP_F90_HBOA_=\
95 | ".\resource.fd"\
96 |
97 | # End Source File
98 | # Begin Source File
99 |
100 | SOURCE=.\Script1.rc
101 | # End Source File
102 | # End Group
103 | # Begin Group "Header Files"
104 |
105 | # PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
106 | # Begin Source File
107 |
108 | SOURCE=.\resource.fd
109 | # End Source File
110 | # End Group
111 | # Begin Group "Resource Files"
112 |
113 | # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
114 | # End Group
115 | # End Target
116 | # End Project
117 |
--------------------------------------------------------------------------------
/21/HBFA.dsp:
--------------------------------------------------------------------------------
1 | # Microsoft Developer Studio Project File - Name="HBFA" - Package Owner=<4>
2 | # Microsoft Developer Studio Generated Build File, Format Version 6.00
3 | # ** DO NOT EDIT **
4 |
5 | # TARGTYPE "Win32 (x86) Console Application" 0x0103
6 |
7 | CFG=HBFA - Win32 Debug
8 | !MESSAGE This is not a valid makefile. To build this project using NMAKE,
9 | !MESSAGE use the Export Makefile command and run
10 | !MESSAGE
11 | !MESSAGE NMAKE /f "HBFA.mak".
12 | !MESSAGE
13 | !MESSAGE You can specify a configuration when running NMAKE
14 | !MESSAGE by defining the macro CFG on the command line. For example:
15 | !MESSAGE
16 | !MESSAGE NMAKE /f "HBFA.mak" CFG="HBFA - Win32 Debug"
17 | !MESSAGE
18 | !MESSAGE Possible choices for configuration are:
19 | !MESSAGE
20 | !MESSAGE "HBFA - Win32 Release" (based on "Win32 (x86) Console Application")
21 | !MESSAGE "HBFA - Win32 Debug" (based on "Win32 (x86) Console Application")
22 | !MESSAGE
23 |
24 | # Begin Project
25 | # PROP AllowPerConfigDependencies 0
26 | # PROP Scc_ProjName ""
27 | # PROP Scc_LocalPath ""
28 | CPP=cl.exe
29 | F90=df.exe
30 | RSC=rc.exe
31 |
32 | !IF "$(CFG)" == "HBFA - Win32 Release"
33 |
34 | # PROP BASE Use_MFC 0
35 | # PROP BASE Use_Debug_Libraries 0
36 | # PROP BASE Output_Dir "Release"
37 | # PROP BASE Intermediate_Dir "Release"
38 | # PROP BASE Target_Dir ""
39 | # PROP Use_MFC 0
40 | # PROP Use_Debug_Libraries 0
41 | # PROP Output_Dir "Release"
42 | # PROP Intermediate_Dir "Release"
43 | # PROP Target_Dir ""
44 | # ADD BASE F90 /compile_only /nologo /warn:nofileopt
45 | # ADD F90 /compile_only /nologo /warn:nofileopt
46 | # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
47 | # ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
48 | # ADD BASE RSC /l 0x804 /d "NDEBUG"
49 | # ADD RSC /l 0x804 /d "NDEBUG"
50 | BSC32=bscmake.exe
51 | # ADD BASE BSC32 /nologo
52 | # ADD BSC32 /nologo
53 | LINK32=link.exe
54 | # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
55 | # ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
56 |
57 | !ELSEIF "$(CFG)" == "HBFA - Win32 Debug"
58 |
59 | # PROP BASE Use_MFC 0
60 | # PROP BASE Use_Debug_Libraries 1
61 | # PROP BASE Output_Dir "Debug"
62 | # PROP BASE Intermediate_Dir "Debug"
63 | # PROP BASE Target_Dir ""
64 | # PROP Use_MFC 0
65 | # PROP Use_Debug_Libraries 1
66 | # PROP Output_Dir "Debug"
67 | # PROP Intermediate_Dir "Debug"
68 | # PROP Target_Dir ""
69 | # ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
70 | # ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
71 | # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
72 | # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
73 | # ADD BASE RSC /l 0x804 /d "_DEBUG"
74 | # ADD RSC /l 0x804 /d "_DEBUG"
75 | BSC32=bscmake.exe
76 | # ADD BASE BSC32 /nologo
77 | # ADD BSC32 /nologo
78 | LINK32=link.exe
79 | # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
80 | # ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /pdbtype:sept
81 |
82 | !ENDIF
83 |
84 | # Begin Target
85 |
86 | # Name "HBFA - Win32 Release"
87 | # Name "HBFA - Win32 Debug"
88 | # Begin Group "Source Files"
89 |
90 | # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
91 | # Begin Source File
92 |
93 | SOURCE=.\HBFA.F90
94 | DEP_F90_HBFA_=\
95 | ".\resource.fd"\
96 |
97 | # End Source File
98 | # Begin Source File
99 |
100 | SOURCE=..\F90\HBFA\Script1.rc
101 | # End Source File
102 | # End Group
103 | # Begin Group "Header Files"
104 |
105 | # PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
106 | # Begin Source File
107 |
108 | SOURCE=.\resource.fd
109 | # End Source File
110 | # End Group
111 | # Begin Group "Resource Files"
112 |
113 | # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
114 | # Begin Source File
115 |
116 | SOURCE=..\F90\HBFA\bitmap3.bmp
117 | # End Source File
118 | # Begin Source File
119 |
120 | SOURCE=..\F90\HBFA\bitmap5.bmp
121 | # End Source File
122 | # End Group
123 | # End Target
124 | # End Project
125 |
--------------------------------------------------------------------------------
/22/resource.fd:
--------------------------------------------------------------------------------
1 | !MS$FREEFORM
2 | ! Microsoft Developer Studio generated include file.
3 | ! Used by Script1.rc
4 | !
5 | integer, parameter :: IDD_DIALOG1 = 101
6 | integer, parameter :: IDD_TAIDA = 101
7 | integer, parameter :: IDD_DIALOG2 = 102
8 | integer, parameter :: IDB_BITMAP1 = 111
9 | integer, parameter :: IDB_BITMAP2 = 112
10 | integer, parameter :: IDB_BITMAP3 = 113
11 | integer, parameter :: IDB_BITMAP4 = 114
12 | integer, parameter :: IDC_EDIT1 = 1000
13 | integer, parameter :: IDC_EDIT_DD = 1000
14 | integer, parameter :: IDC_EDIT2 = 1001
15 | integer, parameter :: IDC_EDIT_D = 1001
16 | integer, parameter :: IDC_EDIT3 = 1002
17 | integer, parameter :: IDC_EDIT_AL = 1002
18 | integer, parameter :: IDC_EDIT4 = 1003
19 | integer, parameter :: IDC_EDIT_AN = 1003
20 | integer, parameter :: IDC_EDIT5 = 1004
21 | integer, parameter :: IDC_EDIT_SUM = 1004
22 | integer, parameter :: IDC_EDIT6 = 1005
23 | integer, parameter :: IDC_EDIT_AI = 1005
24 | integer, parameter :: IDC_EDIT_ALF2 = 1005
25 | integer, parameter :: IDC_EDIT7 = 1006
26 | integer, parameter :: IDC_EDIT_Q = 1006
27 | integer, parameter :: IDC_EDIT_Q0 = 1006
28 | integer, parameter :: IDC_EDIT8 = 1007
29 | integer, parameter :: IDC_EDIT_M = 1007
30 | integer, parameter :: IDC_EDIT9 = 1008
31 | integer, parameter :: IDC_EDIT_ALF = 1008
32 | integer, parameter :: IDC_EDIT_MAXALF = 1008
33 | integer, parameter :: IDC_EDIT10 = 1009
34 | integer, parameter :: IDC_EDIT_RLGL = 1009
35 | integer, parameter :: IDC_EDIT_MAXRLGL = 1009
36 | integer, parameter :: IDC_EDIT11 = 1010
37 | integer, parameter :: IDC_EDIT_EPSON = 1010
38 | integer, parameter :: IDC_EDIT12 = 1011
39 | integer, parameter :: IDC_EDIT_CG = 1011
40 | integer, parameter :: IDC_EDIT_MAXCG = 1011
41 | integer, parameter :: IDC_EDIT13 = 1012
42 | integer, parameter :: IDC_EDIT_Q1 = 1012
43 | integer, parameter :: IDC_EDIT_RLGL2 = 1012
44 | integer, parameter :: IDC_EDIT14 = 1013
45 | integer, parameter :: IDC_EDIT_DT = 1013
46 | integer, parameter :: IDC_EDIT_CG2 = 1013
47 | integer, parameter :: IDC_BUTTON1 = 1014
48 | integer, parameter :: IDC_BUTTON_CALCULATE = 1014
49 | integer, parameter :: IDC_CALCULATE = 1014
50 | integer, parameter :: IDC_EDIT_SUM2 = 1015
51 | integer, parameter :: IDC_CANCEL = 1016
52 | integer, parameter :: IDC_CLEAR = 1017
53 | integer, parameter :: IDC_EDIT_DEDA = 1018
54 | integer, parameter :: IDC_EDIT_EPSON2 = 1019
55 | integer, parameter :: IDC_EDIT_RO = 1020
56 | integer, parameter :: IDC_EDIT_CO = 1021
57 | integer, parameter :: IDC_EDIT_AS = 1022
58 | integer, parameter :: IDC_EDIT19 = 1023
59 | integer, parameter :: IDC_EDIT_MINRLGL = 1023
60 | integer, parameter :: IDC_EDIT_MINALF = 1024
61 | integer, parameter :: IDC_EDIT_MINCG = 1025
62 | integer, parameter :: IDC_RADIO_EPSON = 1035
63 | integer, parameter :: IDC_RADIO_SUM = 1036
64 | integer, parameter :: IDC_EDIT_E = 1037
65 | integer, parameter :: IDC_LIST1 = 1042
66 | integer, parameter :: IDC_RADIO1_LOAD = 1043
67 | integer, parameter :: IDC_RADIO_LOAD = 1043
68 | integer, parameter :: IDC_RADIO_FLUX = 1044
69 | integer, parameter :: IDC_CONTINUE = 1045
70 | integer, parameter :: IDC_RADIO_CONTINUE = 1046
71 | integer, parameter :: IDC_RADIO_DYNAMIC = 1049
72 | integer, parameter :: IDC_RADIO_STATIC = 1050
73 |
--------------------------------------------------------------------------------
/11/JOURNALTHERM.f90:
--------------------------------------------------------------------------------
1 | PROGRAM JOURNALTHERM
2 | DIMENSION X(200),Y(200),P(20000),H(20000),T(20000),EDA(20000),POLD(20000)
3 | DATA EDA0,RO,C,AJ,B,R,RATIO,AN,EPSON/0.05,890.0,1870.0,4.184,1.0E-1,6.0E-2,0.003,3.0E3,0.7/
4 | OPEN(7,FILE='FILM.DAT',STATUS='UNKNOWN')
5 | OPEN(8,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
6 | OPEN(9,FILE='TEM.DAT',STATUS='UNKNOWN')
7 | OPEN(10,FILE='EDA.DAT',STATUS='UNKNOWN')
8 | PI=3.1415926
9 | N=61
10 | M=41
11 | DX=2.0*PI/FLOAT(N-1)
12 | DY=1./FLOAT(M-1)
13 | ALFA1=R/B
14 | C0=RATIO*R
15 | U=R*AN*2.0*PI/60.0
16 | ALFA=(R/B*DX/DY)**2
17 | A=U*R*EDA0/(2.0*AJ*RO*C*C0**2)
18 | T0=303.0
19 | KG=0
20 | CALL INIT(N,M,DX,DY,A,T0,EPSON,X,Y,H,T,EDA)
21 | 10 CALL SUBP(N,M,DX,EPSON,ALFA,H,P,EDA)
22 | CALL THERM(N,M,A,ALFA1,DX,DY,EDA0,T0,X,Y,P,H,T,EDA)
23 | IF(KG.EQ.0)THEN
24 | CALL PSAVE(KG,N,M,P,POLD,ERO)
25 | KG=1
26 | GOTO 10
27 | ENDIF
28 | CALL PSAVE(KG,N,M,P,POLD,ERO)
29 | WRITE(*,*)'EROP,KG=',ERO,KG
30 | KG=KG+1
31 | IF(ERO.GT.1.E-6.AND.KG.LT.10)GOTO 10
32 | CALL OUTPUT(N,M,A,T0,X,Y,H,P,T,EDA)
33 | STOP
34 | END
35 |
36 | SUBROUTINE INIT(N,M,DX,DY,A,T0,EPSON,X,Y,H,T,EDA)
37 | DIMENSION X(N),Y(M),H(N,M),T(N,M),EDA(N,M)
38 | DO I=1,N
39 | X(I)=(I-1.0)*DX
40 | ENDDO
41 | DO J=1,M
42 | Y(J)=-0.5+(J-1)*DY
43 | DO I=1,N
44 | H(I,J)=1.0+EPSON*COS(X(I))
45 | T(I,J)=T0/A
46 | EDA(I,J)=1.0
47 | ENDDO
48 | ENDDO
49 | RETURN
50 | END
51 |
52 | SUBROUTINE SUBP(N,M,DX,EPSON,ALFA,H,P,EDA)
53 | DIMENSION H(N,M),P(N,M),EDA(N,M)
54 | DO I=2,N-1
55 | DO J=2,M-1
56 | P(I,J)=0.5
57 | ENDDO
58 | ENDDO
59 | DO J=1,M
60 | P(1,J)=0.0
61 | P(N,J)=0.0
62 | ENDDO
63 | DO I=1,N
64 | P(I,1)=0.0
65 | P(I,M)=0.0
66 | ENDDO
67 | IK=0
68 | 10 C1=0.0
69 | ALOAD=0.0
70 | DO I=2,N-1
71 | I1=I-1
72 | I2=I+1
73 | DO J=2,M-1
74 | PD=P(I,J)
75 | J1=J-1
76 | J2=J+1
77 | A1=(0.5*(H(I2,J)+H(I,J)))**3/(0.5*(EDA(I2,J)+EDA(I,J)))
78 | A2=(0.5*(H(I,J)+H(I1,J)))**3/(0.5*(EDA(I,J)+EDA(I1,J)))
79 | A3=ALFA*H(I,J)**3/(0.5*(EDA(I,J2)+EDA(I,J)))
80 | A4=ALFA*H(I,J)**3/(0.5*(EDA(I,J)+EDA(I,J1)))
81 | A5=A1*P(I2,J)+A2*P(I1,J)+A3*P(I,J2)+A4*P(I,J1)
82 | A6=A1+A2+A3+A4
83 | P(I,J)=(-DX*(H(I2,J)-H(I1,J))+A5)/A6
84 | P(I,J)=0.7*PD+0.3*P(I,J)
85 | IF(P(I,J).LT.0.0)P(I,J)=0.0
86 | C1=C1+ABS(P(I,J)-PD)
87 | ALOAD=ALOAD+P(I,J)
88 | ENDDO
89 | ENDDO
90 | IK=IK+1
91 | C1=C1/ALOAD
92 | IF(C1.GT.1.E-6)GOTO 10
93 | RETURN
94 | END
95 |
96 | SUBROUTINE PSAVE(KG,N,M,P,POLD,ERO)
97 | DIMENSION P(N,M),POLD(N,M)
98 | IF(KG.EQ.0)GOTO 10
99 | ERO=0.0
100 | EROMAX=-1.0
101 | W=0.0
102 | DO I=1,N
103 | DO J=1,M
104 | AE=ABS(P(I,J)-POLD(I,J))
105 | ERO=ERO+AE
106 | IF(AE.GT.EROMAX)THEN
107 | II=I
108 | JJ=J
109 | EROMAX=AE
110 | ENDIF
111 | W=W+ABS(P(I,J))
112 | ENDDO
113 | ENDDO
114 | ERO=ERO/W
115 | 10 DO I=1,N
116 | DO J=1,M
117 | POLD(I,J)=P(I,J)
118 | ENDDO
119 | ENDDO
120 | RETURN
121 | END
122 |
123 | SUBROUTINE THERM(N,M,A,ALFA1,DX,DY,EDA0,T0,X,Y,P,H,T,EDA)
124 | DIMENSION X(N),Y(M),H(N,M),P(N,M),T(N,M),EDA(N,M)
125 | KG=0
126 | 10 ERT=0.0
127 | DO I=2,N
128 | DO J=1,M/2+1
129 | TOLD=T(I,J)
130 | EDA(I,J)=EXP((ALOG(EDA0)+9.67)*(((A*T(I,J)-138.0)/(T0-138.0))**(-1.1)-1.0))
131 | IF(I.NE.N)DPDX=0.5*(P(I+1,J)-P(I-1,J))/DX
132 | IF(I.EQ.N)DPDX=0.5*(P(1,J)-P(I-1,J))/DX
133 | QX=0.5*H(I,J)-0.5*H(I,J)**3*DPDX
134 | DPDY=ALFA1*(P(I,J+1)-P(I,J))/DY
135 | IF(J.EQ.M/2+1)DPDY=0.0
136 | QY=-0.5*H(I,J)**3*DPDY
137 | AA=QX/DX*T(I-1,J)-ALFA1*QY*T(I,J+1)/DY
138 | AB=2.0*EDA(I,J)/H(I,J)
139 | AC=6.0*H(I,J)/EDA(I,J)*(DPDX**2+DPDY**2)
140 | BB=QX/DX-ALFA1*QY/DY
141 | T(I,J)=(AA+AB+AC)/BB
142 | IF(A*T(I,J).GE.403.)THEN
143 | WRITE(*,*)'T OVER THE LIMIT 100'
144 | WRITE(*,*)I,J,T(I,J)
145 | STOP 00001
146 | ENDIF
147 | T(I,J)=0.7*TOLD+0.3*T(I,J)
148 | ERT=ERT+ABS(T(I,J)-TOLD)/303.
149 | ENDDO
150 | ENDDO
151 | ERT=A*ERT/((N-1)*(M-1))
152 | KG=KG+1
153 | DO J=1,M
154 | T(1,J)=0.5*(T(1,J)+T(N,J))
155 | ENDDO
156 | WRITE(*,*)'ERT,KG=',ERT,KG
157 | IF(ERT.GT.1.E-3)GOTO 10
158 | DO I=1,N
159 | DO J=1,M/2
160 | T(I,M-J+1)=T(I,J)
161 | EDA(I,M-J+1)=EDA(I,J)
162 | ENDDO
163 | ENDDO
164 | RETURN
165 | END
166 | SUBROUTINE OUTPUT(N,M,A,T0,X,Y,H,P,T,EDA)
167 | DIMENSION X(N),Y(M),H(N,M),P(N,M),T(N,M),EDA(N,M)
168 | TMAX=0.0
169 | DO I=1,N
170 | DO J=1,M
171 | T(I,J)=A*T(I,J)-T0
172 | IF(T(I,J).GT.TMAX)TMAX=T(I,J)
173 | END DO
174 | ENDDO
175 | WRITE(*,*)'TAMX=',TMAX
176 | WRITE(7,30)X(1),(Y(J),J=1,M)
177 | WRITE(8,30)X(1),(Y(J),J=1,M)
178 | WRITE(9,30)X(1),(Y(J),J=1,M)
179 | WRITE(10,30)X(1),(Y(J),J=1,M)
180 | DO I=1,N
181 | WRITE(7,30)X(I),(H(I,J),J=1,M)
182 | WRITE(8,30)X(I),(P(I,J),J=1,M)
183 | WRITE(9,30)X(I),(T(I,J),J=1,M)
184 | WRITE(10,30)X(I),(EDA(I,J),J=1,M)
185 | ENDDO
186 | 30 FORMAT(42(1X,E12.6))
187 | RETURN
188 | END
189 |
--------------------------------------------------------------------------------
/23/MAGNETICHEAD.F90:
--------------------------------------------------------------------------------
1 | PROGRAM MAGNETICHEAD
2 | IMPLICIT REAL*8 (A-H,O-Z)
3 | DIMENSION P(101,101),H(101,101),X(101),Y(101),F(101,101),QW(101,101)
4 | DATA AL,B,HM,BETA1,U,EDA,PA/1.25E-3,1.0E-3,1.0E-8,0.01,25.0,1.8060E-5,1.0135E5/
5 | DATA ALA,ALFA,R,T0,SKEW,PI,AROLL/63.5E-9,0.95024E-4,287.03,293.0,0.0,3.14159265,6.1465303E-6/
6 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
7 | OPEN(9,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
8 | OPEN(10,FILE='ERROR.DAT',STATUS='UNKNOWN')
9 | OPEN(11,FILE='FLUX.DAT',STATUS='UNKNOWN')
10 | N=101
11 | M=N
12 | N1=N-1
13 | M1=N1
14 | N2=N1/2+1
15 | M2=M1/2+1
16 | UX=U*COS(SKEW*PI/180.)
17 | UY=U*SIN(SKEW*PI/180.)
18 | HC=ALA/HM
19 | ALENDA=6.0*EDA*UX*AL/(HM**2*PA)
20 | ALENDAY=6.0*EDA*UY*AL/(HM**2*PA)
21 | DELTA=AL*SIN(ALFA)/HM
22 | Q=B/AL
23 | D0=PA*HM/EDA/SQRT(2.0*R*T0)
24 | CALL SUBH(N,M,M2,N1,M1,DX,DY,AL,ALFA,B,AROLL,HM,DELTA1,X,Y,H)
25 | CALL SUBPINIT(N,M,N1,M1,HMIN,H,P,F,QW)
26 | CALL SUBP(N,M,N1,M1,DX,DY,Q,ALENDA,ALENDAY,D0,DR,PA,AL,B,BETA1,PI,AD,HM,ALFA,U,H,P,F,QW)
27 | CALL OUTPUT(N,M,X,Y,H,P,F,QW)
28 | STOP
29 | END
30 | SUBROUTINE SUBH(N,M,M2,N1,M1,DX,DY,AL,ALFA,B,AROLL,HM,DELTA1,X,Y,H)
31 | IMPLICIT REAL*8 (A-H,O-Z)
32 | DIMENSION X(N),Y(M),H(N,M)
33 | DO I=1,N
34 | DO J=1,M
35 | H(I,J)=(1770.0E-9+HM)/HM
36 | ENDDO
37 | ENDDO
38 | DO I=1,0.1*N
39 | DO J=1,M
40 | H(I,J)=(114.0E-9+HM)/HM
41 | ENDDO
42 | ENDDO
43 | DO I=0.1*N+1,0.2*N
44 | DO J=1,M
45 | H(I,J)=1.0
46 | ENDDO
47 | ENDDO
48 | DO I=0.2*N+1,0.8*N
49 | DO J=1,0.1*M
50 | H(I,J)=1.0
51 | H(I,M-J)=1.0
52 | ENDDO
53 | ENDDO
54 | DO I=0.77*N+1,0.97*N
55 | DO J=0.4*M,M/2+1
56 | H(I,J)=1.0
57 | H(I,M-J)=1.0
58 | ENDDO
59 | ENDDO
60 | DO I=0.85*N+1,0.95*N
61 | DO J=0.2*M,0.3*M
62 | H(I,J)=1.0
63 | H(I,M-J)=1.0
64 | ENDDO
65 | ENDDO
66 | X(1)=0.0
67 | DX=1./N1
68 | DO I=2,N
69 | X(I)=X(I-1)+DX
70 | ENDDO
71 | Y(1)=-0.5
72 | DY=1./M1
73 | DO J=2,M
74 | Y(J)=Y(J-1)+DY
75 | ENDDO
76 | X(N)=1.0
77 | Y(M2)=0.0
78 | HMIN=10.0
79 | DO I=1,N
80 | DO J=1,M
81 | DELTA1=(AL*(X(N)-X(I))*SIN(ALFA)+B*(Y(M)-Y(J))*SIN(AROLL))/HM
82 | H(I,J)=H(I,J)+DELTA1
83 | IF(H(I,J).LT.HMIN)THEN
84 | IMIN=I
85 | JMIN=J
86 | HMIN=H(I,J)
87 | ENDIF
88 | ENDDO
89 | ENDDO
90 | RETURN
91 | END
92 | SUBROUTINE SUBPINIT(N,M,N1,M1,HMIN,H,P,F,QW)
93 | IMPLICIT REAL*8 (A-H,O-Z)
94 | DIMENSION H(N,M),P(N,M),F(N,M),QW(N,M)
95 | DO I=1,N
96 | DO J=1,M
97 | P(I,J)=1.0
98 | F(I,J)=0.0
99 | QW(I,J)=1.0
100 | ENDDO
101 | ENDDO
102 | DO I=2,N1
103 | DO J=2,M1
104 | P(I,J)=P(I-1,J)*H(I-1,J)/H(I,J)
105 | ENDDO
106 | ENDDO
107 | RETURN
108 | END
109 | SUBROUTINE SUBP(N,M,N1,M1,DX,DY,Q,ALENDA,ALENDAY,D0,DR,PA,AL,B,BETA1,PI,AD,HM,ALFA,U,H,P,F,QW)
110 | IMPLICIT REAL*8 (A-H,O-Z)
111 | DIMENSION H(N,M),P(N,M),F(N,M),QW(N,M)
112 | K=0
113 | DX1=1./DX
114 | DY1=1./(Q*DY)
115 | DX2=DX1*DX1
116 | DY2=DY1*DY1
117 | CX=2.*ALENDA*DX1
118 | CY=2.*ALENDAY*DY1
119 | 10 DO I=1,N
120 | DO J=1,M
121 | DR=D0*P(I,J)*H(I,J)
122 | QC=DR/6.0
123 | QP=QC+1.0162+0.40134*DLOG(1.0+1.2477/DR)
124 | QW(I,J)=QP/QC
125 | ENDDO
126 | ENDDO
127 | ERR=0.0
128 | DO J=2,M1
129 | DO I=2,N1
130 | C0=CX*H(I,J)
131 | C5=CX*P(I-1,J)*H(I-1,J)
132 | CY0=CY*H(I,J)
133 | CY5=CY*P(I,J-1)*H(I,J-1)
134 | TMP1 = QW(I+1,J)*H(I+1,J)*H(I+1,J)*H(I+1,J)
135 | TMP2 = QW(I,J)*H(I,J)*H(I,J)*H(I,J)
136 | QHP1 = 2.0*TMP1*TMP2/(TMP1+TMP2)
137 | TMP1 = QW(I-1,J)*H(I-1,J)*H(I-1,J)*H(I-1,J)
138 | QHM1 = 2.0*TMP1*TMP2/(TMP1+TMP2)
139 | C1=P(I,J)*(QHP1+ QHM1)*DX2
140 | C3=(P(I+1,J)*P(I+1,J)*QHP1+P(I-1,J)*P(I-1,J)*QHM1)*DX2
141 | TMP1 = QW(I,J+1)*H(I,J+1)*H(I,J+1)*H(I,J+1)
142 | QHP1 = 2.0*TMP1*TMP2/(TMP1+TMP2)
143 | TMP1 = QW(I,J-1)*H(I,J-1)*H(I,J-1)*H(I,J-1)
144 | QHM1 = 2.0*TMP1*TMP2/(TMP1+TMP2)
145 | C2=P(I,J)*(QHP1+ QHM1)*DY2
146 | C4=(P(I,J+1)*P(I,J+1)*QHP1+P(I,J-1)*P(I,J-1)*QHM1)*DY2
147 | TMP=(C5+C3+C4+CY5)/(C0+C1+C2+CY0)
148 | P(I,J)=P(I,J)+ BETA1*(TMP-P(I,J))
149 | F(I,J)=P(I,J)*(C0+C1+C2+CY0)-C3-C4-C5-CY5
150 | IF(ABS(F(I,J)).GT.ERR)ERR=ABS(F(I,J))
151 | ENDDO
152 | ENDDO
153 | K=K+1
154 | WRITE(*,*)'K=, ERR=',K,ERR
155 | IF(ERR.LT.1.E-5)GOTO 20
156 | IF(K.GT.500)BETA1=0.1
157 | IF(K.GT.2000)BETA1=0.5
158 | IF(K.GT.3000)BETA1=0.75
159 | IF(K.GT.5000)BETA1=0.95
160 | IF(K.LE.8000) GOTO 10
161 | 20 SM=0.0
162 | PMAX=0.0
163 | PMIN=0.0
164 | AD=2.0/SQRT(PI)
165 | DO I=1,N
166 | DO J=1,M
167 | P(I,J)=P(I,J)-1.
168 | SM=SM+P(I,J)
169 | IF(P(I,J).GT.PMAX)THEN
170 | PMAX=P(I,J)
171 | IMAX=I
172 | JMAX=J
173 | ENDIF
174 | IF(P(I,J).LT.PMIN)THEN
175 | PMIN=P(I,J)
176 | IMIN=I
177 | JMIN=J
178 | ENDIF
179 | QW(I,J)=AD*D0*(1.+P(I,J))*H(I,J)
180 | H(I,J)=HM*H(I,J)
181 | ENDDO
182 | ENDDO
183 | SM=SM*PA*AL*B/(N1*M1)
184 | WRITE(*,*)'ALFA=',ALFA,'HM=',HM,'U=',U,'LOAD=',SM,'PMAX=',PMAX,'PMIN=',PMIN
185 | RETURN
186 | END
187 | SUBROUTINE OUTPUT(N,M,X,Y,H,P,F,QW)
188 | IMPLICIT REAL*8 (A-H,O-Z)
189 | DIMENSION X(N),Y(M),H(N,M),P(N,M),F(N,M),QW(N,M)
190 | WRITE(8,30)(Y(J),J=1,M)
191 | 30 FORMAT(1X,101(E12.6,1X))
192 | WRITE(8,40)(X(I),(H(I,J),J=1,M),I=1,N)
193 | 40 FORMAT(102(E12.6,1X))
194 | WRITE(9,30)(Y(J),J=1,M)
195 | WRITE(9,40)(X(I),(P(I,J),J=1,M),I=1,N)
196 | WRITE(10,30)(Y(J),J=1,M)
197 | WRITE(10,40)(X(I),(F(I,J),J=1,M),I=1,N)
198 | WRITE(11,30)(Y(J),J=1,M)
199 | WRITE(11,40)(X(I),(QW(I,J),J=1,M),I=1,N)
200 | RETURN
201 | END
202 |
--------------------------------------------------------------------------------
/13/LINEEHL.f90:
--------------------------------------------------------------------------------
1 | PROGRAM LINEEHL
2 | CHARACTER*1 S,S1,S2
3 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW/COM2/EDA0/COM4/X0,XE/COM3/E1,PH,B,U1,U2,R
4 | DATA PAI,Z,P0/3.14159265,0.68,1.96E8/,S1,S2/1HY,1Hy/
5 | DATA N,X0,XE,W,E1,EDA0,R,Us,CU,C1/129,-4.0,1.4,1.E5,2.21E11,0.028,0.012183,0.87,0.67,0.5/
6 | OPEN(8,FILE='result.DAT',STATUS='UNKNOWN')
7 | WRITE(*,*)'Show the example or not (Y or N)?'
8 | READ(*,'(A)')S
9 | IF(S.EQ.S1.OR.S.EQ.S2)THEN
10 | GOTO 10
11 | ENDIF
12 | WRITE(*,*)'N,PH,US='
13 | READ(*,*)N,PH,US
14 | W=2.*PAI*R*PH*(PH/E1)
15 | WRITE(*,*)'W=',W
16 | 10 W1=W/(E1*R)
17 | PH=E1*SQRT(0.5*W1/PAI)
18 | A1=(ALOG(EDA0)+9.67)
19 | A2=PH/P0
20 | A3=0.59/(PH*1.E-9)
21 | B=4.*R*PH/E1
22 | ALFA=Z*A1/P0
23 | G=ALFA*E1
24 | U=EDA0*US/(2.*E1*R)
25 | CC1=SQRT(2.*U)
26 | AM=2.*PAI*(PH/E1)**2/CC1
27 | AL=G*SQRT(CC1)
28 | CW=(PH/E1)*(B/R)
29 | C3=1.6*(R/B)**2*G**0.6*U**0.7*W1**(-0.13)
30 | ENDA=3.*(PAI/AM)**2/8.
31 | U1=0.5*(2.+CU)*U
32 | U2=0.5*(2.-CU)*U
33 | CW=-1.13*C3
34 | WRITE(*,*)N,X0,XE,W,E1,EDA0,R,US
35 | WRITE(8,*)N,X0,XE,W,E1,EDA0,R,US,B,PH
36 | WRITE(*,40)
37 | 40 FORMAT(2X,' Wait Please',//)
38 | CALL SUBAK(N)
39 | CALL EHL(N)
40 | STOP
41 | END
42 | SUBROUTINE EHL(N)
43 | DIMENSION X(1100),P(1100),H(1100),RO(1100),POLD(1100),EPS(1100),EDA(1100),R(1100)
44 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW/COM4/X0,XE
45 | COMMON /COM3/E1,PH,B,U1,U2,RR
46 | DATA MK,G0/1,1.570796325/
47 | NX=N
48 | DX=(XE-X0)/(N-1.0)
49 | DO 10 I=1,N
50 | X(I)=X0+(I-1)*DX
51 | IF(ABS(X(I)).GE.1.0)P(I)=0.0
52 | IF(ABS(X(I)).LT.1.0)P(I)=SQRT(1.-X(I)*X(I))
53 | 10 CONTINUE
54 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA)
55 | CALL FZ(N,P,POLD)
56 | 14 KK=19
57 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,R)
58 | MK=MK+1
59 | CALL ERROP(N,P,POLD,ERP)
60 | WRITE(*,*)ERP
61 | IF(MK.EQ.2)THEN
62 | ENDIF
63 | IF(ERP.GT.1.E-4.AND.MK.LE.200)THEN
64 | GOTO 14
65 | ENDIF
66 | 105 IF(MK.GE.200)THEN
67 | WRITE(*,*)'Pressures are not convergent !!!'
68 | READ(*,*)
69 | ENDIF
70 | H2=1.E3
71 | P2=0.0
72 | DO 106 I=1,N
73 | IF(H(I).LT.H2)H2=H(I)
74 | IF(P(I).GT.P2)P2=P(I)
75 | 106 CONTINUE
76 | H3=H2*B*B/RR
77 | P3=P2*PH
78 | 110 FORMAT(6(1X,E12.6))
79 | 120 CONTINUE
80 | WRITE(8,*)'P2,H2,P3,H3=',P2,H2,P3,H3
81 | CALL OUTHP(N,X,P,H,R)
82 | RETURN
83 | END
84 | SUBROUTINE OUTHP(N,X,P,H,R)
85 | DIMENSION X(N),P(N),H(N),R(N)
86 | DX=X(2)-X(1)
87 | DO 10 I=1,N
88 | WRITE(8,20)X(I),P(I),H(I),R(I)
89 | 10 CONTINUE
90 | 20 FORMAT(1X,6(F12.6,1X))
91 | RETURN
92 | END
93 | SUBROUTINE HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA)
94 | DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N)
95 | DIMENSION W(2200)
96 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW,K/COM2/EDA0/COMAK/AK(0:1100)
97 | DATA KK,NW,PAI1/0,2200,0.318309886/
98 | IF(KK.NE.0)GOTO 3
99 | HM0=C3
100 | H00=0.0
101 | 3 W1=0.0
102 | DO 4 I=1,N
103 | 4 W1=W1+P(I)
104 | C3=(DX*W1)/G0
105 | DW=1.-C3
106 | CALL VI(N,DX,P,W)
107 | HMIN=1.E3
108 | DO 30 I=1,N
109 | H0=0.5*X(I)*X(I)+W(I)
110 | IF(H0.LT.HMIN)HMIN=H0
111 | H(I)=H0
112 | 30 CONTINUE
113 | IF(KK.NE.0)GOTO 32
114 | KK=1
115 | H00=-HMIN+HM0
116 | 32 H0=H00+HMIN
117 | IF(H0.LE.0.0)GOTO 48
118 | IF(H0+0.3*CW*DW.GT.0.0)HM0=H0+0.3*CW*DW
119 | IF(H0+0.3*CW*DW.LE.0.0)HM0=HM0*C3
120 | 48 H00=HM0-HMIN
121 | 50 DO 60 I=1,N
122 | 60 H(I)=H00+H(I)
123 | DO 100 I=1,N
124 | EDA(I)=EXP(A1*(-1.+(1.+A2*P(I))**Z))
125 | RO(I)=(A3+1.34*P(I))/(A3+P(I))
126 | EPS(I)=RO(I)*H(I)**3/(ENDA*EDA(I))
127 | 100 CONTINUE
128 | RETURN
129 | END
130 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,R)
131 | DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N),R(N)
132 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW
133 | COMMON /COMAK/AK(0:1100)
134 | DATA KG1,PAI/0,3.14159265/
135 | IF(KG1.NE.0)GOTO 5
136 | KG1=1
137 | DX1=1./DX
138 | DX2=DX*DX
139 | DX3=1./DX2
140 | DX4=DX1/PAI
141 | DXL=DX*ALOG(DX)
142 | AK0=DX*AK(0)+DXL
143 | AK1=DX*AK(1)+DXL
144 | 5 DO 100 K=1,KK
145 | D2=0.5*(EPS(1)+EPS(2))
146 | D3=0.5*(EPS(2)+EPS(3))
147 | D5=DX1*(RO(2)*H(2)-RO(1)*H(1))
148 | D7=DX4*(RO(2)*AK0-RO(1)*AK1)
149 | PP=0.
150 | DO 70 I=2,N-1
151 | D1=D2
152 | D2=D3
153 | D4=D5
154 | D6=D7
155 | IF(I+2.LE.N)D3=0.5*(EPS(I+1)+EPS(I+2))
156 | D5=DX1*(RO(I+1)*H(I+1)-RO(I)*H(I))
157 | D7=DX4*(RO(I+1)*AK0-RO(I)*AK1)
158 | DD=(D1+D2)*DX3
159 | IF(0.05*DD.LT.ABS(D6))GOTO 10
160 | RI=-DX3*(D1*P(I-1)-(D1+D2)*P(I)+D2*P(I+1))+D4
161 | R(I)=RI
162 | DLDP=-DX3*(D1+D2)+D6
163 | RI=RI/DLDP
164 | RI=RI/C1
165 | GOTO 20
166 | 10 RI=-DX3*(D1*PP-(D1+D2)*P(I)+D2*P(I+1))+D4
167 | R(I)=RI
168 | DLDP=-DX3*(2.*D1+D2)+2.*D6
169 | RI=RI/DLDP
170 | RI=0.5*RI
171 | IF(I.GT.2.AND.P(I-1)-C1*RI.GT.0.0)P(I-1)=P(I-1)-C1*RI
172 | 20 PP=P(I)
173 | P(I)=P(I)+C1*RI
174 | IF(P(I).LT.0.0)P(I)=0.0
175 | IF(P(I).LE.0.0)R(I)=0.0
176 | 70 CONTINUE
177 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA)
178 | 100 CONTINUE
179 | RETURN
180 | END
181 | SUBROUTINE VI(N,DX,P,V)
182 | DIMENSION P(N),V(N)
183 | COMMON /COMAK/AK(0:1100)
184 | PAI1=0.318309886
185 | C=ALOG(DX)
186 | DO 10 I=1,N
187 | V(I)=0.0
188 | DO 10 J=1,N
189 | IJ=IABS(I-J)
190 | 10 V(I)=V(I)+(AK(IJ)+C)*DX*P(J)
191 | DO I=1,N
192 | V(I)=-PAI1*V(I)
193 | ENDDO
194 | RETURN
195 | END
196 | SUBROUTINE SUBAK(MM)
197 | COMMON /COMAK/AK(0:1100)
198 | DO 10 I=0,MM
199 | 10 AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
200 | RETURN
201 | END
202 | SUBROUTINE FZ(N,P,POLD)
203 | DIMENSION P(N),POLD(N)
204 | DO 10 I=1,N
205 | 10 POLD(I)=P(I)
206 | RETURN
207 | END
208 | SUBROUTINE ERROP(N,P,POLD,ERP)
209 | DIMENSION P(N),POLD(N)
210 | SD=0.0
211 | SUM=0.0
212 | DO 10 I=1,N
213 | SD=SD+ABS(P(I)-POLD(I))
214 | POLD(I)=P(I)
215 | 10 SUM=SUM+P(I)
216 | ERP=SD/SUM
217 | RETURN
218 | END
219 |
220 |
--------------------------------------------------------------------------------
/14/POINTEHL.f90:
--------------------------------------------------------------------------------
1 | PROGRAM POINTEHL
2 | DIMENSION THETA(15),EALFA(15),EBETA(15)
3 | COMMON /COM1/ENDA,A1,A2,A3,Z,HM0
4 | COMMON /COMEK/EK,EAL,EBE
5 | DATA N,PAI,Z,EAL,EBE,E1,EDA0,RX,RY,X0,XE,W0,US/65,3.14159265,0.68,1.0,1.0,2.21E11,0.0283,0.05,0.05,-2.5,1.5,39.24,1.5/
6 | DATA THETA/10.,20.,30.,35.,40.,45.,50.,55.,60.,65.,70.,75.,80.,85.,90./
7 | DATA EALFA/6.612,3.778,2.731,2.397,2.136,1.926,1.754,1.611,1.486,1.378,1.284,1.202,1.128,1.061,1.0/
8 | DATA EBETA/0.319,0.408,0.493,0.53,0.567,0.604,0.641,0.678,0.717,0.759,0.802,0.846,0.893,0.944,1.0/
9 | EK=RX/RY
10 | AA=0.5*(1./RX+1./RY)
11 | BB=0.5*ABS(1./RX-1./RY)
12 | CC=ACOS(BB/AA)*180.0/PAI
13 | DO I=1,15
14 | IF(CC.LT.THETA(I))THEN
15 | WRITE(*,*)I
16 | EAL=EALFA(I-1)+(CC-THETA(I))*(EALFA(I)-EALFA(I-1))/(THETA(I)-THETA(I-1))
17 | EBE=EBETA(I-1)+(CC-THETA(I))*(EBETA(I)-EBETA(I-1))/(THETA(I)-THETA(I-1))
18 | GOTO 1
19 | ENDIF
20 | ENDDO
21 | 1 EA=EAL*(1.5*W0/AA/E1)**(1./3.0)
22 | EB=EBE*(1.5*W0/AA/E1)**(1./3.0)
23 | PH=1.5*W0/(EA*EB*PAI)
24 | OPEN(4,FILE='OUT.DAT',STATUS='UNKNOWN')
25 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
26 | OPEN(10,FILE='PRESSURE.DAT',STATUS='UNKNOWN')
27 | WRITE(*,*)N,X0,XE,W0,PH,E1,EDA0,RX,US
28 | WRITE(4,*)N,X0,XE,W0,PH,E1,EDA0,RX,US
29 | H00=0.0
30 | MM=N-1
31 | U=EDA0*US/(2.*E1*RX)
32 | A1=ALOG(EDA0)+9.67
33 | A2=5.1E-9*PH
34 | A3=0.59/(PH*1.E-9)
35 | B=PAI*PH*RX/E1
36 | W=2.*PAI*PH/(3.*E1)*(B/RX)**2
37 | ALFA=Z*5.1E-9*A1
38 | G=ALFA*E1
39 | AHM=1.0-EXP(-0.68*1.03)
40 | HM0=3.63*(RX/B)**2*G**0.49*U**0.68*W**(-0.073)*AHM
41 | ENDA=12.*U*(E1/PH)*(RX/B)**3
42 | UTL=EDA0*US*RX/(B*B*2.E7)
43 | W0=2.0*PAI*EA*EB*PH/3.0
44 | WRITE(*,*)' Wait please'
45 | CALL SUBAK(MM)
46 | CALL MULTI(N,X0,XE,H00)
47 | STOP
48 | END
49 | SUBROUTINE MULTI(N,X0,XE,H00)
50 | DIMENSION X(65),Y(65),H(4500),RO(4500),EPS(4500),EDA(4500),P(4500),POLD(4500)
51 | COMMON /COMEK/EK,EAL,EBE
52 | DATA MK,G00/200,2.0943951/
53 | G0=G00*EAL*EBE
54 | NX=N
55 | NY=N
56 | NN=(N+1)/2
57 | CALL INITI(N,DX,X0,XE,X,Y,P,POLD)
58 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
59 | M=0
60 | 14 KK=15
61 | CALL ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
62 | M=M+1
63 | CALL ERP(N,ER,P,POLD)
64 | WRITE(*,*)'ER=',ER
65 | IF(M.LT.MK.AND.ER.GT.1.E-5)GOTO 14
66 | CALL OUTPUT(N,DX,X,Y,H,P)
67 | RETURN
68 | END
69 | SUBROUTINE ERP(N,ER,P,POLD)
70 | DIMENSION P(N,N),POLD(N,N)
71 | ER=0.0
72 | SUM=0.0
73 | NN=(N+1)/2
74 | DO 10 I=1,N
75 | DO 10 J=1,NN
76 | ER=ER+ABS(P(I,J)-POLD(I,J))
77 | SUM=SUM+P(I,J)
78 | 10 CONTINUE
79 | ER=ER/SUM
80 | DO I=1,N
81 | DO J=1,N
82 | POLD(I,J)=P(I,J)
83 | ENDDO
84 | ENDDO
85 | RETURN
86 | END
87 | SUBROUTINE INITI(N,DX,X0,XE,X,Y,P,POLD)
88 | DIMENSION X(N),Y(N),P(N,N),POLD(N,N)
89 | NN=(N+1)/2
90 | DX=(XE-X0)/(N-1.)
91 | Y0=-0.5*(XE-X0)
92 | DO 5 I=1,N
93 | X(I)=X0+(I-1)*DX
94 | Y(I)=Y0+(I-1)*DX
95 | 5 CONTINUE
96 | DO 10 I=1,N
97 | D=1.-X(I)*X(I)
98 | DO 10 J=1,NN
99 | C=D-Y(J)*Y(J)
100 | IF(C.LE.0.0)P(I,J)=0.0
101 | 10 IF(C.GT.0.0)P(I,J)=SQRT(C)
102 | DO 20 I=1,N
103 | DO 20 J=NN+1,N
104 | JJ=N-J+1
105 | 20 P(I,J)=P(I,JJ)
106 | DO I=1,N
107 | DO J=1,N
108 | POLD(I,J)=P(I,J)
109 | ENDDO
110 | ENDDO
111 | RETURN
112 | END
113 | SUBROUTINE HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
114 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
115 | DIMENSION W(150,150),P0(150,150)
116 | COMMON /COM1/ENDA,A1,A2,A3,Z,HM0/COMAK/AK(0:65,0:65)
117 | COMMON /COMEK/EK,EAL,EBE
118 | DATA NW,PAI,PAI1/150,3.14159265,0.2026423/
119 | NN=(N+1)/2
120 | CALL VI(NW,N,DX,P,W)
121 | HMIN=1.E3
122 | DO 30 I=1,N
123 | DO 30 J=1,NN
124 | RAD=X(I)*X(I)+EK*Y(J)*Y(J)
125 | W1=0.5*RAD
126 | H0=W1+W(I,J)
127 | IF(H0.LT.HMIN)HMIN=H0
128 | 30 H(I,J)=H0
129 | IF(KK.EQ.0)THEN
130 | KG1=0
131 | H01=-HMIN+HM0
132 | DH=0.005*HM0
133 | H02=-HMIN
134 | H00=0.5*(H01+H02)
135 | ENDIF
136 | W1=0.0
137 | DO 32 I=1,N
138 | DO 32 J=1,N
139 | 32 W1=W1+P(I,J)
140 | W1=DX*DX*W1/G0
141 | DW=1.-W1
142 | IF(KK.EQ.0)THEN
143 | KK=1
144 | GOTO 50
145 | ENDIF
146 | IF(DW.LT.0.0)THEN
147 | KG1=1
148 | H00=AMIN1(H01,H00+DH)
149 | ENDIF
150 | IF(DW.GT.0.0)THEN
151 | KG2=2
152 | H00=AMAX1(H02,H00-DH)
153 | ENDIF
154 | 50 DO 60 I=1,N
155 | DO 60 J=1,NN
156 | H(I,J)=H00+H(I,J)
157 | IF(P(I,J).LT.0.0)P(I,J)=0.0
158 | EDA1=EXP(A1*(-1.+(1.+A2*P(I,J))**Z))
159 | EDA(I,J)=EDA1
160 | 55 RO(I,J)=(A3+1.34*P(I,J))/(A3+P(I,J))
161 | 60 EPS(I,J)=RO(I,J)*H(I,J)**3/(ENDA*EDA1)
162 | DO 70 J=NN+1,N
163 | JJ=N-J+1
164 | DO 70 I=1,N
165 | H(I,J)=H(I,JJ)
166 | RO(I,J)=RO(I,JJ)
167 | EDA(I,J)=EDA(I,JJ)
168 | 70 EPS(I,J)=EPS(I,JJ)
169 | RETURN
170 | END
171 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
172 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
173 | DIMENSION D(70),A(350),B(210),ID(70)
174 | COMMON /COM1/ENDA,A1,A2,A3,Z,C3/COMAK/AK(0:65,0:65)
175 | DATA KG1,PAI1,C1,C2/0,0.2026423,0.31,0.31/
176 | IF(KG1.NE.0)GOTO 2
177 | KG1=1
178 | AK00=AK(0,0)
179 | AK10=AK(1,0)
180 | AK20=AK(2,0)
181 | BK00=AK00-AK10
182 | BK10=AK10-0.25*(AK00+2.*AK(1,1)+AK(2,0))
183 | BK20=AK20-0.25*(AK10+2.*AK(2,1)+AK(3,0))
184 | 2 NN=(N+1)/2
185 | MM=N-1
186 | DX1=1./DX
187 | DX2=DX*DX
188 | DX3=1./DX2
189 | DX4=0.3*DX2
190 | DO 100 K=1,KK
191 | PMAX=0.0
192 | DO 70 J=2,NN
193 | J0=J-1
194 | J1=J+1
195 | JJ=N-J+1
196 | IA=1
197 | 8 MM=N-IA
198 | IF(P(MM,J0).GT.1.E-6)GOTO 20
199 | IF(P(MM,J).GT.1.E-6)GOTO 20
200 | IF(P(MM,J1).GT.1.E-6)GOTO 20
201 | IA=IA+1
202 | IF(IA.LT.N)GOTO 8
203 | GOTO 70
204 | 20 IF(MM.LT.N-1)MM=MM+1
205 | D2=0.5*(EPS(1,J)+EPS(2,J))
206 | DO 50 I=2,MM
207 | I0=I-1
208 | I1=I+1
209 | II=5*I0
210 | D1=D2
211 | D2=0.5*(EPS(I1,J)+EPS(I,J))
212 | D4=0.5*(EPS(I,J0)+EPS(I,J))
213 | D5=0.5*(EPS(I,J1)+EPS(I,J))
214 | P1=P(I0,JJ)
215 | P2=P(I1,JJ)
216 | P3=P(I,JJ)
217 | P4=P(I,JJ+1)
218 | P5=P(I,JJ-1)
219 | D3=D1+D2+D4+D5
220 | IF(J.EQ.NN.AND.ID(I).EQ.1)P(I,J)=P(I,J)-0.5*C2*D(I)
221 | IF(H(I,J).LE.0.0)THEN
222 | ID(I)=2
223 | A(II+1)=0.0
224 | A(II+2)=0.0
225 | A(II+3)=1.0
226 | A(II+4)=0.0
227 | A(II+5)=1.0
228 | A(II-4)=0.0
229 | GOTO 50
230 | ENDIF
231 | IF(D1.GE.DX4)GOTO 30
232 | IF(D2.GE.DX4)GOTO 30
233 | IF(D4.GE.DX4)GOTO 30
234 | IF(D5.GE.DX4)GOTO 30
235 | ID(I)=1
236 | IF(J.EQ.NN)P5=P4
237 | A(II+1)=PAI1*(RO(I0,J)*BK10-RO(I,J)*BK20)
238 | A(II+2)=DX3*(D1+0.25*D3)+PAI1*(RO(I0,J)*BK00-RO(I,J)*BK10)
239 | A(II+3)=-1.25*DX3*D3+PAI1*(RO(I0,J)*BK10-RO(I,J)*BK00)
240 | A(II+4)=DX3*(D2+0.25*D3)+PAI1*(RO(I0,J)*BK20-RO(I,J)*BK10)
241 | A(II+5)=-DX3*(D1*P1+D2*P2+D4*P4+D5*P5-D3*P3)+DX1*(RO(I,J)*H(I,J)-RO(I0,J)*H(I0,J))
242 | GOTO 50
243 | 30 ID(I)=0
244 | P4=P(I,J0)
245 | IF(J.EQ.NN)P5=P4
246 | A(II+1)=PAI1*(RO(I0,J)*AK10-RO(I,J)*AK20)
247 | A(II+2)=DX3*D1+PAI1*(RO(I0,J)*AK00-RO(I,J)*AK10)
248 | A(II+3)=-DX3*D3+PAI1*(RO(I0,J)*AK10-RO(I,J)*AK00)
249 | A(II+4)=DX3*D2+PAI1*(RO(I0,J)*AK20-RO(I,J)*AK10)
250 | A(II+5)=-DX3*(D1*P1+D2*P2+D4*P4+D5*P5-D3*P3)+DX1*(RO(I,J)*H(I,J)-RO(I0,J)*H(I0,J))
251 | 50 CONTINUE
252 | CALL TRA4(MM,D,A,B)
253 | DO 60 I=2,MM
254 | IF(ID(I).EQ.2)GOTO 60
255 | IF(ID(I).EQ.0)GOTO 52
256 | DD=D(I+1)
257 | IF(I.EQ.MM)DD=0
258 | P(I,J)=P(I,J)+C2*(D(I)-0.25*(D(I-1)+DD))
259 | IF(J0.NE.1)P(I,J0)=P(I,J0)-0.25*C2*D(I)
260 | IF(P(I,J0).LT.0.)P(I,J0)=0.0
261 | IF(J1.GE.NN)GOTO 54
262 | P(I,J1)=P(I,J1)-0.25*C2*D(I)
263 | GOTO 54
264 | 52 P(I,J)=P(I,J)+C1*D(I)
265 | 54 IF(P(I,J).LT.0.0)P(I,J)=0.0
266 | IF(PMAX.LT.P(I,J))PMAX=P(I,J)
267 | 60 CONTINUE
268 | 70 CONTINUE
269 | DO 80 J=1,NN
270 | JJ=N+1-J
271 | DO 80 I=1,N
272 | 80 P(I,JJ)=P(I,J)
273 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
274 | 100 CONTINUE
275 | RETURN
276 | END
277 | SUBROUTINE TRA4(N,D,A,B)
278 | DIMENSION D(N),A(5,N),B(3,N)
279 | C=1./A(3,N)
280 | B(1,N)=-A(1,N)*C
281 | B(2,N)=-A(2,N)*C
282 | B(3,N)=A(5,N)*C
283 | DO 10 I=1,N-2
284 | IN=N-I
285 | IN1=IN+1
286 | C=1./(A(3,IN)+A(4,IN)*B(2,IN1))
287 | B(1,IN)=-A(1,IN)*C
288 | B(2,IN)=-(A(2,IN)+A(4,IN)*B(1,IN1))*C
289 | 10 B(3,IN)=(A(5,IN)-A(4,IN)*B(3,IN1))*C
290 | D(1)=0.0
291 | D(2)=B(3,2)
292 | DO 20 I=3,N
293 | 20 D(I)=B(1,I)*D(I-2)+B(2,I)*D(I-1)+B(3,I)
294 | RETURN
295 | END
296 | SUBROUTINE VI(NW,N,DX,P,V)
297 | DIMENSION P(N,N),V(NW,NW)
298 | COMMON /COMAK/AK(0:65,0:65)
299 | PAI1=0.2026423
300 | DO 40 I=1,N
301 | DO 40 J=1,N
302 | H0=0.0
303 | DO 30 K=1,N
304 | IK=IABS(I-K)
305 | DO 30 L=1,N
306 | JL=IABS(J-L)
307 | 30 H0=H0+AK(IK,JL)*P(K,L)
308 | 40 V(I,J)=H0*DX*PAI1
309 | RETURN
310 | END
311 | SUBROUTINE SUBAK(MM)
312 | COMMON /COMAK/AK(0:65,0:65)
313 | S(X,Y)=X+SQRT(X**2+Y**2)
314 | DO 10 I=0,MM
315 | XP=I+0.5
316 | XM=I-0.5
317 | DO 10 J=0,I
318 | YP=J+0.5
319 | YM=J-0.5
320 | A1=S(YP,XP)/S(YM,XP)
321 | A2=S(XM,YM)/S(XP,YM)
322 | A3=S(YM,XM)/S(YP,XM)
323 | A4=S(XP,YP)/S(XM,YP)
324 | AK(I,J)=XP*ALOG(A1)+YM*ALOG(A2)+XM*ALOG(A3)+YP*ALOG(A4)
325 | 10 AK(J,I)=AK(I,J)
326 | RETURN
327 | END
328 | SUBROUTINE OUTPUT(N,DX,X,Y,H,P)
329 | DIMENSION X(N),Y(N),H(N,N),P(N,N)
330 | NN=(N+1)/2
331 | A=0.0
332 | WRITE(8,110)A,(Y(I),I=1,N)
333 | DO I=1,N
334 | WRITE(8,110)X(I),(H(I,J),J=1,N)
335 | ENDDO
336 | WRITE(10,110)A,(Y(I),I=1,N)
337 | DO I=1,N
338 | WRITE(10,110)X(I),(P(I,J),J=1,N)
339 | ENDDO
340 | 110 FORMAT(66(E12.6,1X))
341 | RETURN
342 | END
--------------------------------------------------------------------------------
/15/GREASELINEEHL.f90:
--------------------------------------------------------------------------------
1 | PROGRAM GREASELINEEHL
2 | CHARACTER*1 S,S1,S2
3 | CHARACTER*16 CDATE,CTIME
4 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW,LMAX,FF/COM2/EDA0/COM4/X0,XE/COM3/E1,PH,B,U1,U2,R
5 | DATA PAI,Z,P0/3.14159265,0.68,1.96E8/S1,S2/1HY,1Hy/
6 | DATA N,X0,XE,W,E1,EDA0,R,Us,CU,C1,FN/129,-4.,1.4,1.E5,2.26E11,0.4,0.012183,0.87,0.67,0.5,1.0/CDATE,CTIME/'The date is','The time is'/
7 | OPEN(8,FILE='OUT.DAT',STATUS='UNKNOWN')
8 | 1 FORMAT(20X,A12,I2.2,':',I2.2,':',I4.4)
9 | 2 FORMAT(20X,A12,I2.2,':',I2.2,':',I2.2,'.',I2.2)
10 | WRITE(*,*)'Show the example or not (Y or N)?'
11 | READ(*,'(A)')S
12 | IF(S.EQ.S1.OR.S.EQ.S2)THEN
13 | GOTO 10
14 | ENDIF
15 | WRITE(*,*)'PH='
16 | READ(*,*)PH
17 | W=2.*PAI*R*PH*(PH/E1)
18 | WRITE(*,*)'W=',W
19 | 10 CW=N+0.1
20 | FF=1./FN
21 | LMAX=ALOG(CW)/ALOG(2.)
22 | N=2**LMAX+1
23 | LMIN=(ALOG(CW)-ALOG(SQRT(CW)))/ALOG(2.)
24 | LMAX=LMIN
25 | W1=W/(E1*R)
26 | PH=E1*SQRT(0.5*W1/PAI)
27 | A1=(ALOG(EDA0)+9.67)
28 | A2=PH/P0
29 | A3=0.59/(PH*1.E-9)
30 | B=4.*R*PH/E1
31 | ALFA=Z*A1/P0
32 | G=ALFA*E1
33 | U=EDA0*US/(2.*E1*R)
34 | C3=1.6*(R/B)**2*G**0.6*U**0.7*W1**(-0.13)
35 | ENDA=B**(2.+FF)*(PH/2/EDA0)**FF/R**(1+FF)/US/(2.+FF)
36 | U1=0.5*(2.+CU)*U
37 | U2=0.5*(2.-CU)*U
38 | WRITE(*,*)'B,PH,G,U=',B,PH,G,U
39 | CW=-1.13*C3
40 | WRITE(*,*)N,X0,XE,W,E1,EDA0,R,US,PH
41 | WRITE(8,*)N,W,E1,EDA0,R,US,B,PH,FF
42 | WRITE(*,40)
43 | 40 FORMAT(2X,'Wait Please',//)
44 | CALL SUBAK(N)
45 | CALL MULTI(N)
46 | STOP
47 | END
48 | SUBROUTINE MULTI(N)
49 | REAL*8 X(1100),P(1100),H(1100),RO(1100),POLD(1100),EPS(1100),EDA(1100),R(1100),K(1100),E(1100)
50 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW,LMAX,FF/COM4/X0,XE/COM3/E1,PH,B,U1,U2,RR
51 | DATA MK,G0/1,1.570796325/
52 | NX=N
53 | DX=(XE-X0)/(N-1.0)
54 | DO 10 I=1,N
55 | X(I)=X0+(I-1)*DX
56 | IF(ABS(X(I)).GE.1.0)P(I)=0.0
57 | IF(ABS(X(I)).LT.1.0)P(I)=SQRT(1.-X(I)*X(I))
58 | 10 CONTINUE
59 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA)
60 | CALL FZ(N,P,POLD)
61 | 14 KK=19
62 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,R)
63 | MK=MK+1
64 | CALL ERROP(N,P,POLD,ERP)
65 | IF(ERP.GT.1.E-4.AND.MK.LE.800)THEN
66 | GOTO 14
67 | ENDIF
68 | WRITE(*,*)PH,RR,B
69 | 105 IF(MK.GE.800)THEN
70 | WRITE(*,*)'Pressures are not convergent !!!'
71 | READ(*,*)
72 | ENDIF
73 | FM=FRICT(N,DX,X,H,P,EDA)
74 | H2=1.E3
75 | P2=0.0
76 | DO 106 I=1,N
77 | IF(H(I).LT.H2)H2=H(I)
78 | IF(P(I).GT.P2)P2=P(I)
79 | 106 CONTINUE
80 | DO 108 I=1,N
81 | K(I)=P(I)*PH/1.E9
82 | E(I)=H(I)*B*B*1.E6/RR
83 | 108 CONTINUE
84 | H3=H2*B*B/RR
85 | P3=P2*PH
86 | 110 FORMAT(6(1X,E12.6))
87 | 120 CONTINUE
88 | WRITE(8,*)'P2,H2,P3,H3=',P2,H2,P3,H3
89 | CALL OUTHP(N,X, K,E)
90 | RETURN
91 | END
92 | SUBROUTINE OUTHP(N,X, K,E)
93 | REAL*8 X(N), K(N),E(N)
94 | DX=X(2)-X(1)
95 | DO 10 I=1,N
96 | WRITE(8,20)X(I),K(I),E(I)
97 | 10 CONTINUE
98 | 20 FORMAT(1X,6(F20.6,1X))
99 | RETURN
100 | END
101 | SUBROUTINE HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA)
102 | REAL*8 X(N),P(N),H(N),RO(N),EPS(N),EDA(2200)
103 | REAL*8 W(2200)
104 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW,K,FF/COM2/EDA0/COMAK/AK(0:1100)
105 | DATA KK,NW,PAI1/0,2200,0.318309886/
106 | IF(KK.NE.0)GOTO 3
107 | HM0=C3
108 | H00=0.0
109 | 3 W1=0.0
110 | DO 4 I=1,N
111 | 4 W1=W1+P(I)
112 | C3=(DX*W1)/G0
113 | DW=1.-C3
114 | CALL DISP(N,NW,K,DX,P,W)
115 | HMIN=1.E3
116 | DO 30 I=1,N
117 | H0=0.5*X(I)*X(I)-PAI1*W(I)
118 | IF(H0.LT.HMIN)HMIN=H0
119 | H(I)=H0
120 | 30 CONTINUE
121 | IF(KK.NE.0)GOTO 32
122 | KK=1
123 | H00=-HMIN+HM0
124 | 32 H0=H00+HMIN
125 | IF(H0.LE.0.0)GOTO 48
126 | IF(H0+0.3*CW*DW.GT.0.0)HM0=H0+0.3*CW*DW
127 | IF(H0+0.3*CW*DW.LE.0.0)HM0=HM0*C3
128 | 48 H00=HM0-HMIN
129 | 50 DO 60 I=1,N
130 | 60 H(I)=H00+H(I)
131 | DO 100 I=1,N
132 | EDA(I)=EXP(A1*(-1.+(1.+A2*P(I))**Z))
133 | RO(I)=1.0
134 | EPS(I)=RO(I)*H(I)**(2+FF)*ENDA/EDA(I)**FF
135 | 100 CONTINUE
136 | RETURN
137 | END
138 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,R)
139 | REAL*8 X(N),P(N),H(N),RO(N),EPS(N),EDA(N),R(N)
140 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C3,CW,LMAX,FF/COMAK/AK(0:1100)
141 | DATA KG1,PAI/0,3.14159265/
142 | IF(KG1.NE.0)GOTO 5
143 | KG1=1
144 | DX1=1./DX
145 | DX2=DX*DX
146 | DX3=1./DX2
147 | DX4=DX1/PAI
148 | DX5=DX1**(1+FF)
149 | DXL=DX*ALOG(DX)
150 | AK0=DX*AK(0)+DXL
151 | AK1=DX*AK(1)+DXL
152 | 5 DO 100 K=1,KK
153 | D2=0.5*(EPS(1)+EPS(2))
154 | D3=0.5*(EPS(2)+EPS(3))
155 | D5=DX1*(RO(2)*H(2)-RO(1)*H(1))
156 | D7=DX4*(RO(2)*AK0-RO(1)*AK1)
157 | PP=0.
158 | DO 70 I=2,N-1
159 | D1=D2
160 | D2=D3
161 | D4=D5
162 | D6=D7
163 | IF(I+2.LE.N)D3=0.5*(EPS(I+1)+EPS(I+2))
164 | D5=DX1*(RO(I+1)*H(I+1)-RO(I)*H(I))
165 | D7=DX4*(RO(I+1)*AK0-RO(I)*AK1)
166 | DD=(D1+D2)*DX3
167 | IF(0.05*DD.LT.ABS(D6))GOTO 10
168 | RI=-DX5*(D2*SIGN(1.0,(P(I+1)-P(I)))*ABS((P(I+1)-P(I)))**(FF)-D1*SIGN(1.0,(P(I)-P(I-1)))*ABS((P(I)-P(I-1)))**(FF))+D4
169 | R(I)=RI
170 | DLDP=-FF*DX5*(D1*ABS((P(I)-P(I-1)))**(FF-1)+D2*ABS((P(I+1)-P(I)))**(FF-1))+D6
171 | RI=RI/DLDP
172 | RI=RI/C1
173 | GOTO 20
174 | 10 RI=-DX5*(D2*SIGN(1.0,(P(I+1)-P(I)))*ABS((P(I+1)-P(I)))**(FF)-D1*SIGN(1.0,(P(I)-PP))*ABS((P(I)-PP))**(FF))+D4
175 | R(I)=RI
176 | DLDP=-FF*DX5*(2*D1*ABS((P(I)-PP))**(FF-1)+D2*ABS((P(I+1)-P(I)))**(FF-1))+2.*D6
177 | RI=RI/DLDP
178 |
179 | IF(I.GT.2.AND.P(I-1)-C1*RI.GT.0)P(I-1)=P(I-1)-C1*RI
180 | 20 PP=P(I)
181 | P(I)=P(I)+C1*RI
182 | IF(P(I).LT.0.0)P(I)=0.0
183 | IF(P(I).LE.0.0)R(I)=0.0
184 | 70 CONTINUE
185 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA)
186 | 100 CONTINUE
187 | RETURN
188 | END
189 | SUBROUTINE DISP(N,NW,KMAX,DX,P1,W)
190 | REAL*8 P1(N),W(NW),P(2200),AK1(0:50),AK2(0:50)
191 | COMMON /COMAK/AK(0:1100)
192 | DATA NMAX,KMIN/2200,1/
193 | N2=N
194 | M=3+2*ALOG(FLOAT(N))
195 | K1=N+KMAX
196 | DO 10 I=1,N
197 | 10 P(K1+I)=P1(I)
198 | DO 20 KK=KMIN,KMAX-1
199 | K=KMAX+KMIN-KK
200 | N1=(N2+1)/2
201 | CALL DOWNP(NMAX,N1,N2,K,P)
202 | 20 N2=N1
203 | DX1=DX*2**(KMAX-KMIN)
204 | CALL WI(NMAX,N1,KMIN,KMAX,DX,DX1,P,W)
205 | DO 30 K=KMIN+1,KMAX
206 | N2=2*N1-1
207 | DX1=DX1/2.
208 | CALL AKCO(M+5,KMAX,K,AK1)
209 | CALL AKIN(M+6,AK1,AK2)
210 | CALL WCOS(NMAX,N1,N2,K,W)
211 | CALL CORR(NMAX,N2,K,M,1,DX1,P,W,AK1)
212 | CALL WINT(NMAX,N2,K,W)
213 | CALL CORR(NMAX,N2,K,M,2,DX1,P,W,AK2)
214 | 30 N1=N2
215 | DO 40 I=1,N
216 | 40 W(I)=W(K1+I)
217 | RETURN
218 | END
219 | SUBROUTINE DOWNP(NMAX,N1,N2,K,P)
220 | REAL*8 P(NMAX)
221 | K1=N1+K-1
222 | K2=N2+K-1
223 | DO 10 I=3,N1-2
224 | I2=2*I+K2
225 | 10 P(K1+I)=(16.*P(I2)+9.*(P(I2-1)+P(I2+1))-(P(I2-3)+P(I2+3)))/32.
226 | P(K1+2)=0.25*(P(K2+3)+P(K2+5))+0.5*P(K2+4)
227 | P(K1+N1-1)=0.25*(P(K2+N2-2)+P(K2+N2))+0.5*P(K2+N2-1)
228 | RETURN
229 | END
230 | SUBROUTINE WCOS(NMAX,N1,N2,K,W)
231 | REAL*8 W(NMAX)
232 | K1=N1+K-1
233 | K2=N2+K
234 | DO 10 I=1,N1
235 | II=2*I-1
236 | 10 W(K2+II)=W(K1+I)
237 | RETURN
238 | END
239 | SUBROUTINE WINT(NMAX,N,K,W)
240 | REAL*8 W(NMAX)
241 | K2=N+K
242 | DO 10 I=4,N-3,2
243 | II=K2+I
244 | 10 W(II)=(9.*(W(II-1)+W(II+1))-(W(II-3)+W(II+3)))/16.
245 | I1=K2+2
246 | I2=K2+N-1
247 | W(I1)=0.5*(W(I1-1)+W(I1+1))
248 | W(I2)=0.5*(W(I2-1)+W(I2+1))
249 | RETURN
250 | END
251 | SUBROUTINE CORR(NMAX,N,K,M,I1,DX,P,W,AK)
252 | REAL*8 P(NMAX),W(NMAX),AK(0:M)
253 | K1=N+K
254 | IF(I1.EQ.2)GOTO 20
255 | DO 10 I=1,N,2
256 | II=K1+I
257 | J1=MAX0(1,I-M)
258 | J2=MIN0(N,I+M)
259 | DO 10 J=J1,J2
260 | IJ=IABS(I-J)
261 | 10 W(II)=W(II)+AK(IJ)*DX*P(K1+J)
262 | RETURN
263 | 20 DO 30 I=2,N,2
264 | II=K1+I
265 | J1=MAX0(1,I-M)
266 | J2=MIN0(N,I+M)
267 | DO 30 J=J1,J2
268 | IJ=IABS(I-J)
269 | 30 W(II)=W(II)+AK(IJ)*DX*P(K1+J)
270 | RETURN
271 | END
272 | SUBROUTINE WI(NMAX,N,KMIN,KMAX,DX,DX1,P,W)
273 | REAL*8 P(NMAX),W(NMAX)
274 | COMMON /COMAK/AK(0:1100)
275 | K1=N+1
276 | K=2**(KMAX-KMIN)
277 | C=ALOG(DX)
278 | DO 10 I=1,N
279 | II=K1+I
280 | W(II)=0.0
281 | DO 10 J=1,N
282 | IJ=K*IABS(I-J)
283 | 10 W(II)=W(II)+(AK(IJ)+C)*DX1*P(K1+J)
284 | RETURN
285 | END
286 | SUBROUTINE AKCO(KA,KMAX,K,AK1)
287 | REAL*8 AK1(0:KA)
288 | COMMON /COMAK/AK(0:1100)
289 | J=2**(KMAX-K)
290 | DO 10 I=0,KA
291 | II=J*I
292 | 10 AK1(I)=AK(II)
293 | RETURN
294 | END
295 | SUBROUTINE AKIN(KA,AK1,AK2)
296 | REAL*8 AK1(KA),AK2(KA)
297 | DO 10 I=4,KA-3
298 | 10 AK2(I)=(9.*(AK1(I-1)+AK1(I+1))-(AK1(I-3)+AK1(I+3)))/16.
299 | AK2(1)=(9.*AK1(2)-AK1(4))/8.
300 | AK2(2)=(9.*(AK1(1)+AK1(3))-(AK1(3)+AK1(5)))/16.
301 | AK2(3)=(9.*(AK1(2)+AK1(4))-(AK1(2)+AK1(6)))/16.
302 | DO 20 I=1,KA
303 | 20 AK2(I)=AK1(I)-AK2(I)
304 | DO 30 I=1,KA-1,2
305 | I1=I+1
306 | AK1(I)=0.0
307 | 30 AK1(I1)=AK2(I1)
308 | RETURN
309 | END
310 | SUBROUTINE SUBAK(MM)
311 | COMMON /COMAK/AK(0:1100)
312 | DO 10 I=0,MM
313 | 10 AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
314 | RETURN
315 | END
316 | FUNCTION FRICT(N,DX,X,H,P,EDA)
317 | REAL*8 X(N),H(N),P(N),EDA(N)
318 | COMMON /COM3/E1,PH,B,U1,U2,R
319 | DATA TAU0,AT/1.98E7,0.078/
320 | OPEN (10,FILE='TAU.DAT')
321 | TP=TAU0/PH
322 | TE=TAU0/E1
323 | A=AT/TAU0
324 | BR=B/R
325 | FRICT=0.0
326 | DO 10 I=1,N
327 | DP=0.0
328 | A=1.0+AT*P(I)/TAU0
329 | IF(I.NE.N)DP=(P(I+1)-P(I))/DX
330 | TAU1=0.5*H(I)*DP*(BR/TP/A)
331 | TAU2=2.*U1*EDA(I)/(H(I)*BR**2*TE*A)
332 | FRICT=FRICT+ABS(TAU1)+TAU2
333 | TAU2=0.05*TAU2
334 | WRITE(10,5)X(I),TAU1,TAU2,P(I),H(I)
335 | 5 FORMAT(5(E12.6,1X))
336 | 10 CONTINUE
337 | FRICT=FRICT*DX*B*TAU0
338 | RETURN
339 | END
340 | SUBROUTINE FZ(N,P,POLD)
341 | REAL*8 P(N),POLD(N)
342 | DO 10 I=1,N
343 | 10 POLD(I)=P(I)
344 | RETURN
345 | END
346 | SUBROUTINE ERROP(N,P,POLD,ERP)
347 | REAL*8 P(N),POLD(N)
348 | SD=0.0
349 | SUM=0.0
350 | DO 10 I=1,N
351 | SD=SD+ABS(P(I)-POLD(I))
352 | POLD(I)=P(I)
353 | 10 SUM=SUM+P(I)
354 | ERP=SD/SUM
355 | RETURN
356 | END
357 |
--------------------------------------------------------------------------------
/16/GREASEPOINTEHL.f90:
--------------------------------------------------------------------------------
1 | PROGRAM GREASEPOINTEHL
2 | DIMENSION THETA(15),EALFA(15),EBETA(15)
3 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
4 | COMMON /COM2/W0,E1,RX,B,PH,US,U1,U2,EDA0
5 | COMMON /COM3/A1,A2,A3,LMIN
6 | DATA PAI,Z,AKC,AD,AD1/3.14159265,0.68,1.0,0.0,0.0/
7 | DATA T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0/303.,0.058,0.14,46.,46.,2000.,470.,470.,890.,7850.,7850.,-1.1,-0.00065/
8 | DATA N,NZ,RX,RY,X0,XE,E1,US,CT,W0/65,5,0.05,0.05,-2.5,1.5,2.21E11,1.5,0.31,39.24/
9 | DATA THETA/10.,20.,30.,35.,40.,45.,50.,55.,60.,65.,70.,75.,80.,85.,90./
10 | DATA EALFA/6.612,3.778,2.731,2.397,2.136,1.926,1.754,1.611,1.486,1.378,1.284,1.202,1.128,1.061,1.0/
11 | DATA EBETA/0.319,0.408,0.493,0.53,0.567,0.604,0.641,0.678,0.717,0.759,0.802,0.846,0.893,0.944,1.0/
12 | DATA KK1,KK2,KK3,KK4/0,0,0,0/
13 | WRITE(*,*)'n<=1 INPUT n=?'
14 | READ(*,*)FN
15 | FN1=1.0/FN
16 | FF=1.0/FN-1.0
17 | WRITE(*,*)"FF=",FF
18 | EK=RX/RY
19 | AA=0.5*(1./RX+1./RY)
20 | BB=0.5*ABS(1./RX-1./RY)
21 | CC=ACOS(BB/AA)*180.0/PAI
22 | EAL=1.0
23 | EBE=1.0
24 | DO I=1,15
25 | IF(CC.LT.THETA(I))THEN
26 | WRITE(*,*)I
27 | EAL=EALFA(I-1)+(CC-THETA(I))*(EALFA(I)-EALFA(I-1))/(THETA(I)-THETA(I-1))
28 | EBE=EBETA(I-1)+(CC-THETA(I))*(EBETA(I)-EBETA(I-1))/(THETA(I)-THETA(I-1))
29 | GOTO 10
30 | ENDIF
31 | ENDDO
32 | 10 EA=EAL*(1.5*W0/AA/E1)**(1./3.0)
33 | EB=EBE*(1.5*W0/AA/E1)**(1./3.0)
34 | PH=1.5*W0/(EA*EB*PAI)
35 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
36 | OPEN(9,FILE='PRESS.DAT',STATUS='UNKNOWN')
37 | OPEN(10,FILE='OUT.DAT',STATUS='UNKNOWN')
38 | WRITE(*,*)"N,X0,XE,PH,E1,EDA0,RX,US"
39 | WRITE(*,*)N,X0,XE,PH,E1,EDA0,RX,US
40 | WRITE(16,*)"N,X0,XE,PH,E1,EDA0,RX,US"
41 | WRITE(16,*)N,X0,XE,PH,E1,EDA0,RX,US
42 | H00=0.0
43 | MM=N-1
44 | LMIN=ALOG(N-1.)/ALOG(2.)-1.99
45 | U=EDA0*(US/2.)**FN/(E1*RX**FN)
46 | WRITE(*,*)"U=",U
47 | U1=0.5*(2.+AKC)*U
48 | U2=0.5*(2.-AKC)*U
49 | A1=ALOG(EDA0)+9.67
50 | A2=5.1E-9*PH
51 | A3=0.59/(PH*1.E-9)
52 | B=PAI*PH*RX/E1
53 | W=2.*PAI*PH/(3.*E1)*(B/RX)**2
54 | ALFA=Z*5.1E-9*A1
55 | G=ALFA*E1
56 | AHM=1.0-EXP(-0.68*1.03)
57 | AHC=1.0-0.61*EXP(-0.73*1.03)
58 | HM0=3.63*(RX/B)**2*G**0.49*U**0.68*W**(-0.073)*AHM
59 | HMC=2.69*(RX/B)**2*G**0.53*U**0.67*W**(-0.067)*AHC
60 | ENDA=2.*U*(3.+FF)*2.0**(1.0+FF)*(E1/PH)**(1.0+FF)*(RX/B)**(3.0+FF)
61 | WRITE(*,*)"ENDA=",ENDA
62 | UTL=EDA0*US*RX/(B*B*2.E7)
63 | W0=2.0*PAI*EA*EB*PH/3.0
64 | T1=PH*B/RX
65 | T2=EDA0*US*RX/(B*B)
66 | WRITE(*,*)' Wait please'
67 | CALL SUBAK(MM)
68 | CALL MULTI(N,NZ,X0,XE,H00)
69 | STOP
70 | END
71 | SUBROUTINE MULTI(N,NZ,X0,XE,H00)
72 | DIMENSION X(65),Y(65),H(4500),RO(4500),EPS(4500),EDA(4500),P(4500),POLD(4500),T(65,65,5)
73 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
74 | DATA MK,KTK,G00/200,1,2.0943951/
75 | G0=G00*EAL*EBE
76 | NX=N
77 | NY=N
78 | NN=(N+1)/2
79 | CALL INITI(N,DX,X0,XE,X,Y,P,POLD)
80 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
81 | M=0
82 | 14 KK=15
83 | CALL ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
84 | CALL ERP(N,ER,P,POLD)
85 | ER=ER/KK
86 | WRITE(*,*)'ER=',ER
87 | M=M+1
88 | IF(M.LT.MK.AND.ER.GT.1.E-4)GOTO 14
89 | CALL OUPT(N,DX,X,Y,H,P,EDA,TMAX)
90 | RETURN
91 | END
92 | SUBROUTINE INITI(N,DX,X0,XE,X,Y,P,POLD)
93 | DIMENSION X(N),Y(N),P(N,N),POLD(N,N)
94 | NN=(N+1)/2
95 | DX=(XE-X0)/(N-1.)
96 | Y0=-0.5*(XE-X0)
97 | DO 5 I=1,N
98 | X(I)=X0+(I-1)*DX
99 | Y(I)=Y0+(I-1)*DX
100 | 5 CONTINUE
101 | DO 10 I=1,N
102 | D=1.-X(I)*X(I)
103 | DO 10 J=1,NN
104 | C=D-Y(J)*Y(J)
105 | IF(C.LE.0.0)P(I,J)=0.0
106 | 10 IF(C.GT.0.0)P(I,J)=SQRT(C)
107 | DO 20 I=1,N
108 | DO 20 J=NN+1,N
109 | JJ=N-J+1
110 | 20 P(I,J)=P(I,JJ)
111 | DO I=1,N
112 | DO J=1,N
113 | POLD(I,J)=P(I,J)
114 | ENDDO
115 | ENDDO
116 | RETURN
117 | END
118 | SUBROUTINE HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
119 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
120 | DIMENSION W(150,150),P0(150,150),ROU(65,65)
121 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
122 | COMMON /COM2/W0,E1,RX,B,PH,US,U1,U2,EDA0
123 | COMMON /COM3/A1,A2,A3,LMIN
124 | DATA KR,NW,PAI,PAI1,DELTA/0,150,3.14159265,0.2026423,0.0/
125 | NN=(N+1)/2
126 | CALL VI(NW,N,DX,P,W)
127 | HMIN=1.E3
128 | DO 30 I=1,N
129 | DO 30 J=1,NN
130 | RAD=X(I)*X(I)+EK*Y(J)*Y(J)
131 | W1=0.5*RAD+DELTA
132 | ZZ=0.5*AD1*AD1+X(I)*ATAN(AD*PAI/180.0)
133 | IF(W1.LE.ZZ)W1=ZZ
134 | H0=W1+W(I,J)
135 | IF(H0.LT.HMIN)HMIN=H0
136 | 30 H(I,J)=H0
137 | IF(KK.EQ.0)THEN
138 | KG1=0
139 | H01=-HMIN+HM0
140 | DH=0.005*HM0
141 | H02=-HMIN
142 | H00=0.5*(H01+H02)
143 | ENDIF
144 | W1=0.0
145 | DO 32 I=1,N
146 | DO 32 J=1,N
147 | 32 W1=W1+P(I,J)
148 | W1=DX*DX*W1/G0
149 | DW=1.-W1
150 | IF(KK.EQ.0)THEN
151 | KK=1
152 | GOTO 50
153 | ENDIF
154 | IF(DW.LT.0.0)THEN
155 | KG1=1
156 | H00=AMIN1(H01,H00+DH)
157 | ENDIF
158 | IF(DW.GT.0.0)THEN
159 | KG2=2
160 | H00=AMAX1(H02,H00-DH)
161 | ENDIF
162 | 50 DO 60 I=1,N
163 | DO 60 J=1,NN
164 | H(I,J)=H00+H(I,J)
165 | IF(P(I,J).LT.0.0)P(I,J)=0.0
166 | EDA1=EXP(A1*(-1.+(1.+A2*P(I,J))**Z))
167 | EDA(I,J)=EDA1
168 | RO(I,J)=1.
169 | EPS(I,J)=ENDA*RO(I,J)*H(I,J)**(2.+FN1)/(EDA(I,J)**FN1)
170 | 60 CONTINUE
171 | DO 70 J=NN+1,N
172 | JJ=N-J+1
173 | DO 70 I=1,N
174 | H(I,J)=H(I,JJ)
175 | RO(I,J)=RO(I,JJ)
176 | EDA(I,J)=EDA(I,JJ)
177 | 70 EPS(I,J)=EPS(I,JJ)
178 | RETURN
179 | END
180 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
181 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
182 | DIMENSION D(70),A(350),B(210),ID(70)
183 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
184 | COMMON /COMAK/AK(0:65,0:65)
185 | DATA KG1,PAI1,C1,C2/0,0.2026423,0.27,0.27/
186 | IF(KG1.NE.0)GOTO 2
187 | KG1=1
188 | AK00=AK(0,0)
189 | AK10=AK(1,0)
190 | AK20=AK(2,0)
191 | BK00=AK00-AK10
192 | BK10=AK10-0.25*(AK00+2.*AK(1,1)+AK(2,0))
193 | BK20=AK20-0.25*(AK10+2.*AK(2,1)+AK(3,0))
194 | 2 NN=(N+1)/2
195 | MM=N-1
196 | DX1=1./DX
197 | DX2=DX*DX
198 | DX3=1./DX2
199 | DO 100 K=1,KK
200 | PMAX=0.0
201 | DO 70 J=2,NN
202 | J0=J-1
203 | J1=J+1
204 | IA=1
205 | 8 MM=N-IA
206 | IF(P(MM,J0).GT.1.E-6)GOTO 20
207 | IF(P(MM,J).GT.1.E-6)GOTO 20
208 | IF(P(MM,J1).GT.1.E-6)GOTO 20
209 | IA=IA+1
210 | IF(IA.LT.N)GOTO 8
211 | GOTO 70
212 | 20 IF(MM.LT.N-1)MM=MM+1
213 | DPDX1=ABS((P(2,J)-P(1,J))*DX1)**(FF)
214 | D2=0.5*(EPS(1,J)+EPS(2,J))*DPDX1
215 | DO 50 I=2,MM
216 | I0=I-1
217 | I1=I+1
218 | II=5*I0
219 | DPDX2=ABS((P(I1,J)-P(I,J))*DX1)**(FF)
220 | DPDY1=ABS((P(I,J)-P(I,J0))*DX1)**(FF)
221 | DPDY2=ABS((P(I,J1)-P(I,J))*DX1)**(FF)
222 | D1=D2
223 | D2=0.5*(EPS(I1,J)+EPS(I,J))*DPDX2
224 | D4=0.5*(EPS(I,J0)+EPS(I,J))*DPDY1
225 | D5=0.5*(EPS(I,J1)+EPS(I,J))*DPDY2
226 | P1=P(I0,J)
227 | P2=P(I1,J)
228 | P3=P(I,J)
229 | P4=P(I,J0)
230 | P5=P(I,J1)
231 | D3=D1+D2+D4+D5
232 | IF(H(I,J).LE.0.0)THEN
233 | ID(I)=0
234 | A(II+1)=0.0
235 | A(II+2)=0.0
236 | A(II+3)=1.0
237 | A(II+4)=0.0
238 | A(II+5)=1.0
239 | A(II-4)=0.0
240 | GOTO 50
241 | ENDIF
242 | ID(I)=1
243 | IF(J.EQ.NN)P5=P4
244 | A(II+1)=PAI1*(RO(I0,J)*AK10-RO(I,J)*AK20)
245 | A(II+2)=DX3*D1+PAI1*(RO(I0,J)*AK00-RO(I,J)*AK10)
246 | A(II+3)=-DX3*D3+PAI1*(RO(I0,J)*AK10-RO(I,J)*AK00)
247 | A(II+4)=DX3*D2+PAI1*(RO(I0,J)*AK20-RO(I,J)*AK10)
248 | A(II+5)=-DX3*(D1*P1+D2*P2+D4*P4+D5*P5-D3*P3)+DX1*(RO(I,J)*H(I,J)-RO(I0,J)*H(I0,J))
249 | 50 CONTINUE
250 | CALL TRA4(MM,D,A,B)
251 | DO 60 I=2,MM
252 | IF(ID(I).EQ.1)P(I,J)=P(I,J)+C1*D(I)
253 | IF(P(I,J).LT.0.0)P(I,J)=0.0
254 | IF(PMAX.LT.P(I,J))PMAX=P(I,J)
255 | 60 CONTINUE
256 | 70 CONTINUE
257 | DO 80 J=1,NN
258 | JJ=N+1-J
259 | DO 80 I=1,N
260 | 80 P(I,JJ)=P(I,J)
261 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
262 | 100 CONTINUE
263 | RETURN
264 | END
265 | SUBROUTINE TRA4(N,D,A,B)
266 | DIMENSION D(N),A(5,N),B(3,N)
267 | C=1./A(3,N)
268 | B(1,N)=-A(1,N)*C
269 | B(2,N)=-A(2,N)*C
270 | B(3,N)=A(5,N)*C
271 | DO 10 I=1,N-2
272 | IN=N-I
273 | IN1=IN+1
274 | C=1./(A(3,IN)+A(4,IN)*B(2,IN1))
275 | B(1,IN)=-A(1,IN)*C
276 | B(2,IN)=-(A(2,IN)+A(4,IN)*B(1,IN1))*C
277 | 10 B(3,IN)=(A(5,IN)-A(4,IN)*B(3,IN1))*C
278 | D(1)=0.0
279 | D(2)=B(3,2)
280 | DO 20 I=3,N
281 | 20 D(I)=B(1,I)*D(I-2)+B(2,I)*D(I-1)+B(3,I)
282 | RETURN
283 | END
284 | SUBROUTINE VI(NW,N,DX,P,V)
285 | DIMENSION P(N,N),V(NW,NW)
286 | COMMON /COMAK/AK(0:65,0:65)
287 | PAI1=0.2026423
288 | DO 40 I=1,N
289 | DO 40 J=1,N
290 | H0=0.0
291 | DO 30 K=1,N
292 | IK=IABS(I-K)
293 | DO 30 L=1,N
294 | JL=IABS(J-L)
295 | 30 H0=H0+AK(IK,JL)*P(K,L)
296 | 40 V(I,J)=H0*DX*PAI1
297 | RETURN
298 | END
299 | SUBROUTINE SUBAK(MM)
300 | COMMON /COMAK/AK(0:65,0:65)
301 | S(X,Y)=X+SQRT(X**2+Y**2)
302 | DO 10 I=0,MM
303 | XP=I+0.5
304 | XM=I-0.5
305 | DO 10 J=0,I
306 | YP=J+0.5
307 | YM=J-0.5
308 | A1=S(YP,XP)/S(YM,XP)
309 | A2=S(XM,YM)/S(XP,YM)
310 | A3=S(YM,XM)/S(YP,XM)
311 | A4=S(XP,YP)/S(XM,YP)
312 | AK(I,J)=XP*ALOG(A1)+YM*ALOG(A2)+XM*ALOG(A3)+YP*ALOG(A4)
313 | 10 AK(J,I)=AK(I,J)
314 | RETURN
315 | END
316 | SUBROUTINE ERP(N,ER,P,POLD)
317 | DIMENSION P(N,N),POLD(N,N)
318 | ER=0.0
319 | SUM=0.0
320 | NN=(N+1)/2
321 | DO 10 I=1,N
322 | DO 10 J=1,NN
323 | ER=ER+ABS(P(I,J)-POLD(I,J))
324 | SUM=SUM+P(I,J)
325 | 10 CONTINUE
326 | ER=ER/SUM
327 | DO I=1,N
328 | DO J=1,N
329 | POLD(I,J)=P(I,J)
330 | ENDDO
331 | ENDDO
332 | RETURN
333 | END
334 | SUBROUTINE OUPT(N,DX,X,Y,H,P,EDA,TMAX)
335 | DIMENSION X(N),Y(N),H(N,N),P(N,N),EDA(N,N)
336 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
337 | COMMON /COM2/W0,E1,RX,B,PH,US,U1,U2,EDA0
338 | A=0.0
339 | WRITE(8,40)A,(Y(I),I=1,N)
340 | DO I=1,N
341 | WRITE(8,40)X(I),(H(I,J),J=1,N)
342 | ENDDO
343 | WRITE(9,40)A,(Y(I),I=1,N)
344 | DO I=1,N
345 | WRITE(9,40)X(I),(P(I,J),J=1,N)
346 | ENDDO
347 | 40 FORMAT(66(E12.6,1X))
348 | HMIN=1.E3
349 | PMAX=0.0
350 | DO J=1,N
351 | DO I=2,N
352 | IF(H(I,J).LT.HMIN)HMIN=H(I,J)
353 | IF(P(I,J).GT.PMAX)PMAX=P(I,J)
354 | ENDDO
355 | ENDDO
356 | HMIN=HMIN*B*B/RX
357 | PMAX=PMAX*PH
358 | WRITE(10,*)'HMIN,PMAX,TMAX',HMIN,PMAX,TMAX
359 | RETURN
360 | END
--------------------------------------------------------------------------------
/17/LINEEHLT.F90:
--------------------------------------------------------------------------------
1 | PROGRAM LINEEHLT
2 | CHARACTER*1 S,S1,S2
3 | CHARACTER*16 FILEO,CDATE,CTIME
4 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3,CW
5 | COMMON /COM2/T0,EDA0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,D0
6 | COMMON /COM3/E1,PH,B,U1,U2,R,CT/COM4/X0,XE/COM5/H2,P2,T2,ROM,HM,FM
7 | DATA PAI,Z,P0/3.14159265,0.68,1.96E8/,KT,S1,S2/0,1HY,1Hy/
8 | DATA N,X0,XE,W,E1,EDA0,R,Us,C1,C2,NZ,CU,CT/129,-4.,1.4,1.768E5,2.21E11,0.03,0.02,1.77,0.37,0.37,5,0.25,0.35/
9 | OPEN(8,FILE='OUT.DAT',STATUS='UNKNOWN')
10 | WRITE(*,*)'Show the example or not (Y or N)?'
11 | READ(*,'(A)')S
12 | IF(S.EQ.S1.OR.S.EQ.S2)THEN
13 | KT=2
14 | GOTO 10
15 | ELSE
16 | WRITE(*,*)' Temperature is considered or not (Y or N) ?'
17 | READ(*,'(A)')S
18 | IF(S.EQ.S1.OR.S.EQ.S2)KT=2
19 | ENDIF
20 | WRITE(*,*)'N,X0,XE,W,E,EDA0,R,US='
21 | READ(*,*)N,X0,XE,W,E1,EDA0,R,US
22 | IF(KT.EQ.2)THEN
23 | WRITE(*,*)'NZ,CU='
24 | READ(*,*)NZ,CU
25 | ENDIF
26 | WRITE(*,*)' Change iteration factors or not (Y or N) ?'
27 | READ(*,'(A)')S
28 | IF(S.EQ.S1.OR.S.EQ.S2)THEN
29 | WRITE(*,*)'C1,C2='
30 | READ(*,*)C1,C2
31 | ENDIF
32 | 10 CW=N+0.1
33 | LMAX=ALOG(CW)/ALOG(2.)
34 | N=2**LMAX+1
35 | LMIN=(ALOG(CW)-ALOG(SQRT(CW)))/ALOG(2.)
36 | LMAX=LMIN
37 | H00=0.0
38 | W1=W/(E1*R)
39 | PH=E1*SQRT(0.5*W1/PAI)
40 | A1=(ALOG(EDA0)+9.67)
41 | A2=PH/P0
42 | A3=0.59/(PH*1.E-9)
43 | T2=0.0
44 | B=4.*R*PH/E1
45 | ALFA=Z*A1/P0
46 | G=ALFA*E1
47 | U=EDA0*US/(2.*E1*R)
48 | CC1=SQRT(2.*U)
49 | AM=2.*PAI*(PH/E1)**2/CC1
50 | AL=G*SQRT(CC1)
51 | CW=(PH/E1)*(B/R)
52 | C3=1.6*(R/B)**2*G**0.6*U**0.7*W1**(-0.13)
53 | ENDA=3.*(PAI/AM)**2/8.
54 | U1=0.5*(2.+CU)*U
55 | U2=0.5*(2.-CU)*U
56 | CW=-1.13*C3
57 | WRITE(*,40)
58 | 40 FORMAT(2X,' Wait Please',//)
59 | CALL SUBAK(N)
60 | CALL MULTI(N,NZ,KT,LMIN,LMAX,H00)
61 | STOP
62 | END
63 | SUBROUTINE MULTI(N,NZ,KT,LMIN,LMAX,H00)
64 | DIMENSION X(1100),P(1100),H(1100),RO(1100),POLD(1100),EPS(1100),EDA(1100),P0(2200),F(1100),F0(2200),R(1100),R0(2200),G(10),T(22000)
65 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3,CW
66 | COMMON /COMK/K/COMT/LT,T1(1100)/COM3/E1,PH,B,U1,U2,RR,CT/COM5/H2,P2,T2,RM,HM,FM
67 | DATA MK,IT,KH,NMAX,PAI,G0/0,0,0,1100,3.14159265,1.570796325/
68 | LT=LMAX
69 | NX=N
70 | K=LMIN
71 | N0=(N-1)/2**(LMIN-1)
72 | CALL KNDX(K,N,N0,N1,NMAX,DX,X)
73 | DO 10 I=1,N
74 | T1(I)=1.0
75 | IF(ABS(X(I)).GE.1.0)P(I)=0.0
76 | 10 IF(ABS(X(I)).LT.1.0)P(I)=SQRT(1.-X(I)*X(I))
77 | 12 CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F,0)
78 | IF(KH.NE.0)GOTO 14
79 | KH=1
80 | GOTO 12
81 | 14 CALL FZ(N,P,POLD)
82 | DO 100 L=LMIN,LMAX
83 | K=L
84 | G(K)=PAI/2.
85 | DO 18 I=1,N
86 | R(I)=0.0
87 | F(I)=0.0
88 | R0(N1+I)=0.0
89 | 18 F0(N1+I)=0.0
90 | 20 KK=2
91 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,0)
92 | KK=1
93 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,1)
94 | G(K-1)=G(K)
95 | DO 24 I=1,N
96 | IF(I.LT.N)G(K-1)=G(K-1)-0.5*DX*(P(I)+P(I+1))
97 | 24 P0(N1+I)=P(I)
98 | N2=N
99 | K=K-1
100 | CALL KNDX(K,N,N0,N1,NMAX,DX,X)
101 | CALL TRANS(N,N2,P,H,RO,EPS,EDA,R)
102 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,2)
103 | DO 26 I=1,N
104 | IF(I.LT.N)G(K)=G(K)+0.5*DX*(P(I)+P(I+1))
105 | 26 F(I)=H(I)
106 | G0=G(K)
107 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F,1)
108 | DO 28 I=1,N
109 | R0(N1+I)=R(I)
110 | 28 F0(N1+I)=F(I)
111 | IF(K.NE.1)GOTO 20
112 | KK=19
113 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,0)
114 | 40 DO 42 I=1,N
115 | 42 P0(N1+I)=P(I)
116 | N2=N1
117 | K=K+1
118 | CALL KNDX(K,N,N0,N1,NMAX,DX,X)
119 | G0=G(K)
120 | DO 50 I=2,N,2
121 | I1=N1+I
122 | I2=N2+I/2
123 | P(I-1)=P0(I2)
124 | P(I)=P0(I1)+0.5*(P0(I2)+P0(I2+1)-P0(I1-1)-P0(I1+1))
125 | 50 IF(P(I).LT.0.0)P(I)=0.
126 | DO 52 I=1,N
127 | R(I)=R0(N1+I)
128 | 52 F(I)=F0(N1+I)
129 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F,0)
130 | KK=1
131 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,0)
132 | IF(K.LT.L)GOTO 40
133 | 100 CONTINUE
134 | MK=MK+1
135 | CALL ERROP(N,P,POLD,ERP)
136 | IF(ERP.GT.0.01*C2.AND.MK.LE.12)GOTO 14
137 | MK=8
138 | IF(KT.NE.2)GOTO 105
139 | CALL THERM(NX,NZ,DX,T,P,H)
140 | CALL ERROM(NX,NZ,T1,T,KT)
141 | IT=IT+1
142 | IF(KT.EQ.2.AND.IT.LT.10)GOTO 14
143 | KT=2
144 | IF(IT.GE.10)THEN
145 | WRITE(*,*)'Temperature is not convergent !!!'
146 | READ(*,*)
147 | ENDIF
148 | 105 IF(MK.GE.10)THEN
149 | WRITE(*,*)'Pressures are not convergent !!!'
150 | READ(*,*)
151 | ENDIF
152 | FM=FRICT(N,DX,H,P,EDA)
153 | DO I=1,N
154 | WRITE(8,110)X(I),P(I),H(I)
155 | H(I)=H(I)*B*B/RR
156 | P(I)=P(I)*PH
157 | ENDDO
158 | 110 FORMAT(1X,6(E12.6,1X))
159 | DO I=2,N-1
160 | IF(P(I).GE.P(I-1).AND.P(I).GE.P(I+1))THEN
161 | HM=H(I)
162 | RM=RO(I)
163 | GOTO 120
164 | ENDIF
165 | ENDDO
166 | 120 DO I=1,N
167 | H(I)=H(I)*1.E6
168 | P(I)=P(I)*1.E-9
169 | ENDDO
170 | IF(KT.EQ.2)THEN
171 | CALL OUPT(NX,NZ,X,T)
172 | ENDIF
173 | RETURN
174 | END
175 | SUBROUTINE HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F0,KG)
176 | DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N),F0(N)
177 | DIMENSION W(2200)
178 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3,CW/COMK/K/COMT/LT,T1(1100)/COM2/T0,EDA0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,D0/COMAK/AK(0:1100)
179 | DATA KK,MK1,MK2,NW,PAI1/0,3,0,2200,0.318309886/
180 | IF(KK.NE.0)GOTO 3
181 | HM0=C3
182 | 3 W1=0.0
183 | DO 4 I=1,N
184 | 4 W1=W1+P(I)
185 | C3=(DX*W1)/G0
186 | DW=1.-C3
187 | IF(K.EQ.1)GOTO 6
188 | CALL VI(N,DX,P,W)
189 | GOTO 10
190 | 6 WX=-PAI1*W1*DX*ALOG(DX)
191 | DO 8 I=1,N
192 | W(I)=WX
193 | DO 8 J=1,N
194 | IJ=IABS(I-J)
195 | 8 W(I)=W(I)-PAI1*AK(IJ)*P(J)*DX
196 | 10 HMIN=1.E3
197 | DO 30 I=1,N
198 | H0=0.5*X(I)*X(I)+W(I)
199 | IF(KG.EQ.1)GOTO 20
200 | IF(H0+F0(I).LT.HMIN)HMIN=H0+F0(I)
201 | H(I)=H0
202 | GOTO 30
203 | 20 F0(I)=F0(I)-H00-H0
204 | 30 CONTINUE
205 | IF(KG.EQ.1)RETURN
206 | H0=H00+HMIN
207 | IF(KK.NE.0)GOTO 32
208 | KK=1
209 | H00=-H0+HM0
210 | 32 IF(H0.LE.0.0)GOTO 48
211 | IF(K.NE.1)GOTO 50
212 | 40 MK=MK+1
213 | IF(MK.LE.MK1)GOTO 50
214 | IF(MK.GE.MK2)MK=0
215 | IF(H0+CW*DW.GT.0.0)HM0=H0+CW*DW
216 | IF(H0+CW*DW.LE.0.0)HM0=HM0*C3
217 | 48 H00=HM0-HMIN
218 | 50 DO 60 I=1,N
219 | 60 H(I)=H00+H(I)+F0(I)
220 | IT=2**(LT-K)
221 | DO 100 I=1,N
222 | II=IT*(I-1)+1
223 | CT1=-0.05*T0*(T1(II)-1.0)
224 | CT2=D0*T0*(T1(II)-1.)
225 | EDA(I)=EXP(CT1)*EXP(A1*(-1.+(1.+A2*P(I))**Z))
226 | RO(I)=(A3+1.34*P(I))/(A3+P(I))+CT2
227 | EPS(I)=RO(I)*H(I)**3/(ENDA*EDA(I))
228 | 100 CONTINUE
229 | RETURN
230 | END
231 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F0,R0,KG)
232 | DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N),F0(N),R0(N)
233 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3/COMAK/AK(0:1100)
234 | DATA PAI/3.14159265/
235 | DX1=1./DX
236 | DX2=DX*DX
237 | DX3=1./DX2
238 | DX4=DX1/PAI
239 | DXL=DX*ALOG(DX)
240 | AK0=DX*AK(0)+DXL
241 | AK1=DX*AK(1)+DXL
242 | DO 100 K=1,KK
243 | RMAX=0.0
244 | D2=0.5*(EPS(1)+EPS(2))
245 | D3=0.5*(EPS(2)+EPS(3))
246 | D5=DX1*(RO(2)*H(2)-RO(1)*H(1))
247 | D7=DX4*(RO(2)*AK0-RO(1)*AK1)
248 | PP=0.
249 | DO 70 I=2,N-1
250 | D1=D2
251 | D2=D3
252 | D4=D5
253 | D6=D7
254 | IF(I+2.LE.N)D3=0.5*(EPS(I+1)+EPS(I+2))
255 | D5=DX1*(RO(I+1)*H(I+1)-RO(I)*H(I))
256 | D7=DX4*(RO(I+1)*AK0-RO(I)*AK1)
257 | IF(KG.NE.0)GOTO 30
258 | DD=(D1+D2)*DX3
259 | IF(DD.LT.0.1*ABS(D6))GOTO 10
260 | RI=-DX3*(D1*P(I-1)-(D1+D2)*P(I)+D2*P(I+1))+D4+R0(I)
261 | DLDP=-DX3*(D1+D2)+D6
262 | RI=C1*RI/DLDP
263 | GOTO 20
264 | 10 RI=-DX3*(D1*PP-(D1+D2)*P(I)+D2*P(I+1))+D4+R0(I)
265 | DLDP=-DX3*(2.*D1+D2)+2.*D6
266 | RI=C2*RI/DLDP
267 | IF(I.GT.2.AND.P(I-1)-RI.GT.0.0)P(I-1)=P(I-1)-RI
268 | 20 PP=P(I)
269 | P(I)=P(I)+RI
270 | IF(P(I).LT.0.0)P(I)=0.0
271 | IF(K.NE.KK)GOTO 70
272 | IF(RMAX.LT.ABS(RI).AND.P(I).GT.0.0)RMAX=ABS(RI)
273 | GOTO 70
274 | 30 IF(KG.EQ.2)GOTO 40
275 | R0(I)=-DX3*(D1*P(I-1)-(D1+D2)*P(I)+D2*P(I+1))+D4+R0(I)
276 | GOTO 70
277 | 40 R0(I)=DX3*(D1*P(I-1)-(D1+D2)*P(I)+D2*P(I+1))-D4+R0(I)
278 | 70 CONTINUE
279 | IF(KG.NE.0)GOTO 100
280 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F0,0)
281 | 100 CONTINUE
282 | RETURN
283 | END
284 | SUBROUTINE VI(N,DX,P,V)
285 | DIMENSION P(N),V(N)
286 | COMMON /COMAK/AK(0:1100)
287 | PAI1=0.318309886
288 | C=ALOG(DX)
289 | DO 10 I=1,N
290 | V(I)=0.0
291 | DO 10 J=1,N
292 | IJ=IABS(I-J)
293 | 10 V(I)=V(I)+(AK(IJ)+C)*DX*P(J)
294 | DO I=1,N
295 | V(I)=-PAI1*V(I)
296 | ENDDO
297 | RETURN
298 | END
299 | SUBROUTINE SUBAK(MM)
300 | COMMON /COMAK/AK(0:1100)
301 | DO 10 I=0,MM
302 | 10 AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
303 | RETURN
304 | END
305 | FUNCTION FRICT(N,DX,H,P,EDA)
306 | DIMENSION H(N),P(N),EDA(N)
307 | COMMON /COM3/E1,PH,B,U1,U2,R,CT
308 | DATA TAU0/4.E7/
309 | TP=TAU0/PH
310 | TE=TAU0/E1
311 | BR=B/R
312 | FRICT=0.0
313 | DO I=1,N
314 | DP=0.0
315 | IF(I.NE.N)DP=(P(I+1)-P(I))/DX
316 | TAU=0.5*H(I)*ABS(DP)*(BR/TP)+2.*ABS(U1-U2)*EDA(I)/(H(I)*BR**2*TE)
317 | FRICT=FRICT+TAU
318 | ENDDO
319 | FRICT=FRICT*DX*B*TAU0
320 | RETURN
321 | END
322 | SUBROUTINE FZ(N,P,POLD)
323 | DIMENSION P(N),POLD(N)
324 | DO 10 I=1,N
325 | 10 POLD(I)=P(I)
326 | RETURN
327 | END
328 | SUBROUTINE ERROP(N,P,POLD,ERP)
329 | DIMENSION P(N),POLD(N)
330 | SD=0.0
331 | SUM=0.0
332 | DO 10 I=1,N
333 | SD=SD+ABS(P(I)-POLD(I))
334 | 10 SUM=SUM+P(I)
335 | ERP=SD/SUM
336 | RETURN
337 | END
338 | SUBROUTINE KNDX(K,N,N0,N1,NMAX,DX,X)
339 | DIMENSION X(NMAX)
340 | COMMON /COM4/X0,XE
341 | N=2**(K-1)*N0
342 | DX=(XE-X0)/N
343 | N=N+1
344 | N1=N+K
345 | DO 10 I=1,N
346 | 10 X(I)=X0+(I-1)*DX
347 | RETURN
348 | END
349 | SUBROUTINE TRANS(N1,N2,P,H,RO,EPS,EDA,R)
350 | DIMENSION P(N2),H(N2),RO(N2),EPS(N2),EDA(N2),R(N2)
351 | DO 10 I=1,N1
352 | II=2*I-1
353 | P(I)=P(II)
354 | H(I)=H(II)
355 | R(I)=R(II)
356 | RO(I)=RO(II)
357 | EPS(I)=EPS(II)
358 | 10 EDA(I)=EDA(II)
359 | RETURN
360 | END
361 | SUBROUTINE OUPT(NX,NZ,X,T)
362 | DIMENSION X(NX),T(NX,NZ)
363 | DO I=1,NX
364 | DO K=1,NZ
365 | T(I,K)=303.*(T(I,K)-1.0)
366 | END DO
367 | END DO
368 | DO I=1,NX
369 | WRITE(8,30)X(I),(T(I,K),K=1,NZ)
370 | ENDDO
371 | 30 FORMAT(6(1X,E12.6))
372 | RETURN
373 | END
374 | SUBROUTINE ERROM(NX,NZ,T1,T,KT)
375 | DIMENSION T(NX,NZ),T1(NX)
376 | KT=2
377 | ERM=0.
378 | C1=1./FLOAT(NZ)
379 | DO 20 I=1,NX
380 | TT=0.
381 | DO 10 K=1,NZ
382 | 10 TT=TT+T(I,K)
383 | TT=C1*TT
384 | ER=ABS((TT-T1(I))/TT)
385 | IF(ER.GT.ERM)ERM=ER
386 | 20 T1(I)=TT
387 | IF(ERM.LT.0.003)KT=1
388 | RETURN
389 | END
390 | SUBROUTINE THERM(NX,NZ,DX,T,P,H)
391 | DIMENSION T(NX,NZ),P(NX),H(NX),T1(21),TI(21),TF(21),U(21),DU(21),W(21),EDA(21),RO(21),EDA1(21),EDA2(21),ROR(21),UU(21)
392 | DATA KK/0/
393 | IF(KK.NE.0)GOTO 4
394 | DO 2 K=1,NZ
395 | 2 T(1,K)=1.0
396 | 4 DO 30 I=2,NX
397 | KG=0
398 | DO 8 K=1,NZ
399 | TF(K)=T(I-1,K)
400 | IF(KK.NE.0)GOTO 6
401 | T1(K)=T(I-1,K)
402 | GOTO 8
403 | 6 T1(K)=T(I,K)
404 | 8 TI(K)=T1(K)
405 | P1=P(I)
406 | H1=H(I)
407 | DP=(P(I)-P(I-1))/DX
408 | CALL TBOUD(NX,NZ,I,CC1,CC2,T)
409 | 10 CALL EROEQ(NZ,T1,P1,EDA,RO,EDA1,EDA2,KG)
410 | CALL UCAL(NZ,DX,H1,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,W,DP)
411 | CALL TCAL(NZ,DX,CC1,CC2,T1,TF,U,W,DU,H1,DP,EDA,RO)
412 | CALL ERRO(NZ,TI,T1,ETS)
413 | KG=KG+3
414 | IF(ETS.GT.1.E-4.AND.KG.LE.50)GOTO 10
415 | DO 20 K=1,NZ
416 | ROR(K)=RO(K)
417 | UU(K)=U(K)
418 | 20 T(I,K)=T1(K)
419 | 30 CONTINUE
420 | KK=1
421 | RETURN
422 | END
423 | SUBROUTINE TBOUD(NX,NZ,I,CC1,CC2,T)
424 | DIMENSION T(NX,NZ)
425 | CC1=0.
426 | CC2=0.
427 | DO 10 L=1,I-1
428 | DS=1./SQRT(FLOAT(I-L))
429 | IF(L.EQ.I-1)DS=1.1666667
430 | CC1=CC1+DS*(T(L,2)-T(L,1))
431 | 10 CC2=CC2+DS*(T(L,NZ)-T(L,NZ-1))
432 | RETURN
433 | END
434 | SUBROUTINE ERRO(NZ,T0,T,ETS)
435 | DIMENSION T0(NZ),T(NZ)
436 | ETS=0.0
437 | DO 10 K=1,NZ
438 | IF(T(K).LT.1.E-5)ETS0=1.
439 | IF(T(K).GE.1.E-5)ETS0=ABS((T(K)-T0(K))/T(K))
440 | IF(ETS0.GT.ETS)ETS=ETS0
441 | 10 T0(K)=T(K)
442 | RETURN
443 | END
444 | SUBROUTINE EROEQ(NZ,T,P,EDA,RO,EDA1,EDA2,KG)
445 | DIMENSION T(NZ),EDA(NZ),RO(NZ),EDA1(NZ),EDA2(NZ)
446 | COMMON /COM1/ENDA,A1,A2,A3,Z,O1,O2,O3/COM2/T0,EDA0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,D0/COM3/E1,PH,B,U1,U2,R,CC
447 | DATA A4,A5/0.455445545,0.544554455/
448 | IF(KG.NE.0)GOTO 20
449 | B1=(1.+A2*P)**Z
450 | B2=(A3+1.34*P)/(A3+P)
451 | B3=-0.05*T0
452 | 20 DO 30 K=1,NZ
453 | EDA(K)=EXP(A1*(-1.+B1))*EXP(B3*(T(K)-1.0))
454 | 30 RO(K)=B2+D0*T0*(T(K)-1.)
455 | CC1=0.5/(NZ-1.)
456 | CC2=1./(NZ-1.)
457 | C1=0.
458 | C2=0.
459 | DO 40 K=1,NZ
460 | IF(K.EQ.1)GOTO 32
461 | C1=C1+0.5/EDA(K)+0.5/EDA(K-1)
462 | C2=C2+CC1*((K-1.)/EDA(K)+(K-2.)/EDA(K-1))
463 | 32 EDA1(K)=C1*CC2
464 | 40 EDA2(K)=C2*CC2
465 | IF(KG.NE.2)RETURN
466 | C1=0.
467 | C2=0.
468 | C3=0.
469 | DO 50 K=1,NZ
470 | IF(K.EQ.1)GOTO 50
471 | C1=C1+0.5*(RO(K)+RO(K-1))
472 | C2=C2+0.5*(RO(K)*EDA1(K)+RO(K)*EDA1(K-1))
473 | C3=C3+0.5*(RO(K)*EDA2(K)+RO(K)*EDA2(K-1))
474 | 50 CONTINUE
475 | B1=12.*CC2*(C1*EDA2(NZ)/EDA1(NZ)-C2)
476 | 60 B2=2.*CC2/(U1+U2)*(C1*(U1-U2)/EDA1(NZ)+C3*U1)
477 | RETURN
478 | END
479 | SUBROUTINE UCAL(NZ,DX,H,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,W,DP)
480 | DIMENSION U(NZ),DU(NZ),W(NZ),ROR(NZ),UU(NZ),EDA(NZ),RO(NZ),EDA1(NZ),EDA2(NZ)
481 | COMMON /COM2/T0,EDA0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,D0/COM3/E1,PH,B,U1,U2,R,CC
482 | DATA KK/0/
483 | IF(KK.NE.0)GOTO 20
484 | A1=U1
485 | A2=PH*(B/R)**3/E1
486 | A3=U2-U1
487 | 20 CC1=A2*DP*H
488 | CC2=CC1*H
489 | CC3=A3/H
490 | CC4=1./EDA1(NZ)
491 | DO 30 K=1,NZ
492 | U(K)=A1+CC2*(EDA2(K)-CC4*EDA2(NZ)*EDA1(K))+A3*CC4*EDA1(K)
493 | IF(U(K).LT.0.0)U(K)=0.
494 | 30 DU(K)=CC1/EDA(K)*((K-1.)/(NZ-1.)-CC4*EDA2(NZ))+CC3*CC4/EDA(K)
495 | A4=B/((NZ-1)*R*DX)
496 | C1=A4*H
497 | IF(KK.EQ.0)GOTO 50
498 | DO 40 K=2,NZ-1
499 | W(K)=(RO(K-1)*W(K-1)+C1*(RO(K)*U(K)-ROR(K)*UU(K)))/RO(K)
500 | 40 CONTINUE
501 | 50 KK=1
502 | RETURN
503 | END
504 | SUBROUTINE TCAL(NZ,DX,CC1,CC2,T,TF,U,W,DU,H,DP,EDA,RO)
505 | DIMENSION T(NZ),TF(NZ),U(NZ),DU(NZ),W(NZ),EDA(NZ),RO(NZ),A(4,21),D(21),AA(2,21)
506 | COMMON /COM2/T0,EDA0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,D0/COM3/E1,PH,B,U1,U2,R,CC
507 | DATA KK,CC5,PAI,TAU0/0,0.6666667,3.14159265,4.E7/
508 | IF(KK.NE.0)GOTO 5
509 | KK=1
510 | TAU=TAU0*B*B/(E1*R*R)
511 | A2=-CV*RO0*E1*B**3/(EDA0*AK0*R)
512 | A3=-E1*PH*B**3*D0/(AK0*EDA0*T0*R)
513 | A4=-(E1*R)**2/(AK0*EDA0*T0)
514 | A5=0.5*R/B*A2
515 | A6=AK0*SQRT(EDA0*R/(PAI*RO1*CV1*U1*E1*AK1*B**3))
516 | A7=AK0*SQRT(EDA0*R/(PAI*RO2*CV2*U2*E1*AK2*B**3))
517 | 5 CC3=A6*SQRT(DX)
518 | CC4=A7*SQRT(DX)
519 | DZ=H/(NZ-1.)
520 | DZ1=1./DZ
521 | DZ2=DZ1*DZ1
522 | CC6=A3*DP
523 | DO 10 K=2,NZ-1
524 | A(1,K)=DZ2+DZ1*A5*RO(K)*W(K)
525 | A(2,K)=-2.*DZ2+A2*RO(K)*U(K)/DX+CC6*U(K)/RO(K)
526 | A(3,K)=DZ2-DZ1*A5*RO(K)*W(K)
527 | AE=ABS(EDA(K)*DU(K))
528 | 10 A(4,K)=A4*ABS(DU(K))*AE+A2*RO(K)*U(K)*TF(K)/DX
529 | A(1,1)=0.
530 | A(2,1)=1.+2.*DZ1*CC3*CC5
531 | A(3,1)=-2.*DZ1*CC3*CC5
532 | A(1,NZ)=-2.*DZ1*CC4*CC5
533 | A(2,NZ)=1.+2.*DZ1*CC4*CC5
534 | A(3,NZ)=0.
535 | A(4,1)=1.+CC1*CC3*DZ1
536 | A(4,NZ)=1.-CC2*CC4*DZ1
537 | CALL TRA3(NZ,D,A,AA)
538 | DO 20 K=1,NZ
539 | 20 T(K)=(1.-CC)*T(K)+CC*D(K)
540 | 30 CONTINUE
541 | RETURN
542 | END
543 | SUBROUTINE TRA3(N,D,A,B)
544 | DIMENSION D(N),A(4,N),B(2,N)
545 | C=1./A(2,N)
546 | B(1,N)=-A(1,N)*C
547 | B(2,N)=A(4,N)*C
548 | DO 10 I=1,N-1
549 | IN=N-I
550 | IN1=IN+1
551 | C=1./(A(2,IN)+A(3,IN)*B(1,IN1))
552 | B(1,IN)=-A(1,IN)*C
553 | 10 B(2,IN)=(A(4,IN)-A(3,IN)*B(2,IN1))*C
554 | D(1)=B(2,1)
555 | DO 20 I=2,N
556 | 20 D(I)=B(1,I)*D(I-1)+B(2,I)
557 | RETURN
558 | END
559 | BLOCK DATA
560 | COMMON /COM2/T0,EDA0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,D0
561 | DATA T0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,D0/303.,0.14,46.,46.,2000.,470.,470.,890.,7850.,7850.,-0.00065/
562 | END
--------------------------------------------------------------------------------
/20/GREASEPOINTEHLT.F90:
--------------------------------------------------------------------------------
1 | PROGRAM GREASEPOINTEHLT
2 | DIMENSION THETA(15),EALFA(15),EBETA(15)
3 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
4 | COMMON /COM2/W0,E1,RX,B,PH,US,U1,U2,T1,T2,CT
5 | COMMON /COM3/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
6 | COMMON /COM4/A1,A2,A3,LMIN
7 | DATA PAI,Z,AKC,AD,AD1/3.14159265,0.68,1.0,0.0,0.0/
8 | DATA T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0/303.,0.058,0.14,46.,46.,2000.,470.,470.,890.,7850.,7850.,-1.1,-0.00065/
9 | DATA N,NZ,RX,RY,X0,XE,W0,E1,US,CT/65,5,0.05,0.05,-2.5,1.5,39.24,2.21E11,1.5,0.31/
10 | DATA THETA/10.,20.,30.,35.,40.,45.,50.,55.,60.,65.,70.,75.,80.,85.,90./
11 | DATA EALFA/6.612,3.778,2.731,2.397,2.136,1.926,1.754,1.611,1.486,1.378,1.284,1.202,1.128,1.061,1.0/
12 | DATA EBETA/0.319,0.408,0.493,0.53,0.567,0.604,0.641,0.678,0.717,0.759,0.802,0.846,0.893,0.944,1.0/
13 | DATA KK1,KK2,KK3,KK4,EAL,EBE/0,0,0,0,1.0,1.0/
14 | WRITE(*,*)'n<=1 INPUT n=?'
15 | READ(*,*)FN
16 | FN1=1.0/FN
17 | FF=1.0/FN-1.0
18 | WRITE(*,*)"FF=",FF
19 | EK=RX/RY
20 | AA=0.5*(1./RX+1./RY)
21 | BB=0.5*ABS(1./RX-1./RY)
22 | CC=ACOS(BB/AA)*180.0/PAI
23 | DO I=1,15
24 | IF(CC.LT.THETA(I))THEN
25 | WRITE(*,*)I
26 | EAL=EALFA(I-1)+(CC-THETA(I))*(EALFA(I)-EALFA(I-1))/(THETA(I)-THETA(I-1))
27 | EBE=EBETA(I-1)+(CC-THETA(I))*(EBETA(I)-EBETA(I-1))/(THETA(I)-THETA(I-1))
28 | GOTO 10
29 | ENDIF
30 | ENDDO
31 | 10 EA=EAL*(1.5*W0/AA/E1)**(1./3.0)
32 | EB=EBE*(1.5*W0/AA/E1)**(1./3.0)
33 | PH=1.5*W0/(EA*EB*PAI)
34 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
35 | OPEN(9,FILE='PRESS.DAT',STATUS='UNKNOWN')
36 | OPEN(10,FILE='TEM.DAT',STATUS='UNKNOWN')
37 | WRITE(*,*)"N,X0,XE,PH,E1,EDA0,RX,US"
38 | WRITE(*,*)N,X0,XE,PH,E1,EDA0,RX,US
39 | H00=0.0
40 | MM=N-1
41 | LMIN=ALOG(N-1.)/ALOG(2.)-1.99
42 | U=EDA0*(US/2.)**FN/(E1*RX**FN)
43 | U1=0.5*(2.+AKC)*U
44 | U2=0.5*(2.-AKC)*U
45 | A1=ALOG(EDA0)+9.67
46 | A2=5.1E-9*PH
47 | A3=0.59/(PH*1.E-9)
48 | B=PAI*PH*RX/E1
49 | W=2.*PAI*PH/(3.*E1)*(B/RX)**2
50 | ALFA=Z*5.1E-9*A1
51 | G=ALFA*E1
52 | AHM=1.0-EXP(-0.68*1.03)
53 | AHC=1.0-0.61*EXP(-0.73*1.03)
54 | HM0=3.63*(RX/B)**2*G**0.49*U**0.68*W**(-0.073)*AHM
55 | HMC=2.69*(RX/B)**2*G**0.53*U**0.67*W**(-0.067)*AHC
56 | ENDA=2.*U*(3.+FF)*2.0**(1.0+FF)*(E1/PH)**(1.0+FF)*(RX/B)**(3.0+FF)
57 | WRITE(*,*)"ENDA=",ENDA
58 | UTL=EDA0*US*RX/(B*B*2.E7)
59 | W0=2.0*PAI*EA*EB*PH/3.0
60 | T1=PH*B/RX
61 | T2=EDA0*US*RX/(B*B)
62 | WRITE(*,*)' Wait please'
63 | CALL SUBAK(MM)
64 | CALL MULTI(N,NZ,X0,XE,H00)
65 | STOP
66 | END
67 | SUBROUTINE MULTI(N,NZ,X0,XE,H00)
68 | DIMENSION X(65),Y(65),H(4500),RO(4500),EPS(4500),EDA(4500),P(4500),POLD(4500),T(65,65,5)
69 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
70 | COMMON /COMT/TE(65,65)
71 | DATA MK,KTK,G00/200,1,2.0943951/
72 | G0=G00*EAL*EBE
73 | NX=N
74 | NY=N
75 | NN=(N+1)/2
76 | DO I=1,N
77 | DO J=1,N
78 | TE(I,J)=1.0
79 | DO K=1,5
80 | T(I,J,K)=1.0
81 | ENDDO
82 | ENDDO
83 | ENDDO
84 | CALL INITI(N,DX,X0,XE,X,Y,P,POLD)
85 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
86 | M=0
87 | 14 KK=15
88 | CALL ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
89 | CALL ERP(N,ER,P,POLD)
90 | ER=ER/KK
91 | WRITE(*,*)'ER=',ER
92 | CALL THERM(NX,NY,NZ,DX,P,H,T)
93 | CALL ERROM(NX,NY,NZ,T,ERM)
94 | M=M+1
95 | IF(M.LT.MK.AND.ER.GT.1.E-5)GOTO 14
96 | CALL OUPT(N,DX,X,Y,H,P,EDA,TMAX)
97 | RETURN
98 | END
99 | SUBROUTINE INITI(N,DX,X0,XE,X,Y,P,POLD)
100 | DIMENSION X(N),Y(N),P(N,N),POLD(N,N)
101 | NN=(N+1)/2
102 | DX=(XE-X0)/(N-1.)
103 | Y0=-0.5*(XE-X0)
104 | DO 5 I=1,N
105 | X(I)=X0+(I-1)*DX
106 | Y(I)=Y0+(I-1)*DX
107 | 5 CONTINUE
108 | DO 10 I=1,N
109 | D=1.-X(I)*X(I)
110 | DO 10 J=1,NN
111 | C=D-Y(J)*Y(J)
112 | IF(C.LE.0.0)P(I,J)=0.0
113 | 10 IF(C.GT.0.0)P(I,J)=SQRT(C)
114 | DO 20 I=1,N
115 | DO 20 J=NN+1,N
116 | JJ=N-J+1
117 | 20 P(I,J)=P(I,JJ)
118 | DO I=1,N
119 | DO J=1,N
120 | POLD(I,J)=P(I,J)
121 | ENDDO
122 | ENDDO
123 | RETURN
124 | END
125 | SUBROUTINE HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
126 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
127 | DIMENSION W(150,150),P0(150,150),ROU(65,65)
128 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
129 | COMMON /COM2/W0,E1,RX,B,PH,US,U1,U2,T1,T2,CT
130 | COMMON /COM3/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
131 | COMMON /COM4/A1,A2,A3,LMIN
132 | COMMON /COMT/TE(65,65)
133 | DATA KR,NW,PAI,PAI1,DELTA/0,150,3.14159265,0.2026423,0.0/
134 | NN=(N+1)/2
135 | CALL VI(NW,N,DX,P,W)
136 | HMIN=1.E3
137 | DO 30 I=1,N
138 | DO 30 J=1,NN
139 | RAD=X(I)*X(I)+EK*Y(J)*Y(J)
140 | W1=0.5*RAD+DELTA
141 | ZZ=0.5*AD1*AD1+X(I)*ATAN(AD*PAI/180.0)
142 | IF(W1.LE.ZZ)W1=ZZ
143 | H0=W1+W(I,J)
144 | IF(H0.LT.HMIN)HMIN=H0
145 | 30 H(I,J)=H0
146 | IF(KK.EQ.0)THEN
147 | KG1=0
148 | H01=-HMIN+HM0
149 | DH=0.005*HM0
150 | H02=-HMIN
151 | H00=0.5*(H01+H02)
152 | ENDIF
153 | W1=0.0
154 | DO 32 I=1,N
155 | DO 32 J=1,N
156 | 32 W1=W1+P(I,J)
157 | W1=DX*DX*W1/G0
158 | DW=1.-W1
159 | IF(KK.EQ.0)THEN
160 | KK=1
161 | GOTO 50
162 | ENDIF
163 | IF(DW.LT.0.0)THEN
164 | KG1=1
165 | H00=AMIN1(H01,H00+DH)
166 | ENDIF
167 | IF(DW.GT.0.0)THEN
168 | KG2=2
169 | H00=AMAX1(H02,H00-DH)
170 | ENDIF
171 | 50 DO 60 I=1,N
172 | DO 60 J=1,NN
173 | H(I,J)=H00+H(I,J)
174 | CT1=((TE(I,J)-0.455445545)/0.544554455)**S0
175 | CT2=D0*T0*(TE(I,J)-1.)
176 | IF(P(I,J).LT.0.0)P(I,J)=0.0
177 | EDA1=EXP(A1*(-1.+(1.+A2*P(I,J))**Z*CT1))
178 | EDA(I,J)=EDA1
179 | RO(I,J)=1.+CT2
180 | EPS(I,J)=ENDA*RO(I,J)*H(I,J)**(2.+FN1)/(EDA(I,J)**FN1)
181 | 60 CONTINUE
182 | DO 70 J=NN+1,N
183 | JJ=N-J+1
184 | DO 70 I=1,N
185 | H(I,J)=H(I,JJ)
186 | RO(I,J)=RO(I,JJ)
187 | EDA(I,J)=EDA(I,JJ)
188 | 70 EPS(I,J)=EPS(I,JJ)
189 | RETURN
190 | END
191 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
192 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
193 | DIMENSION D(70),A(350),B(210),ID(70)
194 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
195 | COMMON /COMAK/AK(0:65,0:65)
196 | DATA KG1,PAI1,C1,C2/0,0.2026423,0.27,0.27/
197 | IF(KG1.NE.0)GOTO 2
198 | KG1=1
199 | AK00=AK(0,0)
200 | AK10=AK(1,0)
201 | AK20=AK(2,0)
202 | BK00=AK00-AK10
203 | BK10=AK10-0.25*(AK00+2.*AK(1,1)+AK(2,0))
204 | BK20=AK20-0.25*(AK10+2.*AK(2,1)+AK(3,0))
205 | 2 NN=(N+1)/2
206 | MM=N-1
207 | DX1=1./DX
208 | DX2=DX*DX
209 | DX3=1./DX2
210 | DO 100 K=1,KK
211 | PMAX=0.0
212 | DO 70 J=2,NN
213 | J0=J-1
214 | J1=J+1
215 | IA=1
216 | 8 MM=N-IA
217 | IF(P(MM,J0).GT.1.E-6)GOTO 20
218 | IF(P(MM,J).GT.1.E-6)GOTO 20
219 | IF(P(MM,J1).GT.1.E-6)GOTO 20
220 | IA=IA+1
221 | IF(IA.LT.N)GOTO 8
222 | GOTO 70
223 | 20 IF(MM.LT.N-1)MM=MM+1
224 | DPDX1=ABS((P(2,J)-P(1,J))*DX1)**(FF)
225 | D2=0.5*(EPS(1,J)+EPS(2,J))*DPDX1
226 | DO 50 I=2,MM
227 | I0=I-1
228 | I1=I+1
229 | II=5*I0
230 | DPDX2=ABS((P(I1,J)-P(I,J))*DX1)**(FF)
231 | DPDY1=ABS((P(I,J)-P(I,J0))*DX1)**(FF)
232 | DPDY2=ABS((P(I,J1)-P(I,J))*DX1)**(FF)
233 | D1=D2
234 | D2=0.5*(EPS(I1,J)+EPS(I,J))*DPDX2
235 | D4=0.5*(EPS(I,J0)+EPS(I,J))*DPDY1
236 | D5=0.5*(EPS(I,J1)+EPS(I,J))*DPDY2
237 | P1=P(I0,J)
238 | P2=P(I1,J)
239 | P3=P(I,J)
240 | P4=P(I,J0)
241 | P5=P(I,J1)
242 | D3=D1+D2+D4+D5
243 | IF(H(I,J).LE.0.0)THEN
244 | ID(I)=0
245 | A(II+1)=0.0
246 | A(II+2)=0.0
247 | A(II+3)=1.0
248 | A(II+4)=0.0
249 | A(II+5)=1.0
250 | A(II-4)=0.0
251 | GOTO 50
252 | ENDIF
253 | ID(I)=1
254 | IF(J.EQ.NN)P5=P4
255 | A(II+1)=PAI1*(RO(I0,J)*AK10-RO(I,J)*AK20)
256 | A(II+2)=DX3*D1+PAI1*(RO(I0,J)*AK00-RO(I,J)*AK10)
257 | A(II+3)=-DX3*D3+PAI1*(RO(I0,J)*AK10-RO(I,J)*AK00)
258 | A(II+4)=DX3*D2+PAI1*(RO(I0,J)*AK20-RO(I,J)*AK10)
259 | A(II+5)=-DX3*(D1*P1+D2*P2+D4*P4+D5*P5-D3*P3)+DX1*(RO(I,J)*H(I,J)-RO(I0,J)*H(I0,J))
260 | 50 CONTINUE
261 | CALL TRA4(MM,D,A,B)
262 | DO 60 I=2,MM
263 | IF(ID(I).EQ.1)P(I,J)=P(I,J)+C1*D(I)
264 | IF(P(I,J).LT.0.0)P(I,J)=0.0
265 | IF(PMAX.LT.P(I,J))PMAX=P(I,J)
266 | 60 CONTINUE
267 | 70 CONTINUE
268 | DO 80 J=1,NN
269 | JJ=N+1-J
270 | DO 80 I=1,N
271 | 80 P(I,JJ)=P(I,J)
272 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
273 | 100 CONTINUE
274 | RETURN
275 | END
276 | SUBROUTINE TRA4(N,D,A,B)
277 | DIMENSION D(N),A(5,N),B(3,N)
278 | C=1./A(3,N)
279 | B(1,N)=-A(1,N)*C
280 | B(2,N)=-A(2,N)*C
281 | B(3,N)=A(5,N)*C
282 | DO 10 I=1,N-2
283 | IN=N-I
284 | IN1=IN+1
285 | C=1./(A(3,IN)+A(4,IN)*B(2,IN1))
286 | B(1,IN)=-A(1,IN)*C
287 | B(2,IN)=-(A(2,IN)+A(4,IN)*B(1,IN1))*C
288 | 10 B(3,IN)=(A(5,IN)-A(4,IN)*B(3,IN1))*C
289 | D(1)=0.0
290 | D(2)=B(3,2)
291 | DO 20 I=3,N
292 | 20 D(I)=B(1,I)*D(I-2)+B(2,I)*D(I-1)+B(3,I)
293 | RETURN
294 | END
295 | SUBROUTINE VI(NW,N,DX,P,V)
296 | DIMENSION P(N,N),V(NW,NW)
297 | COMMON /COMAK/AK(0:65,0:65)
298 | PAI1=0.2026423
299 | DO 40 I=1,N
300 | DO 40 J=1,N
301 | H0=0.0
302 | DO 30 K=1,N
303 | IK=IABS(I-K)
304 | DO 30 L=1,N
305 | JL=IABS(J-L)
306 | 30 H0=H0+AK(IK,JL)*P(K,L)
307 | 40 V(I,J)=H0*DX*PAI1
308 | RETURN
309 | END
310 | SUBROUTINE SUBAK(MM)
311 | COMMON /COMAK/AK(0:65,0:65)
312 | S(X,Y)=X+SQRT(X**2+Y**2)
313 | DO 10 I=0,MM
314 | XP=I+0.5
315 | XM=I-0.5
316 | DO 10 J=0,I
317 | YP=J+0.5
318 | YM=J-0.5
319 | A1=S(YP,XP)/S(YM,XP)
320 | A2=S(XM,YM)/S(XP,YM)
321 | A3=S(YM,XM)/S(YP,XM)
322 | A4=S(XP,YP)/S(XM,YP)
323 | AK(I,J)=XP*ALOG(A1)+YM*ALOG(A2)+XM*ALOG(A3)+YP*ALOG(A4)
324 | 10 AK(J,I)=AK(I,J)
325 | RETURN
326 | END
327 | SUBROUTINE ERP(N,ER,P,POLD)
328 | DIMENSION P(N,N),POLD(N,N)
329 | ER=0.0
330 | SUM=0.0
331 | NN=(N+1)/2
332 | DO 10 I=1,N
333 | DO 10 J=1,NN
334 | ER=ER+ABS(P(I,J)-POLD(I,J))
335 | SUM=SUM+P(I,J)
336 | 10 CONTINUE
337 | ER=ER/SUM
338 | DO I=1,N
339 | DO J=1,N
340 | POLD(I,J)=P(I,J)
341 | ENDDO
342 | ENDDO
343 | RETURN
344 | END
345 | SUBROUTINE ERROM(NX,NY,NZ,T,ERM)
346 | DIMENSION T(NX,NY,NZ)
347 | COMMON /COMT/TE(65,65)
348 | ERM=0.
349 | C1=1./FLOAT(NZ)
350 | DO 20 I=2,NX
351 | DO 20 J=2,NY
352 | TT=0.
353 | DO 10 K=1,NZ
354 | 10 TT=TT+T(I,J,K)
355 | TT=C1*TT
356 | ER=ABS((TT-TE(I,J))/TT)
357 | IF(ER.GT.ERM)ERM=ER
358 | 20 TE(I,J)=TT
359 | RETURN
360 | END
361 | SUBROUTINE OUPT(N,DX,X,Y,H,P,EDA,TMAX)
362 | DIMENSION X(N),Y(N),H(N,N),P(N,N),EDA(N,N)
363 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
364 | COMMON /COM2/W0,E1,RX,B,PH,US,U1,U2,T1,T2,CT
365 | COMMON /COMT/TE(65,65)
366 | A=0.0
367 | WRITE(8,40)A,(Y(I),I=1,N)
368 | DO I=1,N
369 | WRITE(8,40)X(I),(H(I,J),J=1,N)
370 | ENDDO
371 | WRITE(9,40)A,(Y(I),I=1,N)
372 | DO I=1,N
373 | WRITE(9,40)X(I),(P(I,J),J=1,N)
374 | ENDDO
375 | 40 FORMAT(66(E12.6,1X))
376 | WRITE(10,60)A,(Y(I),I=1,N)
377 | TMAX=0.0
378 | DO I=1,N
379 | WRITE(10,60)X(I),(273.0*(TE(I,JJ)-1.),JJ=1,N)
380 | DO J=1,N
381 | IF(TMAX.LT.273.0*(TE(I,J)-1.))TMAX=273.*(TE(I,J)-1.)
382 | ENDDO
383 | ENDDO
384 | 60 FORMAT(66(E12.6,1X))
385 | HMIN=1.E3
386 | PMAX=0.0
387 | DO J=1,N
388 | DO I=2,N
389 | IF(H(I,J).LT.HMIN)HMIN=H(I,J)
390 | IF(P(I,J).GT.PMAX)PMAX=P(I,J)
391 | ENDDO
392 | ENDDO
393 | HMIN=HMIN*B*B/RX
394 | PMAX=PMAX*PH
395 | RETURN
396 | END
397 | SUBROUTINE THERM(NX,NY,NZ,DX,P,H,T)
398 | DIMENSION T(NX,NY,NZ),T1(21),TI(21),U(21),DU(21),UU(21),V(21),DV(21),VV(21),W(21),EDA(21),RO(21),EDA1(21),EDA2(21),ROR(21),P(NX,NX),H(NX,NX),TFX(21),TFY(21)
399 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
400 | IF(KK.NE.0)GOTO 4
401 | DO 2 K=1,NZ
402 | DO 1 J=1,NY
403 | 1 T(1,J,K)=1.0
404 | DO 2 I=1,NX
405 | 2 T(I,1,K)=1.0
406 | 4 DO 30 I=2,NX
407 | DO 30 J=2,NY
408 | KG=0
409 | DO 6 K=1,NZ
410 | TFX(K)=T(I-1,J,K)
411 | TFY(K)=T(I,J-1,K)
412 | IF(KK.NE.0)GOTO 5
413 | T1(K)=T(I-1,J,K)
414 | GOTO 6
415 | 5 T1(K)=T(I,J,K)
416 | 6 TI(K)=T1(K)
417 | P1=P(I,J)
418 | H1=H(I,J)
419 | DPX=(P(I,J)-P(I-1,J))/DX
420 | DPY=(P(I,J)-P(I,J-1))/DX
421 | CALL TBOUD(NX,NY,NZ,I,J,CC1,CC2,T)
422 | 10 CALL EROEQ(NZ,T1,P1,H1,DPX,DPY,EDA,RO,EDA1,EDA2,KG)
423 | CALL UCAL(NZ,DX,H1,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,V,VV,DV,W,DPX,DPY)
424 | CALL TCAL(NZ,DX,CC1,CC2,T1,TFX,TFY,U,V,W,DU,DV,H1,DPX,DPY,EDA,RO)
425 | CALL ERRO(NZ,TI,T1,ETS)
426 | KG=KG+3
427 | IF(ETS.GT.1.E-4.AND.KG.LE.50)GOTO 10
428 | DO 20 K=1,NZ
429 | ROR(K)=RO(K)
430 | UU(K)=U(K)
431 | VV(K)=V(K)
432 | 20 T(I,J,K)=T1(K)
433 | 30 CONTINUE
434 | KK=1
435 | RETURN
436 | END
437 | SUBROUTINE TBOUD(NX,NY,NZ,I,J,CC1,CC2,T)
438 | DIMENSION T(NX,NY,NZ)
439 | CC1=0.
440 | CC2=0.
441 | DO 10 L=1,I-1
442 | DS=1./SQRT(FLOAT(I-L))
443 | IF(L.EQ.I-1)DS=1.1666667
444 | CC1=CC1+DS*(T(L,J,2)-T(L,J,1))
445 | 10 CC2=CC2+DS*(T(L,J,NZ)-T(L,J,NZ-1))
446 | RETURN
447 | END
448 | SUBROUTINE ERRO(NZ,T0,T,ETS)
449 | DIMENSION T0(NZ),T(NZ)
450 | ETS=0.0
451 | DO 10 K=1,NZ
452 | IF(T(K).LT.1.E-5)ETS0=1.
453 | IF(T(K).GE.1.E-5)ETS0=ABS((T(K)-T0(K))/T(K))
454 | IF(ETS0.GT.ETS)ETS=ETS0
455 | 10 T0(K)=T(K)
456 | RETURN
457 | END
458 | SUBROUTINE EROEQ(NZ,T,P,H,DPX,DPY,EDA,RO,EDA1,EDA2,KG)
459 | DIMENSION T(NZ),EDA(NZ),RO(NZ),EDA1(NZ),EDA2(NZ)
460 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
461 | COMMON /COM2/W0,E1,RX,B,PH,US,U1,U2,T1,T2,CT
462 | COMMON /COM3/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
463 | COMMON /COM4/A1,A2,A3,LMIN
464 | DATA A4,A5/0.455445545,0.544554455/
465 | IF(KG.NE.0)GOTO 20
466 | B1=(1.+A2*P)**Z
467 | B2=(A3+1.34*P)/(A3+P)
468 | 20 DO 30 K=1,NZ
469 | EDA3=EXP(A1*(-1.+B1*((T(K)-A4)/A5)**S0))
470 | EDA(K)=EDA3
471 | 30 RO(K)=B2+D0*T0*(T(K)-1.)
472 | CC1=0.5/(NZ-1.)
473 | CC2=1./(NZ-1.)
474 | C1=0.
475 | C2=0.
476 | DO 40 K=1,NZ
477 | IF(K.EQ.1)GOTO 32
478 | C1=C1+0.5/EDA(K)+0.5/EDA(K-1)
479 | C2=C2+CC1*((K-1.)/EDA(K)+(K-2.)/EDA(K-1))
480 | 32 EDA1(K)=C1*CC2
481 | 40 EDA2(K)=C2*CC2
482 | RETURN
483 | END
484 | SUBROUTINE UCAL(NZ,DX,H,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,V,VV,DV,W,DPX,DPY)
485 | DIMENSION U(NZ),UU(NZ),DU(NZ),V(NZ),VV(NZ),DV(NZ),W(NZ),ROR(NZ),EDA(NZ),RO(NZ),EDA1(NZ),EDA2(NZ)
486 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
487 | COMMON /COM2/W0,E1,R,B,PH,US,U1,U2,T1,T2,CC
488 | COMMON /COM3/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
489 | IF(KK.NE.0)GOTO 20
490 | A1=U1
491 | A2=PH*(B/R)**3/E1
492 | A3=U2-U1
493 | 20 CUA=A2*DPX*H
494 | CUB=CUA*H
495 | CVA=A2*DPY*H
496 | CVB=CVA*H
497 | CC3=A3/H
498 | CC4=1./EDA1(NZ)
499 | DO 30 K=1,NZ
500 | U(K)=A1+CUB*(EDA2(K)-CC4*EDA2(NZ)*EDA1(K))+A3*CC4*EDA1(K)
501 | V(K)=CVB*(EDA2(K)-CC4*EDA2(NZ)*EDA1(K))
502 | DU(K)=CUA/EDA(K)*((K-1.)/(NZ-1.)-CC4*EDA2(NZ))+CC3*CC4/EDA(K)
503 | 30 DV(K)=CVA/EDA(K)*((K-1.)/(NZ-1.)-CC4*EDA2(NZ))
504 | A4=B/((NZ-1)*R*DX)
505 | C1=A4*H
506 | IF(KK.EQ.0)GOTO 50
507 | DO 40 K=2,NZ-1
508 | W(K)=(RO(K-1)*W(K-1)+C1*(RO(K)*(U(K)+V(K))-ROR(K)*(UU(K)+VV(K))))/RO(K)
509 | 40 CONTINUE
510 | 50 KK=1
511 | RETURN
512 | END
513 | SUBROUTINE TCAL(NZ,DX,CC1,CC2,T,TFX,TFY,U,V,W,DU,DV,H,DPX,DPY,EDA,RO)
514 | DIMENSION T(NZ),U(NZ),DU(NZ),V(NZ),DV(NZ),W(NZ),EDA(NZ),RO(NZ),A(4,21),D(21),AA(2,21),TFX(NZ),TFY(NZ)
515 | COMMON /COM1/Z,ENDA,AKC,HM0,HMC,EK,EAL,EBE,AD,AD1,KK1,KK2,KK3,KK4,FN,FN1,FF
516 | COMMON /COM2/W0,E1,R,B,PH,US,U1,U2,T1,T2,CC
517 | COMMON /COM3/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
518 | DATA CC5,PAI/0.6666667,3.14159265/
519 | IF(KK.NE.0)GOTO 5
520 | KK=1
521 | A2=-CV*RO0*E1*B**3/(EDA0*AK*R)
522 | A3=-E1*PH*B**3*D0/(AK*EDA0*T0*R)
523 | A4=-(E1*R)**2/(AK*EDA0*T0)
524 | A5=0.5*R/B*A2
525 | A6=AK*SQRT(EDA0*R/(PAI*RO1*CV1*U1*E1*AK1*B**3))
526 | A7=AK*SQRT(EDA0*R/(PAI*RO2*CV2*U2*E1*AK2*B**3))
527 | 5 CC3=A6*SQRT(DX)
528 | CC4=A7*SQRT(DX)
529 | DZ=H/(NZ-1.)
530 | DZ1=1./DZ
531 | DZ2=DZ1*DZ1
532 | CC6=A3*DPX
533 | CC7=A3*DPY
534 | DO 10 K=2,NZ-1
535 | A(1,K)=DZ2+DZ1*A5*RO(K)*W(K)
536 | A(2,K)=-2.*DZ2+A2*RO(K)*(U(K)+V(K))/DX+(CC6*U(K)+CC7*V(K))/RO(K)
537 | A(3,K)=DZ2-DZ1*A5*RO(K)*W(K)
538 | 10 A(4,K)=A4*EDA(K)*(DU(K)**2+DV(K)**2)+A2*RO(K)*(U(K)*TFX(K)+V(K)*TFY(K))/DX
539 | A(1,1)=0.
540 | A(2,1)=1.+2.*DZ1*CC3*CC5
541 | A(3,1)=-2.*DZ1*CC3*CC5
542 | A(1,NZ)=-2.*DZ1*CC4*CC5
543 | A(2,NZ)=1.+2.*DZ1*CC4*CC5
544 | A(3,NZ)=0.
545 | A(4,1)=1.+CC1*CC3*DZ1
546 | A(4,NZ)=1.-CC2*CC4*DZ1
547 | CALL TRA3(NZ,D,A,AA)
548 | DO 20 K=1,NZ
549 | T(K)=(1.-CC)*T(K)+CC*D(K)
550 | 20 IF(T(K).LT.1.)T(K)=1.
551 | 30 CONTINUE
552 | RETURN
553 | END
554 | SUBROUTINE TRA3(N,D,A,B)
555 | DIMENSION D(N),A(4,N),B(2,N)
556 | C=1./A(2,N)
557 | B(1,N)=-A(1,N)*C
558 | B(2,N)=A(4,N)*C
559 | DO 10 I=1,N-1
560 | IN=N-I
561 | IN1=IN+1
562 | C=1./(A(2,IN)+A(3,IN)*B(1,IN1))
563 | B(1,IN)=-A(1,IN)*C
564 | 10 B(2,IN)=(A(4,IN)-A(3,IN)*B(2,IN1))*C
565 | D(1)=B(2,1)
566 | DO 20 I=2,N
567 | 20 D(I)=B(1,I)*D(I-1)+B(2,I)
568 | RETURN
569 | END
--------------------------------------------------------------------------------
/18/POINTEHLT.f90:
--------------------------------------------------------------------------------
1 | PROGRAM POINTEHLT
2 | DIMENSION THETA(15),EALFA(15),EBETA(15)
3 | COMMON /COM1/ENDA,A1,A2,A3,Z,HM0/COM3/E1,PH1,B1,U1,U2,RE,CT/COMK/LMIN,AKC
4 | COMMON /COM2/T0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
5 | COMMON /COMW/W0,T1,T2,RX,B,PH/COMC/KT,NF/COMD/AD,AD1,KK1,KK2,KK3,KK4/COME/US,EDA0/COMH/HMC
6 | COMMON /COMEK/EK,EAL,EBE
7 | DATA PAI,Z/3.14159265,0.68/,N,W0,E1,EDA0,RX,RY,US,X0,XE/65,39.24,2.21E11,0.03,0.01,0.03,1.5,-2.5,1.5/
8 | DATA NZ,CT,AKC/5,0.31,1.0/
9 | DATA THETA/10.,20.,30.,35.,40.,45.,50.,55.,60.,65.,70.,75.,80.,85.,90./
10 | DATA EALFA/6.612,3.778,2.731,2.397,2.136,1.926,1.754,1.611,1.486,1.378,1.284,1.202,1.128,1.061,1.0/
11 | DATA EBETA/0.319,0.408,0.493,0.53,0.567,0.604,0.641,0.678,0.717,0.759,0.802,0.846,0.893,0.944,1.0/
12 | DATA KK1,KK2,KK3,KK4,NF,AD,AD1,EAL,EBE/0,0,0,0,0,0.0,0.0,1.0,1.0/
13 | EK=RX/RY
14 | WRITE(*,*)'KT='
15 | READ(*,*)KT
16 | AA=0.5*(1./RX+1./RY)
17 | BB=0.5*ABS(1./RX-1./RY)
18 | CC=ACOS(BB/AA)*180.0/PAI
19 | DO I=1,15
20 | IF(CC.LT.THETA(I))THEN
21 | WRITE(*,*)I
22 | EAL=EALFA(I-1)+(CC-THETA(I))*(EALFA(I)-EALFA(I-1))/(THETA(I)-THETA(I-1))
23 | EBE=EBETA(I-1)+(CC-THETA(I))*(EBETA(I)-EBETA(I-1))/(THETA(I)-THETA(I-1))
24 | GOTO 1
25 | ENDIF
26 | ENDDO
27 | 1 EA=EAL*(1.5*W0/AA/E1)**(1./3.0)
28 | EB=EBE*(1.5*W0/AA/E1)**(1./3.0)
29 | PH=1.5*W0/(EA*EB*PAI)
30 | OPEN(8,FILE='FILM.DAT',STATUS='UNKNOWN')
31 | OPEN(9,FILE='PRESS.DAT',STATUS='UNKNOWN')
32 | OPEN(10,FILE='OUT.DAT',STATUS='UNKNOWN')
33 | WRITE(*,*)N,X0,XE,PH,E1,EDA0,RX,US
34 | H00=0.0
35 | MM=N-1
36 | LMIN=ALOG(N-1.)/ALOG(2.)-1.99
37 | U=EDA0*US/(2.*E1*RX)
38 | U1=0.5*(2.+AKC)*U
39 | U2=0.5*(2.-AKC)*U
40 | A1=ALOG(EDA0)+9.67
41 | A2=5.1E-9*PH
42 | A3=0.59/(PH*1.E-9)
43 | B=PAI*PH*RX/E1
44 | PH1=PH
45 | B1=B
46 | RE=RX
47 | W=2.*PAI*PH/(3.*E1)*(B/RX)**2
48 | ALFA=Z*5.1E-9*A1
49 | G=ALFA*E1
50 | AHM=1.0-EXP(-0.68*1.03)
51 | AHC=1.0-0.61*EXP(-0.73*1.03)
52 | HM0=3.63*(RX/B)**2*G**0.49*U**0.68*W**(-0.073)*AHM
53 | HMC=2.69*(RX/B)**2*G**0.53*U**0.67*W**(-0.067)*AHC
54 | ENDA=12.*U*(E1/PH)*(RX/B)**3
55 | UTL=EDA0*US*RX/(B*B*2.E7)
56 | W0=2.0*PAI*EA*EB*PH/3.0
57 | T1=PH*B/RX
58 | T2=EDA0*US*RX/(B*B)
59 | WRITE(*,*)' Wait please'
60 | CALL SUBAK(MM)
61 | CALL MULTI(N,NZ,X0,XE,H00)
62 | STOP
63 | END
64 | SUBROUTINE MULTI(N,NZ,X0,XE,H00)
65 | DIMENSION X(65),Y(65),H(4500),RO(4500),EPS(4500),EDA(4500),P(4500),POLD(4500),T(65,65,5)
66 | COMMON /COMT/T1(65,65)/COMC/KT,NF
67 | COMMON /COMEK/EK,EAL,EBE
68 | DATA MK,KTK,G00/200,1,2.0943951/
69 | G0=G00*EAL*EBE
70 | NX=N
71 | NY=N
72 | NN=(N+1)/2
73 | DO I=1,N
74 | DO J=1,N
75 | T1(I,J)=1.0
76 | DO K=1,5
77 | T(I,J,K)=1.0
78 | ENDDO
79 | ENDDO
80 | ENDDO
81 | CALL INITI(N,DX,X0,XE,X,Y,P,POLD)
82 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
83 | M=0
84 | KTK=0
85 | 14 KK=15
86 | 15 CALL ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
87 | M=M+1
88 | CALL ERP(N,ER,P,POLD)
89 | ER=ER/KK
90 | WRITE(*,*)'ER=',ER
91 | IF(KT.NE.0)GOTO 17
92 | IF(M.LT.MK.AND.ER.GT.1.E-7)GOTO 14
93 | GOTO 120
94 | 17 KT1=0
95 | 18 CALL THERM(NX,NY,NZ,DX,P,H,T)
96 | CALL ERROM(NX,NY,NZ,T,ERM)
97 | IF(ER.LT.1.0E-5)GOTO 120
98 | IF(KT1.LT.1)THEN
99 | KT1=KT1+1
100 | GOTO 18
101 | ENDIF
102 | IF(KTK.LT.MK)THEN
103 | KTK=KTK+1
104 | GOTO 14
105 | ENDIF
106 | 120 CONTINUE
107 | OPEN(11,FILE='TEM.DAT',STATUS='UNKNOWN')
108 | WRITE(11,110)X0,(Y(I),I=1,N)
109 | TMAX=0.0
110 | DO I=1,N
111 | WRITE(11,110)X(I),(273.0*(T1(I,JJ)-1.),JJ=1,N)
112 | DO J=1,N
113 | IF(TMAX.LT.273.0*(T1(I,J)-1.))TMAX=273.*(T1(I,J)-1.)
114 | ENDDO
115 | ENDDO
116 | 110 FORMAT(66(E12.6,1X))
117 | 130 CALL OUPT(N,DX,X,Y,H,P,EDA,TMAX)
118 | RETURN
119 | END
120 | SUBROUTINE INITI(N,DX,X0,XE,X,Y,P,POLD)
121 | DIMENSION X(N),Y(N),P(N,N),POLD(N,N)
122 | NN=(N+1)/2
123 | DX=(XE-X0)/(N-1.)
124 | Y0=-0.5*(XE-X0)
125 | DO 5 I=1,N
126 | X(I)=X0+(I-1)*DX
127 | Y(I)=Y0+(I-1)*DX
128 | 5 CONTINUE
129 | DO 10 I=1,N
130 | D=1.-X(I)*X(I)
131 | DO 10 J=1,NN
132 | C=D-Y(J)*Y(J)
133 | IF(C.LE.0.0)P(I,J)=0.0
134 | 10 IF(C.GT.0.0)P(I,J)=SQRT(C)
135 | DO 20 I=1,N
136 | DO 20 J=NN+1,N
137 | JJ=N-J+1
138 | 20 P(I,J)=P(I,JJ)
139 | DO I=1,N
140 | DO J=1,N
141 | POLD(I,J)=P(I,J)
142 | ENDDO
143 | ENDDO
144 | RETURN
145 | END
146 | SUBROUTINE HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
147 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
148 | DIMENSION W(150,150),P0(150,150),ROU(65,65)
149 | COMMON /COM1/ENDA,A1,A2,A3,Z,HM0/COMAK/AK(0:65,0:65)
150 | COMMON /COM2/T0,EAK,EAK1,EAK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
151 | COMMON /COMT/T1(65,65)/COMK/LMIN,AKC/COMD/AD,AD1,KK,KK2,KK3,KK4/COMC/KT,NF
152 | COMMON /COMEK/EK,EAL,EBE
153 | DATA KR,NW,pai,PAI1,delta/0,150,3.14159265,0.2026423,0.0/
154 | NN=(N+1)/2
155 | CALL VI(NW,N,DX,P,W)
156 | HMIN=1.E3
157 | IF(KR.EQ.0)THEN
158 | OPEN(12,FILE='ROUGH2.DAT',STATUS='UNKNOWN')
159 | DO I=1,N
160 | DO J=NN+1,N
161 | ROU(I,J)=ROU(I,N+1-J)
162 | ENDDO
163 | 100 FORMAT(33(1X,F10.6))
164 | ENDDO
165 | CLOSE(12)
166 | KR=1
167 | ENDIF
168 | DO 30 I=1,N
169 | DO 30 J=1,NN
170 | RAD=X(I)*X(I)+EK*Y(J)*Y(J)
171 | W1=0.5*RAD+DELTA
172 | ZZ=0.5*AD1*AD1+X(I)*ATAN(AD*PAI/180.0)
173 | IF(W1.LE.ZZ)W1=ZZ
174 | H0=W1+W(I,J)
175 | IF(H0.LT.HMIN)HMIN=H0
176 | 30 H(I,J)=H0
177 | IF(KK.EQ.0)THEN
178 | KG1=0
179 | H01=-HMIN+HM0
180 | DH=0.005*HM0
181 | H02=-HMIN
182 | H00=0.5*(H01+H02)
183 | ENDIF
184 | W1=0.0
185 | DO 32 I=1,N
186 | DO 32 J=1,N
187 | 32 W1=W1+P(I,J)
188 | W1=DX*DX*W1/G0
189 | DW=1.-W1
190 | IF(KK.EQ.0)THEN
191 | KK=1
192 | GOTO 50
193 | ENDIF
194 | IF(DW.LT.0.0)THEN
195 | KG1=1
196 | H00=AMIN1(H01,H00+DH)
197 | ENDIF
198 | IF(DW.GT.0.0)THEN
199 | KG2=2
200 | H00=AMAX1(H02,H00-DH)
201 | ENDIF
202 | 50 DO 60 I=1,N
203 | DO 60 J=1,NN
204 | H(I,J)=H00+H(I,J)
205 | CT1=((T1(I,J)-0.455445545)/0.544554455)**S0
206 | CT2=D0*T0*(T1(I,J)-1.)
207 | IF(P(I,J).LT.0.0)P(I,J)=0.0
208 | EDA1=EXP(A1*(-1.+(1.+A2*P(I,J))**Z*CT1))
209 | EDA(I,J)=EDA1
210 | IF(NF.EQ.0)GOTO 55
211 | IF(I.NE.1.AND.J.NE.1)THEN
212 | DPDX=(P(I,J)-P(I-1,J))/DX
213 | DPDY=(P(I,J)-P(I,J-1))/DX
214 | EDA(I,J)=EQEDA(DPDX,DPDY,P(I,J),H(I,J),EDA1)
215 | ENDIF
216 | EDA1=EDA(I,J)
217 | 55 RO(I,J)=(A3+1.34*P(I,J))/(A3+P(I,J))+CT2
218 | 60 EPS(I,J)=RO(I,J)*H(I,J)**3/(ENDA*EDA1)
219 | DO 70 J=NN+1,N
220 | JJ=N-J+1
221 | DO 70 I=1,N
222 | H(I,J)=H(I,JJ)
223 | RO(I,J)=RO(I,JJ)
224 | EDA(I,J)=EDA(I,JJ)
225 | 70 EPS(I,J)=EPS(I,JJ)
226 | RETURN
227 | END
228 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
229 | DIMENSION X(N),Y(N),P(N,N),H(N,N),RO(N,N),EPS(N,N),EDA(N,N)
230 | DIMENSION D(70),A(350),B(210),ID(70)
231 | COMMON /COM1/ENDA,A1,A2,A3,Z,C3/COMAK/AK(0:65,0:65)
232 | DATA KG1,PAI1,C1,C2/0,0.2026423,0.31,0.31/
233 | IF(KG1.NE.0)GOTO 2
234 | KG1=1
235 | AK00=AK(0,0)
236 | AK10=AK(1,0)
237 | AK20=AK(2,0)
238 | BK00=AK00-AK10
239 | BK10=AK10-0.25*(AK00+2.*AK(1,1)+AK(2,0))
240 | BK20=AK20-0.25*(AK10+2.*AK(2,1)+AK(3,0))
241 | 2 NN=(N+1)/2
242 | MM=N-1
243 | DX1=1./DX
244 | DX2=DX*DX
245 | DX3=1./DX2
246 | DX4=0.3*DX2
247 | DO 100 K=1,KK
248 | PMAX=0.0
249 | DO 70 J=2,NN
250 | J0=J-1
251 | J1=J+1
252 | JJ=N-J+1
253 | IA=1
254 | 8 MM=N-IA
255 | IF(P(MM,J0).GT.1.E-6)GOTO 20
256 | IF(P(MM,J).GT.1.E-6)GOTO 20
257 | IF(P(MM,J1).GT.1.E-6)GOTO 20
258 | IA=IA+1
259 | IF(IA.LT.N)GOTO 8
260 | GOTO 70
261 | 20 IF(MM.LT.N-1)MM=MM+1
262 | D2=0.5*(EPS(1,J)+EPS(2,J))
263 | DO 50 I=2,MM
264 | I0=I-1
265 | I1=I+1
266 | II=5*I0
267 | D1=D2
268 | D2=0.5*(EPS(I1,J)+EPS(I,J))
269 | D4=0.5*(EPS(I,J0)+EPS(I,J))
270 | D5=0.5*(EPS(I,J1)+EPS(I,J))
271 | P1=P(I0,JJ)
272 | P2=P(I1,JJ)
273 | P3=P(I,JJ)
274 | P4=P(I,JJ+1)
275 | P5=P(I,JJ-1)
276 | D3=D1+D2+D4+D5
277 | IF(J.EQ.NN.AND.ID(I).EQ.1)P(I,J)=P(I,J)-0.5*C2*D(I)
278 | IF(H(I,J).LE.0.0)THEN
279 | ID(I)=2
280 | A(II+1)=0.0
281 | A(II+2)=0.0
282 | A(II+3)=1.0
283 | A(II+4)=0.0
284 | A(II+5)=1.0
285 | A(II-4)=0.0
286 | GOTO 50
287 | ENDIF
288 | IF(D1.GE.DX4)GOTO 30
289 | IF(D2.GE.DX4)GOTO 30
290 | IF(D4.GE.DX4)GOTO 30
291 | IF(D5.GE.DX4)GOTO 30
292 | ID(I)=1
293 | IF(J.EQ.NN)P5=P4
294 | A(II+1)=PAI1*(RO(I0,J)*BK10-RO(I,J)*BK20)
295 | A(II+2)=DX3*(D1+0.25*D3)+PAI1*(RO(I0,J)*BK00-RO(I,J)*BK10)
296 | A(II+3)=-1.25*DX3*D3+PAI1*(RO(I0,J)*BK10-RO(I,J)*BK00)
297 | A(II+4)=DX3*(D2+0.25*D3)+PAI1*(RO(I0,J)*BK20-RO(I,J)*BK10)
298 | A(II+5)=-DX3*(D1*P1+D2*P2+D4*P4+D5*P5-D3*P3)+DX1*(RO(I,J)*H(I,J)-RO(I0,J)*H(I0,J))
299 | GOTO 50
300 | 30 ID(I)=0
301 | P4=P(I,J0)
302 | IF(J.EQ.NN)P5=P4
303 | A(II+1)=PAI1*(RO(I0,J)*AK10-RO(I,J)*AK20)
304 | A(II+2)=DX3*D1+PAI1*(RO(I0,J)*AK00-RO(I,J)*AK10)
305 | A(II+3)=-DX3*D3+PAI1*(RO(I0,J)*AK10-RO(I,J)*AK00)
306 | A(II+4)=DX3*D2+PAI1*(RO(I0,J)*AK20-RO(I,J)*AK10)
307 | A(II+5)=-DX3*(D1*P1+D2*P2+D4*P4+D5*P5-D3*P3)+DX1*(RO(I,J)*H(I,J)-RO(I0,J)*H(I0,J))
308 | 50 CONTINUE
309 | CALL TRA4(MM,D,A,B)
310 | DO 60 I=2,MM
311 | IF(ID(I).EQ.2)GOTO 60
312 | IF(ID(I).EQ.0)GOTO 52
313 | DD=D(I+1)
314 | IF(I.EQ.MM)DD=0
315 | P(I,J)=P(I,J)+C2*(D(I)-0.25*(D(I-1)+DD))
316 | IF(J0.NE.1)P(I,J0)=P(I,J0)-0.25*C2*D(I)
317 | IF(P(I,J0).LT.0.)P(I,J0)=0.0
318 | IF(J1.GE.NN)GOTO 54
319 | P(I,J1)=P(I,J1)-0.25*C2*D(I)
320 | GOTO 54
321 | 52 P(I,J)=P(I,J)+C1*D(I)
322 | 54 IF(P(I,J).LT.0.0)P(I,J)=0.0
323 | IF(PMAX.LT.P(I,J))PMAX=P(I,J)
324 | 60 CONTINUE
325 | 70 CONTINUE
326 | DO 80 J=1,NN
327 | JJ=N+1-J
328 | DO 80 I=1,N
329 | 80 P(I,JJ)=P(I,J)
330 | CALL HREE(N,DX,H00,G0,X,Y,H,RO,EPS,EDA,P)
331 | 100 CONTINUE
332 | RETURN
333 | END
334 | SUBROUTINE TRA4(N,D,A,B)
335 | DIMENSION D(N),A(5,N),B(3,N)
336 | C=1./A(3,N)
337 | B(1,N)=-A(1,N)*C
338 | B(2,N)=-A(2,N)*C
339 | B(3,N)=A(5,N)*C
340 | DO 10 I=1,N-2
341 | IN=N-I
342 | IN1=IN+1
343 | C=1./(A(3,IN)+A(4,IN)*B(2,IN1))
344 | B(1,IN)=-A(1,IN)*C
345 | B(2,IN)=-(A(2,IN)+A(4,IN)*B(1,IN1))*C
346 | 10 B(3,IN)=(A(5,IN)-A(4,IN)*B(3,IN1))*C
347 | D(1)=0.0
348 | D(2)=B(3,2)
349 | DO 20 I=3,N
350 | 20 D(I)=B(1,I)*D(I-2)+B(2,I)*D(I-1)+B(3,I)
351 | RETURN
352 | END
353 | SUBROUTINE ERP(N,ER,P,POLD)
354 | DIMENSION P(N,N),POLD(N,N)
355 | ER=0.0
356 | SUM=0.0
357 | NN=(N+1)/2
358 | DO 10 I=1,N
359 | DO 10 J=1,NN
360 | ER=ER+ABS(P(I,J)-POLD(I,J))
361 | SUM=SUM+P(I,J)
362 | 10 CONTINUE
363 | ER=ER/SUM
364 | DO I=1,N
365 | DO J=1,N
366 | POLD(I,J)=P(I,J)
367 | ENDDO
368 | ENDDO
369 | RETURN
370 | END
371 | SUBROUTINE VI(NW,N,DX,P,V)
372 | DIMENSION P(N,N),V(NW,NW)
373 | COMMON /COMAK/AK(0:65,0:65)
374 | PAI1=0.2026423
375 | DO 40 I=1,N
376 | DO 40 J=1,N
377 | H0=0.0
378 | DO 30 K=1,N
379 | IK=IABS(I-K)
380 | DO 30 L=1,N
381 | JL=IABS(J-L)
382 | 30 H0=H0+AK(IK,JL)*P(K,L)
383 | 40 V(I,J)=H0*DX*PAI1
384 | RETURN
385 | END
386 | SUBROUTINE SUBAK(MM)
387 | COMMON /COMAK/AK(0:65,0:65)
388 | S(X,Y)=X+SQRT(X**2+Y**2)
389 | DO 10 I=0,MM
390 | XP=I+0.5
391 | XM=I-0.5
392 | DO 10 J=0,I
393 | YP=J+0.5
394 | YM=J-0.5
395 | A1=S(YP,XP)/S(YM,XP)
396 | A2=S(XM,YM)/S(XP,YM)
397 | A3=S(YM,XM)/S(YP,XM)
398 | A4=S(XP,YP)/S(XM,YP)
399 | AK(I,J)=XP*ALOG(A1)+YM*ALOG(A2)+XM*ALOG(A3)+YP*ALOG(A4)
400 | 10 AK(J,I)=AK(I,J)
401 | RETURN
402 | END
403 | SUBROUTINE THERM(NX,NY,NZ,DX,P,H,T)
404 | DIMENSION T(NX,NY,NZ),T1(21),TI(21),U(21),DU(21),UU(21),V(21),DV(21),VV(21),W(21),EDA(21),RO(21),EDA1(21),EDA2(21),ROR(21),P(NX,NX),H(NX,NX),TFX(21),TFY(21)
405 | COMMON /COMD/AD,AD1,KK1,KK,KK3,KK4
406 | IF(KK.NE.0)GOTO 4
407 | DO 2 K=1,NZ
408 | DO 1 J=1,NY
409 | 1 T(1,J,K)=1.0
410 | DO 2 I=1,NX
411 | 2 T(I,1,K)=1.0
412 | 4 DO 30 I=2,NX
413 | DO 30 J=2,NY
414 | KG=0
415 | DO 6 K=1,NZ
416 | TFX(K)=T(I-1,J,K)
417 | TFY(K)=T(I,J-1,K)
418 | IF(KK.NE.0)GOTO 5
419 | T1(K)=T(I-1,J,K)
420 | GOTO 6
421 | 5 T1(K)=T(I,J,K)
422 | 6 TI(K)=T1(K)
423 | P1=P(I,J)
424 | H1=H(I,J)
425 | DPX=(P(I,J)-P(I-1,J))/DX
426 | DPY=(P(I,J)-P(I,J-1))/DX
427 | CALL TBOUD(NX,NY,NZ,I,J,CC1,CC2,T)
428 | 10 CALL EROEQ(NZ,T1,P1,H1,DPX,DPY,EDA,RO,EDA1,EDA2,KG)
429 | CALL UCAL(NZ,DX,H1,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,V,VV,DV,W,DPX,DPY)
430 | CALL TCAL(NZ,DX,CC1,CC2,T1,TFX,TFY,U,V,W,DU,DV,H1,DPX,DPY,EDA,RO)
431 | CALL ERRO(NZ,TI,T1,ETS)
432 | KG=KG+3
433 | IF(ETS.GT.1.E-4.AND.KG.LE.50)GOTO 10
434 | DO 20 K=1,NZ
435 | ROR(K)=RO(K)
436 | UU(K)=U(K)
437 | VV(K)=V(K)
438 | 20 T(I,J,K)=T1(K)
439 | 30 CONTINUE
440 | KK=1
441 | RETURN
442 | END
443 | SUBROUTINE TBOUD(NX,NY,NZ,I,J,CC1,CC2,T)
444 | DIMENSION T(NX,NY,NZ)
445 | CC1=0.
446 | CC2=0.
447 | DO 10 L=1,I-1
448 | DS=1./SQRT(FLOAT(I-L))
449 | IF(L.EQ.I-1)DS=1.1666667
450 | CC1=CC1+DS*(T(L,J,2)-T(L,J,1))
451 | 10 CC2=CC2+DS*(T(L,J,NZ)-T(L,J,NZ-1))
452 | RETURN
453 | END
454 | SUBROUTINE ERRO(NZ,T0,T,ETS)
455 | DIMENSION T0(NZ),T(NZ)
456 | ETS=0.0
457 | DO 10 K=1,NZ
458 | IF(T(K).LT.1.E-5)ETS0=1.
459 | IF(T(K).GE.1.E-5)ETS0=ABS((T(K)-T0(K))/T(K))
460 | IF(ETS0.GT.ETS)ETS=ETS0
461 | 10 T0(K)=T(K)
462 | RETURN
463 | END
464 | SUBROUTINE EROEQ(NZ,T,P,H,DPX,DPY,EDA,RO,EDA1,EDA2,KG)
465 | DIMENSION T(NZ),EDA(NZ),RO(NZ),EDA1(NZ),EDA2(NZ)
466 | COMMON /COM1/ENDA,A1,A2,A3,Z,C3/COM2/T0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0/COM3/E1,PH,B,U1,U2,R,CC/COMC/KT,NF
467 | DATA A4,A5/0.455445545,0.544554455/
468 | IF(KG.NE.0)GOTO 20
469 | B1=(1.+A2*P)**Z
470 | B2=(A3+1.34*P)/(A3+P)
471 | 20 DO 30 K=1,NZ
472 | EDA3=EXP(A1*(-1.+B1*((T(K)-A4)/A5)**S0))
473 | EDA(K)=EDA3
474 | IF(NF.NE.0)EDA(K)=EQEDA(DPX,DPY,P,H,EDA3)
475 | 30 RO(K)=B2+D0*T0*(T(K)-1.)
476 | CC1=0.5/(NZ-1.)
477 | CC2=1./(NZ-1.)
478 | C1=0.
479 | C2=0.
480 | DO 40 K=1,NZ
481 | IF(K.EQ.1)GOTO 32
482 | C1=C1+0.5/EDA(K)+0.5/EDA(K-1)
483 | C2=C2+CC1*((K-1.)/EDA(K)+(K-2.)/EDA(K-1))
484 | 32 EDA1(K)=C1*CC2
485 | 40 EDA2(K)=C2*CC2
486 | RETURN
487 | END
488 | SUBROUTINE UCAL(NZ,DX,H,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,V,VV,DV,W,DPX,DPY)
489 | DIMENSION U(NZ),UU(NZ),DU(NZ),V(NZ),VV(NZ),DV(NZ),W(NZ),ROR(NZ),EDA(NZ),RO(NZ),EDA1(NZ),EDA2(NZ)
490 | COMMON /COM2/T0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0/COM3/E1,PH,B,U1,U2,R,CC
491 | COMMON /COMD/AD,AD1,KK1,KK2,KK,KK4
492 | IF(KK.NE.0)GOTO 20
493 | A1=U1
494 | A2=PH*(B/R)**3/E1
495 | A3=U2-U1
496 | 20 CUA=A2*DPX*H
497 | CUB=CUA*H
498 | CVA=A2*DPY*H
499 | CVB=CVA*H
500 | CC3=A3/H
501 | CC4=1./EDA1(NZ)
502 | DO 30 K=1,NZ
503 | U(K)=A1+CUB*(EDA2(K)-CC4*EDA2(NZ)*EDA1(K))+A3*CC4*EDA1(K)
504 | V(K)=CVB*(EDA2(K)-CC4*EDA2(NZ)*EDA1(K))
505 | DU(K)=CUA/EDA(K)*((K-1.)/(NZ-1.)-CC4*EDA2(NZ))+CC3*CC4/EDA(K)
506 | 30 DV(K)=CVA/EDA(K)*((K-1.)/(NZ-1.)-CC4*EDA2(NZ))
507 | A4=B/((NZ-1)*R*DX)
508 | C1=A4*H
509 | IF(KK.EQ.0)GOTO 50
510 | DO 40 K=2,NZ-1
511 | W(K)=(RO(K-1)*W(K-1)+C1*(RO(K)*(U(K)+V(K))-ROR(K)*(UU(K)+VV(K))))/RO(K)
512 | 40 CONTINUE
513 | 50 KK=1
514 | RETURN
515 | END
516 | SUBROUTINE TCAL(NZ,DX,CC1,CC2,T,TFX,TFY,U,V,W,DU,DV,H,DPX,DPY,EDA,RO)
517 | DIMENSION T(NZ),U(NZ),DU(NZ),V(NZ),DV(NZ),W(NZ),EDA(NZ),RO(NZ),A(4,21),D(21),AA(2,21),TFX(NZ),TFY(NZ)
518 | COMMON /COM2/T0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0/COM3/E1,PH,B,U1,U2,R,CC
519 | COMMON /COMD/AD,AD1,KK1,KK2,KK3,KK/COME/US,EDA0
520 | DATA CC5,PAI/0.6666667,3.14159265/
521 | IF(KK.NE.0)GOTO 5
522 | KK=1
523 | A2=-CV*RO0*E1*B**3/(EDA0*AK0*R)
524 | A3=-E1*PH*B**3*D0/(AK0*EDA0*T0*R)
525 | A4=-(E1*R)**2/(AK0*EDA0*T0)
526 | A5=0.5*R/B*A2
527 | A6=AK0*SQRT(EDA0*R/(PAI*RO1*CV1*U1*E1*AK1*B**3))
528 | A7=AK0*SQRT(EDA0*R/(PAI*RO2*CV2*U2*E1*AK2*B**3))
529 | 5 CC3=A6*SQRT(DX)
530 | CC4=A7*SQRT(DX)
531 | DZ=H/(NZ-1.)
532 | DZ1=1./DZ
533 | DZ2=DZ1*DZ1
534 | CC6=A3*DPX
535 | CC7=A3*DPY
536 | DO 10 K=2,NZ-1
537 | A(1,K)=DZ2+DZ1*A5*RO(K)*W(K)
538 | A(2,K)=-2.*DZ2+A2*RO(K)*(U(K)+V(K))/DX+(CC6*U(K)+CC7*V(K))/RO(K)
539 | A(3,K)=DZ2-DZ1*A5*RO(K)*W(K)
540 | 10 A(4,K)=A4*EDA(K)*(DU(K)**2+DV(K)**2)+A2*RO(K)*(U(K)*TFX(K)+V(K)*TFY(K))/DX
541 | A(1,1)=0.
542 | A(2,1)=1.+2.*DZ1*CC3*CC5
543 | A(3,1)=-2.*DZ1*CC3*CC5
544 | A(1,NZ)=-2.*DZ1*CC4*CC5
545 | A(2,NZ)=1.+2.*DZ1*CC4*CC5
546 | A(3,NZ)=0.
547 | A(4,1)=1.+CC1*CC3*DZ1
548 | A(4,NZ)=1.-CC2*CC4*DZ1
549 | CALL TRA3(NZ,D,A,AA)
550 | DO 20 K=1,NZ
551 | T(K)=(1.-CC)*T(K)+CC*D(K)
552 | 20 IF(T(K).LT.1.)T(K)=1.
553 | 30 CONTINUE
554 | RETURN
555 | END
556 | SUBROUTINE TRA3(N,D,A,B)
557 | DIMENSION D(N),A(4,N),B(2,N)
558 | C=1./A(2,N)
559 | B(1,N)=-A(1,N)*C
560 | B(2,N)=A(4,N)*C
561 | DO 10 I=1,N-1
562 | IN=N-I
563 | IN1=IN+1
564 | C=1./(A(2,IN)+A(3,IN)*B(1,IN1))
565 | B(1,IN)=-A(1,IN)*C
566 | 10 B(2,IN)=(A(4,IN)-A(3,IN)*B(2,IN1))*C
567 | D(1)=B(2,1)
568 | DO 20 I=2,N
569 | 20 D(I)=B(1,I)*D(I-1)+B(2,I)
570 | RETURN
571 | END
572 | SUBROUTINE ERROM(NX,NY,NZ,T,ERM)
573 | DIMENSION T(NX,NY,NZ)
574 | COMMON /COMT/T1(65,65)
575 | ERM=0.
576 | C1=1./FLOAT(NZ)
577 | DO 20 I=2,NX
578 | DO 20 J=2,NY
579 | TT=0.
580 | DO 10 K=1,NZ
581 | 10 TT=TT+T(I,J,K)
582 | TT=C1*TT
583 | ER=ABS((TT-T1(I,J))/TT)
584 | IF(ER.GT.ERM)ERM=ER
585 | 20 T1(I,J)=TT
586 | RETURN
587 | END
588 | SUBROUTINE OUPT(N,DX,X,Y,H,P,EDA,TMAX)
589 | DIMENSION X(N),Y(N),H(N,N),P(N,N),EDA(N,N)
590 | COMMON /COM1/ENDA,A1,A2,A3,Z,HM0/COMH/HMC
591 | COMMON /COMW/W0,T1,T2,RX,B,PH/COMK/LMIN,AKC/COMD/AD,AD1,KK1,KK2,KK3,KK4
592 | NN=(N+1)/2
593 | A=0.0
594 | WRITE(8,110)A,(Y(I),I=1,N)
595 | DO I=1,N
596 | WRITE(8,110)X(I),(H(I,J),J=1,N)
597 | ENDDO
598 | WRITE(9,110)A,(Y(I),I=1,N)
599 | DO I=1,N
600 | WRITE(9,110)X(I),(P(I,J),J=1,N)
601 | ENDDO
602 | 110 FORMAT(66(E12.6,1X))
603 | F=0.0
604 | HMIN=H(1,1)
605 | PMAX=0.0
606 | HM=0.0
607 | NCOUN=0
608 | NPA=0
609 | DO I=2,N
610 | DO J=1,N
611 | IF(X(I).LE.0.0.AND.X(I+1).GE.0.0)THEN
612 | IF(Y(J).LE.0.0.AND.Y(I+1).GE.0.0)HC=H(I,J)
613 | ENDIF
614 | DPDX=(P(I,J)-P(I-1,J))/DX
615 | TAU=T1*DPDX*H(I,J)+0.5*AKC*T2*EDA(I,J)/H(I,J)
616 | F=F+TAU
617 | IF(H(I,J).LT.HMIN)HMIN=H(I,J)
618 | IF(P(I,J).GT.PMAX)PMAX=P(I,J)
619 | RAD=SQRT(X(I)*X(I)+Y(J)*Y(J))
620 | IF(RAD.LE.0.5)THEN
621 | NCOUN=NCOUN+1
622 | HM=HM+H(I,J)
623 | ENDIF
624 | IF(P(I,J).GT.1.E-6)THEN
625 | PA=PA+P(I,J)
626 | NPA=NPA+1
627 | ENDIF
628 | ENDDO
629 | ENDDO
630 | PA=PA/FLOAT(NPA)
631 | HM=HM/FLOAT(NCOUN)
632 | F=B*B*F*DX*DX/W0
633 | HMIN=HMIN*B*B/RX
634 | HM=HM*B*B/RX
635 | HC=HC*B*B/RX
636 | PMAX=PMAX*PH
637 | HDM=HM0*B*B/RX
638 | HDC=HMC*B*B/RX
639 | WRITE(10,*)'W0,F,HMIN,HC,HDM,HDC,PMAX,HM,TMAX,PA'
640 | WRITE(10,120)W0,F,HMIN,HC,HDM,HDC,PMAX,HM,TMAX,PA
641 | 120 FORMAT(10(1X,E12.6))
642 | RETURN
643 | END
644 | FUNCTION EQEDA(DPDX,DPDY,P,H,EDA)
645 | COMMON /COME/U0,EDA0/COMW/W0,T1,T2,R,B,PH/COMK/LMIN,AKC
646 | DATA TAU0/2.E7/
647 | DPDX1=DPDX*PH/B
648 | DPDY1=DPDY*PH/B
649 | P1=P*PH
650 | H1=H*B*B/R
651 | EDA1=EDA*EDA0
652 | TAUL=TAU0+0.036*P1
653 | C1=-0.5*EDA1*AKC*U0/H1-0.5*H1*DPDX1
654 | TAU1=DPDX1*H1+C1
655 | TAU2=C1
656 | TAUY=0.5*DPDY1*H1
657 | TAUX=AMAX1(ABS(TAU1),ABS(TAU2))
658 | TAU=SQRT(TAUX**2+TAUY**2)
659 | X=TAUL/TAU
660 | EQEDA=EDA
661 | IF(X.LT.1)THEN
662 | EQEDA=EDA*X
663 | ENDIF
664 | IF(EQEDA.LT.1)EQEDA=1.
665 | RETURN
666 | END
667 | BLOCK DATA
668 | COMMON /COM2/T0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
669 | DATA T0,AK0,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0/303.,0.14,46.,46.,2000.,470.,470.,890.,7850.,7850.,-1.1,-0.00065/
670 | END
671 |
--------------------------------------------------------------------------------
/19/GREASELINETHERMEHL.f90:
--------------------------------------------------------------------------------
1 | PROGRAM GREASELINETHERMEHL
2 | CHARACTER*1 S,S1,S2
3 | CHARACTER*16 FILEO
4 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3,CW
5 | COMMON /COM2/T0,EDA0/COM3/E1,PH,B,U1,U2,R,CT/COM4/X0,XE
6 | COMMON /COM5/H2,P2,T2,ROM,HM,FM/COM6/FF
7 | DATA KT,S1,S2/0,1HY,1Hy/
8 | DATA FILEO/4HDATA/
9 | PAI=3.14159265
10 | Z=0.68
11 | P0=1.96E8
12 | N=129
13 | X0=-4.
14 | XE=1.4
15 | W=1.768E5
16 | E1=2.21E11
17 | R=0.02
18 | Us=1.77
19 | C1=0.37
20 | C2=0.37
21 | NZ=5
22 | CU=0.25
23 | CT=0.35
24 | T2=0.0
25 | FF=0.85
26 | OPEN(8,FILE=FILEO,STATUS='UNKNOWN')
27 | WRITE(*,*)'Show the example or not (Y or N)?'
28 | READ(*,'(A)')S
29 | IF(S.EQ.S1.OR.S.EQ.S2)THEN
30 | KT=2
31 | GOTO 10
32 | ELSE
33 | WRITE(*,*)' Temperature is considered or not (Y or N) ?'
34 | READ(*,'(A)')S
35 | IF(S.EQ.S1.OR.S.EQ.S2)KT=2
36 | ENDIF
37 | WRITE(*,*)'W,US,FF='
38 | READ(*,*)W,US,FF
39 | IF(KT.EQ.2)THEN
40 | WRITE(*,*)'NZ,CU='
41 | READ(*,*)NZ,CU
42 | ENDIF
43 | WRITE(*,*)' Change iteration factors or not (Y or N) ?'
44 | READ(*,'(A)')S
45 | IF(S.EQ.S1.OR.S.EQ.S2)THEN
46 | WRITE(*,*)'C1,C2='
47 | READ(*,*)C1,C2
48 | ENDIF
49 | 10 CW=N+0.1
50 | LMAX=ALOG(CW)/ALOG(2.)
51 | N=2**LMAX+1
52 | LMIN=(ALOG(CW)-ALOG(SQRT(CW)))/ALOG(2.)
53 | LMAX=LMIN
54 | H00=0.0
55 | W1=W/(E1*R)
56 | PH=E1*SQRT(0.5*W1/PAI)
57 | A1=(ALOG(EDA0)+9.67)
58 | A2=PH/P0
59 | A3=0.59/(PH*1.E-9)
60 | T2=0.0
61 | B=4.*R*PH/E1
62 | ALFA=Z*A1/P0
63 | G=ALFA*E1
64 | U=EDA0*US/(2.*E1*R)
65 | CC1=SQRT(2.*U)
66 | AM=2.*PAI*(PH/E1)**2/CC1
67 | AL=G*SQRT(CC1)
68 | CW=(PH/E1)*(B/R)
69 | C3=1.6*(R/B)**2*G**0.6*U**0.7*W1**(-0.13)
70 | ENDA=B**(2.+1/FF)*(PH/2/EDA0)**(1/FF)/R**(1+1/FF)/Us/(2.+1/FF)
71 | ENDA=1./ENDA
72 | U1=0.5*(2.+CU)*U
73 | U2=0.5*(2.-CU)*U
74 | CW=-1.13*C3
75 | WRITE(*,40)
76 | 40 FORMAT(2X,'Wait Please',//)
77 | CALL SUBAK(N)
78 | CALL MULTI(N,NZ,KT,LMIN,LMAX,H00)
79 | H2=H2*1.E-6
80 | P2=P2*1.E6
81 | Q=2.*ROM*HM*US
82 | FM=FM/W
83 | STOP
84 | END
85 | SUBROUTINE MULTI(N,NZ,KT,LMIN,LMAX,H00)
86 | DIMENSION X(1100),P(1100),H(1100),RO(1100),POLD(1100),EPS(1100),EDA(1100),P0(2200),F(1100),F0(2200),R(1100), R0(2200),G(10),T(22000)
87 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3,CW/COM6/FF
88 | COMMON /COMK/K/COMT/LT,T1(1100)/COM3/E1,PH,B,U1,U2,RR,CT
89 | COMMON /COM5/H2,P2,T2,RM,HM,FM
90 | DATA MK,IT,KH,NMAX,PAI,G0/0,0,0,1100,3.14159265,1.570796325/
91 | LT=LMAX
92 | NX=N
93 | K=LMIN
94 | N0=(N-1)/2**(LMIN-1)
95 | CALL KNDX(K,N,N0,N1,NMAX,DX,X)
96 | DO 10 I=1,N
97 | T1(I)=1.0
98 | IF(ABS(X(I)).GE.1.0)P(I)=0.0
99 | 10 IF(ABS(X(I)).LT.1.0)P(I)=SQRT(1.-X(I)*X(I))
100 | 12 CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F,0)
101 | IF(KH.NE.0)GOTO 14
102 | KH=1
103 | GOTO 12
104 | 14 CALL FZ(N,P,POLD)
105 | DO 100 L=LMIN,LMAX
106 | K=L
107 | G(K)=PAI/2.
108 | DO 18 I=1,N
109 | R(I)=0.0
110 | F(I)=0.0
111 | R0(N1+I)=0.0
112 | 18 F0(N1+I)=0.0
113 | 20 KK=2
114 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,0)
115 | KK=1
116 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,1)
117 | G(K-1)=G(K)
118 | DO 24 I=1,N
119 | IF(I.LT.N)G(K-1)=G(K-1)-0.5*DX*(P(I)+P(I+1))
120 | 24 P0(N1+I)=P(I)
121 | N2=N
122 | K=K-1
123 | CALL KNDX(K,N,N0,N1,NMAX,DX,X)
124 | CALL TRANS(N,N2,P,H,RO,EPS,EDA,R)
125 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,2)
126 | DO 26 I=1,N
127 | IF(I.LT.N)G(K)=G(K)+0.5*DX*(P(I)+P(I+1))
128 | 26 F(I)=H(I)
129 | G0=G(K)
130 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F,1)
131 | DO 28 I=1,N
132 | R0(N1+I)=R(I)
133 | 28 F0(N1+I)=F(I)
134 | IF(K.NE.1)GOTO 20
135 | KK=19
136 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,0)
137 | 40 DO 42 I=1,N
138 | 42 P0(N1+I)=P(I)
139 | N2=N1
140 | K=K+1
141 | CALL KNDX(K,N,N0,N1,NMAX,DX,X)
142 | G0=G(K)
143 | DO 50 I=2,N,2
144 | I1=N1+I
145 | I2=N2+I/2
146 | P(I-1)=P0(I2)
147 | P(I)=P0(I1)+0.5*(P0(I2)+P0(I2+1)-P0(I1-1)-P0(I1+1))
148 | 50 IF(P(I).LT.0.0)P(I)=0.
149 | DO 52 I=1,N
150 | R(I)=R0(N1+I)
151 | 52 F(I)=F0(N1+I)
152 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F,0)
153 | KK=1
154 | CALL ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F,R,0)
155 | IF(K.LT.L)GOTO 40
156 | 100 CONTINUE
157 | MK=MK+1
158 | CALL ERROP(N,P,POLD,ERP)
159 | IF(ERP.GT.0.01*C2.AND.MK.LE.12)GOTO 14
160 | MK=8
161 | IF(KT.NE.2)GOTO 105
162 | CALL THERM(NX,NZ,DX,T,P,H)
163 | CALL ERROM(NX,NZ,T1,T,KT)
164 | IT=IT+1
165 | IF(KT.EQ.2.AND.IT.LT.25)GOTO 14
166 | KT=2
167 | IF(IT.GE.25)THEN
168 | WRITE(*,*)'Temperature is not convergent !!!'
169 | READ(*,*)
170 | ENDIF
171 | 105 IF(MK.GE.10)THEN
172 | WRITE(*,*)'Pressures are not convergent !!!'
173 | READ(*,*)
174 | ENDIF
175 | FM=FRICT(N,DX,H,P,EDA)
176 | 110 FORMAT(6(1X,E12.6))
177 | DO I=2,N-1
178 | IF(P(I).GE.P(I-1).AND.P(I).GE.P(I+1))THEN
179 | HM=H(I)*B*B/RR
180 | RM=RO(I)
181 | GOTO 120
182 | ENDIF
183 | ENDDO
184 | 120 H2=1.E5
185 | P2=1.E-10
186 | DO I=1,N
187 | H(I)=H(I)*B*B*1.E6/RR
188 | P(I)=P(I)*PH/1.E6
189 | IF(H(I).LT.H2)H2=H(I)
190 | IF(P(I).GT.P2)P2=P(I)
191 | ENDDO
192 | DO I=1,N
193 | WRITE(8,110)X(I),P(I),H(I)
194 | ENDDO
195 | IF(KT.EQ.2)THEN
196 | CALL OUPT(NX,NZ,X,T,T2)
197 | ENDIF
198 | RETURN
199 | END
200 | SUBROUTINE HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F0,KG)
201 | DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N),F0(N)
202 | DIMENSION W(2200)
203 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3,CW/COMK/K/COMT/LT,T1(1100)
204 | COMMON /COM2/T0,EDA0,AK0,AK1,AK2,CV,CV1,CV2, RO0,RO1,RO2,S0,D0/COMAK/AK(0:1100)/COM6/FF
205 | DATA KK,MK1,MK2,NW,PAI1/0,3,0,2200,0.318309886/
206 | IF(KK.NE.0)GOTO 3
207 | HM0=C3
208 | 3 W1=0.0
209 | DO 4 I=1,N
210 | 4 W1=W1+P(I)
211 | C3=(DX*W1)/G0
212 | DW=1.-C3
213 | IF(K.EQ.1)GOTO 6
214 | CALL DISP(N,NW,K,DX,P,W)
215 | GOTO 10
216 | 6 WX=W1*DX*ALOG(DX)
217 | DO 8 I=1,N
218 | W(I)=WX
219 | DO 8 J=1,N
220 | IJ=IABS(I-J)
221 | 8 W(I)=W(I)+AK(IJ)*P(J)*DX
222 | 10 HMIN=1.E3
223 | DO 30 I=1,N
224 | H0=0.5*X(I)*X(I)-PAI1*W(I)
225 | IF(KG.EQ.1)GOTO 20
226 | IF(H0+F0(I).LT.HMIN)HMIN=H0+F0(I)
227 | H(I)=H0
228 | GOTO 30
229 | 20 F0(I)=F0(I)-H00-H0
230 | 30 CONTINUE
231 | IF(KG.EQ.1)RETURN
232 | H0=H00+HMIN
233 | IF(KK.NE.0)GOTO 32
234 | KK=1
235 | H00=-H0+HM0
236 | 32 IF(H0.LE.0.0)GOTO 48
237 | IF(K.NE.1)GOTO 50
238 | 40 MK=MK+1
239 | IF(MK.LE.MK1)GOTO 50
240 | IF(MK.GE.MK2)MK=0
241 | IF(H0+CW*DW.GT.0.0)HM0=H0+CW*DW
242 | IF(H0+CW*DW.LE.0.0)HM0=HM0*C3
243 | 48 H00=HM0-HMIN
244 | 50 DO 60 I=1,N
245 | 60 H(I)=H00+H(I)+F0(I)
246 | IT=2**(LT-K)
247 | DO 100 I=1,N
248 | II=IT*(I-1)+1
249 | CT1=((T1(II)-0.455445545)/0.544554455)**S0
250 | CT2=D0*T0*(T1(II)-1.)
251 | EDA(I)=EXP(A1*(-1.+(1.+A2*P(I))**Z*CT1))
252 | RO(I)=(A3+1.34*P(I))/(A3+P(I))+CT2
253 | EPS(I)=RO(I)*H(I)**(2+1/FF)/ENDA/EDA(I)**(1/FF)
254 | 100 CONTINUE
255 | RETURN
256 | END
257 | SUBROUTINE ITER(N,KK,DX,H00,G0,X,P,H,RO,EPS,EDA,F0,R0,KG)
258 | DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N),F0(N),R0(N)
259 | COMMON /COM1/ENDA,A1,A2,A3,Z,C1,C2,C3/COM6/FF/COMAK/AK(0:1100)
260 | DATA PAI/3.14159265/
261 | DX1=1./DX
262 | DX2=DX*DX
263 | DX3=1./DX2
264 | DX4=DX1/PAI
265 | DX5=DX1**(1.0+1/FF)
266 | DXL=DX*ALOG(DX)
267 | AK0=DX*AK(0)+DXL
268 | AK1=DX*AK(1)+DXL
269 | DO 100 K=1,KK
270 | RMAX=0.0
271 | D2=0.5*(EPS(1)+EPS(2))
272 | D3=0.5*(EPS(2)+EPS(3))
273 | D5=DX1*(RO(2)*H(2)-RO(1)*H(1))
274 | D7=DX4*(RO(2)*AK0-RO(1)*AK1)
275 | PP=0.
276 | DO 70 I=2,N-1
277 | D1=D2
278 | D2=D3
279 | D4=D5
280 | D6=D7
281 | IF(I+2.LE.N)D3=0.5*(EPS(I+1)+EPS(I+2))
282 | D5=DX1*(RO(I+1)*H(I+1)-RO(I)*H(I))
283 | D7=DX4*(RO(I+1)*AK0-RO(I)*AK1)
284 | AB1=(ABS(P(I+1)-P(I)))**(1/FF-1.0)
285 | AB2=(ABS(P(I)-P(I-1)))**(1/FF-1.0)
286 | IF(KG.NE.0)GOTO 30
287 | DD=(D1+D2)*DX3
288 | IF(DD.LT.0.1*ABS(D6))GOTO 10
289 | RI=-DX5*(D2*(P(I+1)-P(I))*AB1-D1*(P(I)-P(I-1))*AB2)+D4+R0(I)
290 | DLDP=-DX3*(D1+D2)+D6
291 | RI=C1*RI/DLDP
292 | GOTO 20
293 | 10 RI=-DX5*(D2*(P(I+1)-P(I))*AB1-D1*(P(I)-PP)*AB2)+D4+R0(I)
294 | DLDP=-1/FF*DX5*(2*D1*AB1+D2*AB2)+2.*D6
295 | RI=C2*RI/DLDP
296 | IF(I.GT.2.AND.P(I-1)-RI.GT.0.0)P(I-1)=P(I-1)-RI
297 | 20 PP=P(I)
298 | P(I)=P(I)+RI
299 | IF(P(I).LT.0.0)P(I)=0.0
300 | IF(K.NE.KK)GOTO 70
301 | IF(RMAX.LT.ABS(RI).AND.P(I).GT.0.0)RMAX=ABS(RI)
302 | GOTO 70
303 | 30 IF(KG.EQ.2)GOTO 40
304 | R0(I)=-DX5*(D2*(P(I+1)-P(I))*AB1-D1*(P(I)-P(I-1))*AB2)+D4+R0(I)
305 | GOTO 70
306 | 40 R0(I)=DX5*(D2*(P(I+1)-P(I))*AB1-D1*(P(I)-P(I-1))*AB2)-D4+R0(I)
307 | 70 CONTINUE
308 | IF(KG.NE.0)GOTO 100
309 | CALL HREE(N,DX,H00,G0,X,P,H,RO,EPS,EDA,F0,0)
310 | 100 CONTINUE
311 | RETURN
312 | END
313 | SUBROUTINE DISP(N,NW,KMAX,DX,P1,W)
314 | DIMENSION P1(N),W(NW),P(2200),AK1(0:50),AK2(0:50)
315 | COMMON /COMAK/AK(0:1100)
316 | DATA NMAX,KMIN/2200,1/
317 | N2=N
318 | M=3+2*ALOG(FLOAT(N))
319 | K1=N+KMAX
320 | DO 10 I=1,N
321 | 10 P(K1+I)=P1(I)
322 | DO 20 KK=KMIN,KMAX-1
323 | K=KMAX+KMIN-KK
324 | N1=(N2+1)/2
325 | CALL DOWNP(NMAX,N1,N2,K,P)
326 | 20 N2=N1
327 | DX1=DX*2**(KMAX-KMIN)
328 | CALL WI(NMAX,N1,KMIN,KMAX,DX,DX1,P,W)
329 | DO 30 K=KMIN+1,KMAX
330 | N2=2*N1-1
331 | DX1=DX1/2.
332 | CALL AKCO(M+5,KMAX,K,AK1)
333 | CALL AKIN(M+6,AK1,AK2)
334 | CALL WCOS(NMAX,N1,N2,K,W)
335 | CALL CORR(NMAX,N2,K,M,1,DX1,P,W,AK1)
336 | CALL WINT(NMAX,N2,K,W)
337 | CALL CORR(NMAX,N2,K,M,2,DX1,P,W,AK2)
338 | 30 N1=N2
339 | DO 40 I=1,N
340 | 40 W(I)=W(K1+I)
341 | RETURN
342 | END
343 | SUBROUTINE DOWNP(NMAX,N1,N2,K,P)
344 | DIMENSION P(NMAX)
345 | K1=N1+K-1
346 | K2=N2+K-1
347 | DO 10 I=3,N1-2
348 | I2=2*I+K2
349 | 10 P(K1+I)=(16.*P(I2)+9.*(P(I2-1)+P(I2+1))- (P(I2-3)+P(I2+3)))/32.
350 | P(K1+2)=0.25*(P(K2+3)+P(K2+5))+0.5*P(K2+4)
351 | P(K1+N1-1)=0.25*(P(K2+N2-2)+P(K2+N2))+ 0.5*P(K2+N2-1)
352 | RETURN
353 | END
354 | SUBROUTINE WCOS(NMAX,N1,N2,K,W)
355 | DIMENSION W(NMAX)
356 | K1=N1+K-1
357 | K2=N2+K
358 | DO 10 I=1,N1
359 | II=2*I-1
360 | 10 W(K2+II)=W(K1+I)
361 | RETURN
362 | END
363 | SUBROUTINE WINT(NMAX,N,K,W)
364 | DIMENSION W(NMAX)
365 | K2=N+K
366 | DO 10 I=4,N-3,2
367 | II=K2+I
368 | 10 W(II)=(9.*(W(II-1)+W(II+1))-(W(II-3)+W(II+3)))/16.
369 | I1=K2+2
370 | I2=K2+N-1
371 | W(I1)=0.5*(W(I1-1)+W(I1+1))
372 | W(I2)=0.5*(W(I2-1)+W(I2+1))
373 | RETURN
374 | END
375 | SUBROUTINE CORR(NMAX,N,K,M,I1,DX,P,W,AK)
376 | DIMENSION P(NMAX),W(NMAX),AK(0:M)
377 | K1=N+K
378 | IF(I1.EQ.2)GOTO 20
379 | DO 10 I=1,N,2
380 | II=K1+I
381 | J1=MAX0(1,I-M)
382 | J2=MIN0(N,I+M)
383 | DO 10 J=J1,J2
384 | IJ=IABS(I-J)
385 | 10 W(II)=W(II)+AK(IJ)*DX*P(K1+J)
386 | RETURN
387 | 20 DO 30 I=2,N,2
388 | II=K1+I
389 | J1=MAX0(1,I-M)
390 | J2=MIN0(N,I+M)
391 | DO 30 J=J1,J2
392 | IJ=IABS(I-J)
393 | 30 W(II)=W(II)+AK(IJ)*DX*P(K1+J)
394 | RETURN
395 | END
396 | SUBROUTINE WI(NMAX,N,KMIN,KMAX,DX,DX1,P,W)
397 | DIMENSION P(NMAX),W(NMAX)
398 | COMMON /COMAK/AK(0:1100)
399 | K1=N+1
400 | K=2**(KMAX-KMIN)
401 | C=ALOG(DX)
402 | DO 10 I=1,N
403 | II=K1+I
404 | W(II)=0.0
405 | DO 10 J=1,N
406 | IJ=K*IABS(I-J)
407 | 10 W(II)=W(II)+(AK(IJ)+C)*DX1*P(K1+J)
408 | RETURN
409 | END
410 | SUBROUTINE AKCO(KA,KMAX,K,AK1)
411 | DIMENSION AK1(0:KA)
412 | COMMON /COMAK/AK(0:1100)
413 | J=2**(KMAX-K)
414 | DO 10 I=0,KA
415 | II=J*I
416 | 10 AK1(I)=AK(II)
417 | RETURN
418 | END
419 | SUBROUTINE AKIN(KA,AK1,AK2)
420 | DIMENSION AK1(KA),AK2(KA)
421 | DO 10 I=4,KA-3
422 | 10 AK2(I)=(9.*(AK1(I-1)+AK1(I+1))-(AK1(I-3)+AK1(I+3)))/16.
423 | AK2(1)=(9.*AK1(2)-AK1(4))/8.
424 | AK2(2)=(9.*(AK1(1)+AK1(3))-(AK1(3)+AK1(5)))/16.
425 | AK2(3)=(9.*(AK1(2)+AK1(4))-(AK1(2)+AK1(6)))/16.
426 | DO 20 I=1,KA
427 | 20 AK2(I)=AK1(I)-AK2(I)
428 | DO 30 I=1,KA,2
429 | I1=I+1
430 | AK1(I)=0.0
431 | 30 IF(I1.LE.KA) AK1(I1)=AK2(I1)
432 | RETURN
433 | END
434 | SUBROUTINE SUBAK(MM)
435 | COMMON /COMAK/AK(0:1100)
436 | DO 10 I=0,MM
437 | 10 AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
438 | RETURN
439 | END
440 | FUNCTION FRICT(N,DX,H,P,EDA)
441 | DIMENSION H(N),P(N),EDA(N)
442 | COMMON /COM3/E1,PH,B,U1,U2,R,CT
443 | DATA TAU0/4.E7/
444 | TP=TAU0/PH
445 | TE=TAU0/E1
446 | BR=B/R
447 | FRICT=0.0
448 | DO I=1,N
449 | DP=0.0
450 | IF(I.LT.N)THEN
451 | DP=(P(I+1)-P(I))/DX
452 | TAU=0.5*H(I)*ABS(DP)*(BR/TP)+2.*ABS(U1-U2)*EDA(I)/(H(I)*BR**2*TE)
453 | FRICT=FRICT+TAU
454 | ENDIF
455 | ENDDO
456 | FRICT=FRICT*DX*B*TAU0
457 | RETURN
458 | END
459 | SUBROUTINE FZ(N,P,POLD)
460 | DIMENSION P(N),POLD(N)
461 | DO 10 I=1,N
462 | 10 POLD(I)=P(I)
463 | RETURN
464 | END
465 | SUBROUTINE ERROP(N,P,POLD,ERP)
466 | DIMENSION P(N),POLD(N)
467 | SD=0.0
468 | SUM=0.0
469 | DO 10 I=1,N
470 | SD=SD+ABS(P(I)-POLD(I))
471 | POLD(I)=P(I)
472 | 10 SUM=SUM+P(I)
473 | ERP=SD/SUM
474 | RETURN
475 | END
476 | SUBROUTINE KNDX(K,N,N0,N1,NMAX,DX,X)
477 | DIMENSION X(NMAX)
478 | COMMON /COM4/X0,XE
479 | N=2**(K-1)*N0
480 | DX=(XE-X0)/N
481 | N=N+1
482 | N1=N+K
483 | DO 10 I=1,N
484 | 10 X(I)=X0+(I-1)*DX
485 | RETURN
486 | END
487 | SUBROUTINE TRANS(N1,N2,P,H,RO,EPS,EDA,R)
488 | DIMENSION P(N2),H(N2),RO(N2),EPS(N2),EDA(N2),R(N2)
489 | DO 10 I=1,N1
490 | II=2*I-1
491 | P(I)=P(II)
492 | H(I)=H(II)
493 | R(I)=R(II)
494 | RO(I)=RO(II)
495 | EPS(I)=EPS(II)
496 | 10 EDA(I)=EDA(II)
497 | RETURN
498 | END
499 | SUBROUTINE OUPT(NX,NZ,X,T,T2)
500 | DIMENSION X(NX),T(NX,NZ)
501 | DO I=1,NX
502 | DO K=1,NZ
503 | T(I,K)=303.*(T(I,K)-1.0)
504 | IF(T(I,K).GT.T2)T2=T(I,K)
505 | END DO
506 | END DO
507 | WRITE(8,20)NX,NX,NZ
508 | 20 FORMAT(15X,' T(1,1)-T(1,',I4,')-T(',I4,',',I2,') ')
509 | DO I=1,NX
510 | WRITE(8,30)X(I),(T(I,K),K=1,NZ)
511 | ENDDO
512 | 30 FORMAT(6(1X,E12.6))
513 | RETURN
514 | END
515 | SUBROUTINE ERROM(NX,NZ,T1,T,KT)
516 | DIMENSION T(NX,NZ),T1(NX)
517 | KT=2
518 | ERM=0.
519 | C1=1./FLOAT(NZ)
520 | DO 20 I=1,NX
521 | TT=0.
522 | DO 10 K=1,NZ
523 | 10 TT=TT+T(I,K)
524 | TT=C1*TT
525 | ER=ABS((TT-T1(I))/TT)
526 | IF(ER.GT.ERM)ERM=ER
527 | 20 T1(I)=TT
528 | IF(ERM.LT.0.003)KT=1
529 | RETURN
530 | END
531 | SUBROUTINE THERM(NX,NZ,DX,T,P,H)
532 | DIMENSION T(NX,NZ),P(NX),H(NX), T1(21),TI(21),TF(21),U(21),DU(21), W(21),EDA(21), RO(21),EDA1(21),EDA2(21),ROR(21),UU(21)
533 | DATA KK/0/
534 | IF(KK.NE.0)GOTO 4
535 | DO 2 K=1,NZ
536 | 2 T(1,K)=1.0
537 | 4 DO 30 I=2,NX
538 | KG=0
539 | DO 8 K=1,NZ
540 | TF(K)=T(I-1,K)
541 | IF(KK.NE.0)GOTO 6
542 | T1(K)=T(I-1,K)
543 | GOTO 8
544 | 6 T1(K)=T(I,K)
545 | 8 TI(K)=T1(K)
546 | P1=P(I)
547 | H1=H(I)
548 | DP=(P(I)-P(I-1))/DX
549 | CALL TBOUD(NX,NZ,I,CC1,CC2,T)
550 | 10 CALL EROEQ(NZ,T1,P1,EDA,RO,EDA1,EDA2,KG)
551 | CALL UCAL(NZ,DX,H1,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,W,DP)
552 | CALL TCAL(NZ,DX,CC1,CC2,T1,TF,U,W,DU,H1,DP,EDA,RO)
553 | CALL ERRO(NZ,TI,T1,ETS)
554 | KG=KG+3
555 | IF(ETS.GT.1.E-4.AND.KG.LE.50)GOTO 10
556 | DO 20 K=1,NZ
557 | ROR(K)=RO(K)
558 | UU(K)=U(K)
559 | 20 T(I,K)=T1(K)
560 | 30 CONTINUE
561 | KK=1
562 | RETURN
563 | END
564 | SUBROUTINE TBOUD(NX,NZ,I,CC1,CC2,T)
565 | DIMENSION T(NX,NZ)
566 | CC1=0.
567 | CC2=0.
568 | DO 10 L=1,I-1
569 | DS=1./SQRT(FLOAT(I-L))
570 | IF(L.EQ.I-1)DS=1.1666667
571 | CC1=CC1+DS*(T(L,2)-T(L,1))
572 | 10 CC2=CC2+DS*(T(L,NZ)-T(L,NZ-1))
573 | RETURN
574 | END
575 | SUBROUTINE ERRO(NZ,T0,T,ETS)
576 | DIMENSION T0(NZ),T(NZ)
577 | ETS=0.0
578 | DO 10 K=1,NZ
579 | IF(T(K).LT.1.E-5)ETS0=1.
580 | IF(T(K).GE.1.E-5)ETS0=ABS((T(K)-T0(K))/T(K))
581 | IF(ETS0.GT.ETS)ETS=ETS0
582 | 10 T0(K)=T(K)
583 | RETURN
584 | END
585 | SUBROUTINE EROEQ(NZ,T,P,EDA,RO,EDA1,EDA2,KG)
586 | DIMENSION T(NZ),EDA(NZ),RO(NZ),EDA1(NZ),EDA2(NZ)
587 | COMMON /COM1/ENDA,A1,A2,A3,Z,O1,O2,O3
588 | COMMON /COM2/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2,RO0,RO1,RO2,S0,D0
589 | COMMON /COM3/E1,PH,B,U1,U2,R,CC/COM6/FF
590 | DATA A4,A5/0.455445545,0.544554455/
591 | IF(KG.NE.0)GOTO 20
592 | B1=(1.+A2*P)**Z
593 | B2=(A3+1.34*P)/(A3+P)
594 | 20 DO 30 K=1,NZ
595 | EDA(K)=EXP(A1*(-1.+B1*((T(K)-A4)/A5)**S0))
596 | 30 RO(K)=1+D0*T0*(T(K)-1.)
597 | CC1=0.5/(NZ-1.)
598 | CC2=1./(NZ-1.)
599 | C1=0.
600 | C2=0.
601 | DO 40 K=1,NZ
602 | IF(K.EQ.1)GOTO 32
603 | C1=C1+0.5/EDA(K)+0.5/EDA(K-1)
604 | C2=C2+CC1*((K-1.)/EDA(K)+(K-2.)/EDA(K-1))
605 | 32 EDA1(K)=C1*CC2
606 | 40 EDA2(K)=C2*CC2
607 | IF(KG.NE.2)RETURN
608 | C1=0.
609 | C2=0.
610 | C3=0.
611 | DO 50 K=1,NZ
612 | IF(K.EQ.1)GOTO 50
613 | C1=C1+0.5*(RO(K)+RO(K-1))
614 | C2=C2+0.5*(RO(K)*EDA1(K)+RO(K)*EDA1(K-1))
615 | C3=C3+0.5*(RO(K)*EDA2(K)+RO(K)*EDA2(K-1))
616 | 50 CONTINUE
617 | B1=12.*CC2*(C1*EDA2(NZ)/EDA1(NZ)-C2)
618 | 60 B2=2.*CC2/(U1+U2)*(C1*(U1-U2)/EDA1(NZ)+C3*U1)
619 | RETURN
620 | END
621 | SUBROUTINE UCAL(NZ,DX,H,EDA,RO,ROR,EDA1,EDA2,U,UU,DU,W,DP)
622 | DIMENSION U(NZ),DU(NZ),W(NZ),ROR(NZ),UU(NZ), EDA(NZ),RO(NZ), EDA1(NZ),EDA2(NZ)
623 | COMMON /COM2/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2, RO0,RO1,RO2,S0,D0
624 | COMMON /COM3/E1,PH,B,U1,U2,R,CC
625 | DATA KK/0/
626 | IF(KK.NE.0)GOTO 20
627 | A1=U1
628 | A2=PH*(B/R)**3/E1
629 | A3=U2-U1
630 | 20 CC1=A2*DP*H
631 | CC2=CC1*H
632 | CC3=A3/H
633 | CC4=1./EDA1(NZ)
634 | DO 30 K=1,NZ
635 | U(K)=A1+CC2*(EDA2(K)-CC4*EDA2(NZ)*EDA1(K))+ A3*CC4*EDA1(K)
636 | IF(U(K).LT.0.0)U(K)=0.
637 | 30 DU(K)=CC1/EDA(K)*((K-1.)/(NZ-1.)-CC4*EDA2(NZ))+CC3*CC4/EDA(K)
638 | A4=B/((NZ-1)*R*DX)
639 | C1=A4*H
640 | IF(KK.EQ.0)GOTO 50
641 | DO 40 K=2,NZ-1
642 | W(K)=(RO(K-1)*W(K-1)+C1*(RO(K)*U(K)-ROR(K)*UU(K)))/RO(K)
643 | 40 CONTINUE
644 | 50 KK=1
645 | RETURN
646 | END
647 | SUBROUTINE TCAL(NZ,DX,CC1,CC2,T,TF,U,W,DU,H,DP,EDA,RO)
648 | DIMENSION T(NZ),TF(NZ),U(NZ),DU(NZ),W(NZ), EDA(NZ),RO(NZ), A(4,21),D(21),AA(2,21)
649 | COMMON /COM2/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2, RO0,RO1,RO2,S0,D0
650 | COMMON /COM3/E1,PH,B,U1,U2,R,CC
651 | DATA KK,CC5,PAI,TAU0/0,0.6666667,3.14159265,4.E7/
652 | IF(KK.NE.0)GOTO 5
653 | KK=1
654 | TAU=TAU0*B*B/(E1*R*R)
655 | A2=-CV*RO0*E1*B**3/(EDA0*AK*R)
656 | A3=-E1*PH*B**3*D0/(AK*EDA0*T0*R)
657 | A4=-(E1*R)**2/(AK*EDA0*T0)
658 | A5=0.5*R/B*A2
659 | A6=AK*SQRT(EDA0*R/(PAI*RO1*CV1*U1*E1*AK1*B**3))
660 | A7=AK*SQRT(EDA0*R/(PAI*RO2*CV2*U2*E1*AK2*B**3))
661 | 5 CC3=A6*SQRT(DX)
662 | CC4=A7*SQRT(DX)
663 | DZ=H/(NZ-1.)
664 | DZ1=1./DZ
665 | DZ2=DZ1*DZ1
666 | CC6=A3*DP
667 | DO 10 K=2,NZ-1
668 | A(1,K)=DZ2+DZ1*A5*RO(K)*W(K)
669 | A(2,K)=-2.*DZ2+A2*RO(K)*U(K)/DX+CC6*U(K)/RO(K)
670 | A(3,K)=DZ2-DZ1*A5*RO(K)*W(K)
671 | AE=ABS(EDA(K)*DU(K))
672 | 10 A(4,K)=A4*ABS(DU(K))*AE+A2*RO(K)*U(K)*TF(K)/DX
673 | A(1,1)=0.
674 | A(2,1)=1.+2.*DZ1*CC3*CC5
675 | A(3,1)=-2.*DZ1*CC3*CC5
676 | A(1,NZ)=-2.*DZ1*CC4*CC5
677 | A(2,NZ)=1.+2.*DZ1*CC4*CC5
678 | A(3,NZ)=0.
679 | A(4,1)=1.+CC1*CC3*DZ1
680 | A(4,NZ)=1.-CC2*CC4*DZ1
681 | CALL TRA3(NZ,D,A,AA)
682 | DO 20 K=1,NZ
683 | 20 T(K)=(1.-CC)*T(K)+CC*D(K)
684 | 30 CONTINUE
685 | RETURN
686 | END
687 | SUBROUTINE TRA3(N,D,A,B)
688 | DIMENSION D(N),A(4,N),B(2,N)
689 | C=1./A(2,N)
690 | B(1,N)=-A(1,N)*C
691 | B(2,N)=A(4,N)*C
692 | DO 10 I=1,N-1
693 | IN=N-I
694 | IN1=IN+1
695 | C=1./(A(2,IN)+A(3,IN)*B(1,IN1))
696 | B(1,IN)=-A(1,IN)*C
697 | 10 B(2,IN)=(A(4,IN)-A(3,IN)*B(2,IN1))*C
698 | D(1)=B(2,1)
699 | DO 20 I=2,N
700 | 20 D(I)=B(1,I)*D(I-1)+B(2,I)
701 | RETURN
702 | END
703 | BLOCK DATA
704 | COMMON /COM2/T0,EDA0,AK,AK1,AK2,CV,CV1,CV2, RO0,RO1,RO2,S0,D0
705 | DATA T0,EDA0,AK,AK1,AK2,CV,CV1,CV2, RO0,RO1,RO2,S0,D0/303.,0.08,0.14,46.,46.,2000.,470.,470.,890.,7850.,7850.,-1.1,-0.00065/
706 | END
707 |
--------------------------------------------------------------------------------