FORTRAN程序读取数据问题

Swallow · 发表于 2015-11-20 16:45:46

登录后查看更多精彩内容~

您需要登录才可以下载或查看，没有帐号？立即注册

x

求助：
我的FORTRAN程序的读入数据是EXCEL格式数据转入的TXT数据，
用编译好的FORTRAN程序读入数据时出现的问题是：

为什么不能读入数据？到底什么地方出问题了？十几年没有接触过FORTRAN了，求帮助！谢谢！

Swallow · 发表于 2015-11-20 16:57:14

数据njrr12.txt如下：
4.3 1.1 3.7 3.6 2 2.8 3.4 13.4 10.8 15.3 1.6 5.5 0.6 0.6 4.7 0.6 1.5 11.9 12.6 1.6 0.8 5.2 8 2.8 17.5 11.5 14.2 19.9 4.2 10 9.4 8.5 7.2 4.8 3.3 23.7 18 21.5 20 18.2 23.2 4.8 8.7 10.4 9 0 1.1 2.3 11.2 0 7.1 0 0 1.4 0 0 0.9 0 0.2 0 0 0 0 0 0 0 0 0 0 0 0 1.9 0 2 0 0 0 0.1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2.7 0 0.4 0 0
6.2 1.2 11.8 4.6 1.5 5.2 7.9 7.5 6.1 6.9 0.3 5.4 2.4 5.2 1 0.5 4.7 2.9 1 6.5 1.6 3.4 2.3 1.4 4.3 3.1 2.3 4.4 3.5 3.4 4.5 5.5 2.8 6.1 4.6 0.5 2.3 1.5 5.1 2.2 2.4 1.4 0.3 6.6 4.1 0 2.3 0.9 2.1 0 3.7 0 0.1 0.6 0 0 0 0 0 0 0 1 2.6 2.7 0.6 0.9 1.2 0 1.3 0 0 1.4 0.7 4.1 0.2 1.6 1.5 2.2 0.1 0.5 1.7 0.2 0 0 0 0.9 2.4 0.1 0.1 0 0 0 0 0 1.5 0 0 0 0 0.1 2.6 0 0.3 0 0.4
9.5 6.3 19.2 6.8 6.4 18.4 12.1 33.9 33.8 29.2 3.3 10.1 4 3.6 9 4 1.6 15.4 12.1 5.3 5.1 2 6.1 2.1 4 4.7 3.6 3.3 3.9 2.4 2.9 4.4 5.3 4.9 3.5 5.4 8.4 9 9.6 7.6 14.8 2.8 1.9 6.2 2.4 0 0.5 0.5 3.4 0.2 8.4 0 0 8.5 0.2 0.7 0.1 0 0 0 0 0.2 0 0.2 0.8 0 0 0 0.2 0.2 1.5 0 0 0.9 0 0.2 0 0.2 0 0 0 0 0 0 0 3 0.2 0 0 0 0 0 0.6 0 2.4 1.5 0.7 0.5 0 0 3.9 0 0.5 0.2 1.1
3.5 6 14.2 2.8 8.9 21.5 15.2 17.1 15.9 12.8 1 11.7 1.6 2.5 4 7.3 3.2 21.1 24.1 3.4 3.6 6.5 13.7 9.4 10.8 11.2 14 15.7 6.9 9.1 10.5 11.8 9.9 10.5 9.4 19 29.2 14.9 32.8 21.3 15.2 7.2 9.9 16.6 11.5 0.4 1.4 3.7 15.8 1.5 9.6 0 0 1.9 1 1 1.7 0 0.5 0.6 1 2.7 2.8 2.1 4.5 3.5 2.2 0.9 1.9 0.6 1.1 3 4.4 11.5 3.3 8.1 3.8 1.1 1.1 7.6 3.5 2.3 2.1 0 0 0.1 3.5 3.5 3.2 3.7 5.8 3.3 2.9 0.3 1.8 1.2 1.1 0.1 0.1 1 7.3 3.2 5.2 0.3 0.2
5.9 5.2 5.6 5.3 7.9 13 8.4 11.2 24.9 18.5 2.1 3.2 6.2 8.9 5.1 4.2 2.5 18.5 26.9 4.1 10.2 8.5 8.7 3.9 7.2 9.4 10.8 11.5 2.6 4.7 4.1 2 1.4 2.3 1.9 22.7 24 15 31.5 16.3 16.7 7.4 8.9 4.9 5.3 0 1.5 2.3 4.7 0.1 1.9 0 0 3.7 0 0 0 0 0 0 0 0.1 0 0 0.2 0 0 0 0 0 0 0.6 0 0 0 0 0 0.9 0 0 0 0 0 0 0 0 0 15.8 0 0 0 0.2 0 0 1.1 0.3 0.5 0 0 0.1 2.9 0 0.3 0 1.9
20 9.8 20.6 16.1 14.2 40.5 31.1 38.6 38.7 33.3 12.6 16 17.2 21.4 20.5 5.3 9.3 20 20.1 11.3 16.2 16.8 6.2 2.9 8.6 14.4 13.9 7.7 8 7.8 12.8 21.2 11.6 16.5 17.3 16.3 21.9 20.2 24.4 12.3 17.9 7.2 19.7 30.4 20.4 0.4 5 9.4 25.5 5.4 10.6 0.2 1.3 2.3 1 6.7 11.2 1.4 1.5 1.4 2.4 1.4 0 0 0.2 0.6 0 7.2 3.7 2.7 6.3 8.5 0.2 6 0.6 0.2 1.3 0 0 0.4 0 0 0 0 0 0 0.4 4.6 0 0 0 0 0 0 0 0 0 0.5 0 0.1 3.5 0.1 4.7 3.9 0.9
22.8 7.6 27.3 16.3 11.4 31.8 20.1 25.3 49.1 32.7 7.9 17.3 6.1 5.6 14.3 7 10.4 19.1 25.4 3.8 8.5 8.4 9 6.1 9.4 9 13.7 13.4 5.1 8.1 7.4 6.2 7.4 9 9.5 28.3 27.2 48.8 34 25.3 46.9 12.5 20.2 14.8 17.2 0 2.4 4.1 11.1 0 13 0.2 0.1 7.8 0 0 0 0 0.3 0 2.9 0 0 0 0 0 0 0 0 0 0 6.4 0 0.9 0 0 0 0 0 0 0 0 0 0 0 0 0 4.6 0 0 0 0 0 0 0 0 0 0 0 0 3.5 0.2 0 0.9 2.4
12.9 2.4 15.7 4.7 5.8 9 5.2 24.3 14.9 19.7 6 8 11.9 12 6 9.1 13.1 15.5 14 12.2 10.5 9.5 8.8 6.8 13.8 15.2 13 12.6 8.1 13.5 13 8.1 3.6 3.1 6.1 11.5 11.1 11.2 12.9 10.3 18.1 6.7 9.2 8.8 11.8 0.2 3 2.9 9.9 0.1 9.4 0 0 0.3 0 0 0 0 0 0 0 2.2 0 0 0 0 0 0 0 0 0 4.7 0.7 0 1.6 0 0.3 7.8 0.2 0.4 0.1 0 0 0 0 0 0 1 0 0.6 2 1.1 2.9 0.2 4.6 3.4 0.6 0 0 0 2.7 0.2 0 0 1
15.3 8.5 12.9 13.7 6.4 14.5 13.7 18.1 25.5 32 4.8 6.7 16.2 14.9 11.8 16.9 4.3 29.8 32.2 11 11.3 9.2 10.7 16.3 16.2 14.8 22.3 13.3 8.6 10.2 8.4 7.2 8.9 11.8 9.4 33.6 34.7 27.6 43.8 23.6 21.7 13.3 12.7 8.4 9.6 0.1 3.8 4.4 10.5 5 5.5 0.9 0.1 6.1 0 0 0 0.7 1.3 3 1 0 0 0 2.2 0 0 0.4 0 0 0 2.3 0 1.3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4.6 0 0.5 0.6 2.6
16.6 3.5 12.6 11.9 6.1 15.2 5.8 20.7 30 26.2 6.5 6.3 5.8 6.9 9.6 4.3 7.6 11.5 8.7 8.9 5.5 2.3 4.5 4.7 5.6 3.6 5.9 6.7 7.8 9.6 5.7 5.6 5.4 6.2 5 5.5 7.8 11.9 11.7 10.6 10.8 2.1 2.3 6.9 3.4 0 2 1.9 6.8 0 5.5 0 0 4.6 0 0 0 0 0 0 0 4.5 0.1 0 0 0 0 0 0 0 0 5.8 3.2 6.4 1.7 5.5 2 4.7 0 2.5 0.3 0 0 0 0 0.6 9.7 8.4 1.8 6.2 10.7 10 5.6 0.8 1.7 2 1.8 2.9 1.6 0.3 0.9 0.6 0.1 0 0
20.6 8.5 18.7 12.7 9.8 20.3 23 28.9 24.3 32.1 2.6 17 9.6 16 13.1 4.3 6.7 11 12.6 14.4 13.1 9.3 5.3 7.6 14.7 7.5 11.6 14.8 13 13.5 15.6 14 10.6 8.5 7.7 19.5 28.9 41.7 37.4 30.1 14.7 13.1 6.3 16.3 14 0.1 0.7 3.4 11.6 1.1 10.9 0 0 3.4 0 0.6 0.5 0 0 0 0 5.5 5.2 5.3 6 3.7 2.9 2.2 2.4 1.3 1.5 10.9 10.3 5.2 4.5 7.5 5.4 2.3 1.7 2.2 3.6 3.2 1.7 0 0 0 5.9 0 1.1 1.7 4 3.5 1.4 0.8 1 2.5 1.7 0 0 2 8.8 0.8 3.5 2.1 1.6
11.4 10 20.5 11.6 12.1 30.5 32.2 23.3 36.5 22.9 6.1 22.5 14 8.5 10.8 3.7 13 22.5 25.6 7.4 8 6.5 11.3 6.4 16.6 15.1 15.1 13.4 10 13.4 17.9 19.9 15.6 10.6 7.9 28.4 34.3 31.9 45.3 31.7 37.6 8.7 10.1 23.5 23 0.8 2.3 5.8 13.1 3.3 12.7 0 0 6.4 0 0 0.1 0.4 0 0.4 1.8 0 0 0 0 0 0 0 0 0 0 7.9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.1 0 0 0 0 0 0 0 0 0 0.7 1.6 0 1.7 0.6 0.3 0.7 0.4
12.5 6.5 13.8 8 8.3 16.4 12.7 21.2 16.9 18.1 2.5 13.9 8.9 7.8 6 4.6 4.6 6.3 12.2 9.4 15.7 6.9 23.7 20.1 21.5 17.9 19.5 17.9 9.5 10.3 7.9 12.3 10.6 10.2 7.3 24.5 27 27.9 36.8 22.9 21.9 9.3 7.7 17.7 13.7 0.3 2.2 3.1 10.3 1.2 6.6 0 1.1 1.5 0.8 2.6 0.2 0 0 0 0 7.3 9.1 4.3 8.1 7.8 4.5 2.6 6.1 1.3 2.7 4.3 2.3 3 1.3 2.8 1.8 2.6 5.2 0.7 3.6 2.1 0.8 0 0 3.1 1.9 0 0.1 0.5 0.8 0.6 0.3 0 0.1 0 0 0 0 0 3.6 0.5 1.1 1.1 1.2
5 5.1 9.9 8.1 6.6 12.8 6.7 12.2 18.3 17.7 0.7 2.3 8.9 20.1 9.3 10.1 1.9 34.7 38.1 11.1 22.9 4.1 8.2 6.7 13.1 8.3 10.9 9.2 12.1 15.1 14.6 27.7 20.1 14.8 13 32.3 38.5 22.6 47 20.5 21.7 12.8 4.2 35.3 17.4 4.3 9 8.7 16.8 3.7 13.5 0.3 0.7 3.5 7.9 3.8 6.1 0 0 0 0 9.6 38.6 30.9 7.5 3.9 2.8 4 5.1 1.5 7.3 10.2 15.7 5.3 9.5 5.1 8.9 22.3 7.8 5.3 8.4 14 15.3 0 0.2 7 3.1 8.6 12.4 3.9 10.7 5.3 11.3 4.4 14.9 17.9 11.6 4 5.5 3.3 3 1.1 1.1 4.1 1.7
4.4 8.1 4.6 2.4 5.3 10 4.8 19.1 12 15.8 0.2 4.7 2.8 5.3 3.4 3.8 0.7 15 9.6 10.7 2.4 8.1 4.8 3.9 9.5 8.7 9.7 8.2 7.1 10.7 10.9 12.3 7.8 8.2 7.1 9.9 16.5 7 19.9 9.1 7.7 1.3 0 15.7 7.1 0 3 2.6 9.9 0.5 5.2 0 3.4 1.4 4.1 8.2 7.9 0 0 2.7 5.2 0 0.6 0 0 0 0 6 0 0.6 6.3 1 3 3.1 2.4 3.2 3.1 0.4 0 1.4 0.7 0 0 0 0 0 1.9 2.8 0.9 1.4 0.6 1 0.2 0 0 0 0 0 0 0 1.2 0 0 5.2 0.7
40.7 5.8 26.7 17.6 5.5 64.4 23.8 62 56.9 58.2 12.3 21.1 2.5 8.5 22.6 8 15.5 31.7 24.8 5 4.1 4.6 5.5 4.8 14.9 15.7 15 8.9 9.4 10.9 12.6 8.3 8.2 9.7 7 24.6 32.6 55.1 35.4 23.7 68 2.6 11.8 9.2 8.4 0 1 4.4 4.7 0.8 9.7 0 0 28 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7.4 0.4 1.1 0 1.1 0.6 0.2 0 0 0 0 0 0 0 0 0.5 3 0 0 0 0 0 0 0 0 0 0 0 0 0.5 0 0.2 0 0
24.6 7.3 31.4 16 7.7 52.8 23.7 62.1 25.5 41 1.7 21 2 2.2 4.8 6.6 8.6 29.6 29.3 1.9 3.2 1.5 7.9 7.6 8.7 5.2 6.8 5.6 9.3 7.6 7.1 10.6 8.5 8.2 8.2 26 31.6 9 34.6 8.1 15.1 10.3 5.4 7.2 4.1 0 0.5 1.2 4.9 0 3.2 0 0 1.3 0 0 0 0 0 0 0 0.2 0.2 0 0 0 0 0 0 0 0 0.7 0.2 0.8 0 0 0 0.7 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1.9 0 0.5 0.5 0.4
20.9 1.6 14.5 9.3 6.4 17.2 17.6 29.6 33 22 1.7 13.7 5.4 11 7.5 2.2 10.5 48.3 44.5 4.8 11.2 13.2 14.3 8.1 19 17.8 19.1 17.9 7.1 9.8 12.9 13.2 9.2 15.2 11.9 48.3 55.6 41.5 71.1 26.5 48.7 14.1 29.4 20.2 17.3 1.8 4.8 7.6 17.7 0.4 9.9 0 0.2 2.4 6.6 2.8 2.4 0.4 0.5 0 0.2 0 0.4 0.4 0.3 0.3 2.6 0 0 2.9 0 9.5 0 0 0 0 0 0 0.2 0 0 0.2 4.9 0 4.1 0.2 0 0 0 0 0 0 0.2 0.9 1.2 1.4 1.2 0.8 0.9 0 3.5 0.1 0.2 0.6 3.8
9.4 0 11.7 6.8 5.4 9.7 10.9 9.5 12.6 11.1 0.6 9.6 2 7.4 5.3 1.2 4.3 12.8 13.2 4.8 5 10.8 7.7 3.8 18.6 13.9 16.5 18.7 17.3 25.6 29.2 27.9 15.7 19.2 17.2 20.8 23.2 39.2 33.9 20.7 48.6 8.5 8.8 32.8 21.7 0.2 4.9 10.9 28.3 0.5 13.8 0 0 11.3 0 0 1.9 1.3 1.1 2 0.7 0 0 0 2.7 0.2 0 0 1.1 0.1 0.6 3.1 0 0 0 0 0 1.2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3.3 1.2 0.4 3.4 1.7
32.1 0 24.7 38 10.5 53.8 56.1 59.4 42.2 34 12.3 37.8 1.5 3.2 9.5 6.4 4.6 24.6 35.6 1.1 5 14.1 3.8 3.3 11 8.9 10 9.1 3.3 4.3 6.4 5.9 4.3 10 8.9 28.8 34.8 26.9 43.2 13.4 39.6 5.4 6.2 8.6 10.5 0 2.6 7.2 4.7 0.2 8.9 0.7 0.3 4.6 0.1 0.4 4.3 0.1 0 0 0 0 1.8 5.7 1.6 0 0 0 0.2 6.7 0.1 0 0 0 0 0 0 0 0 0 0 0 0.2 0.9 2.7 3.6 0 1.5 0 0 0 0 0 0.4 1.6 0.6 0.6 5.4 0.7 0 1.7 0 0 2.3 3.1
7.8 7.6 8.1 6.2 9 12.4 15.1 13.1 18 12 8.7 13.7 9.9 6.1 9.8 9.2 6.5 14.1 21.7 3 7.6 5 6.7 7.1 7.3 6.3 5.5 5.9 1.5 1.6 4.8 3.4 2.3 2.9 3.6 24.3 27.6 29 37 5.7 32.7 6.7 10.8 5.5 5.5 0 1.7 5.2 3.9 1.1 2.8 0.1 1.7 5.1 0.1 0.5 1.7 0 0.3 0.5 0 5.4 4.8 5 6 4.9 0.9 1.5 5.2 1.4 1.1 9 6.6 3.9 5.2 10 4.7 2 0.4 3.8 5.1 0.9 1.6 0.1 2.2 3.3 5.5 0.7 2.7 1.2 1.2 2 0.7 2.6 2.4 4 2.2 3.5 0.7 2.9 5.8 4.4 3.4 1 0.2
20.3 6.2 10.3 9.5 5.9 16.5 14.8 39 24.1 29.3 4.3 14.4 9.7 6.4 5.8 6.7 6 25.7 28.2 5.5 4.8 17.4 14.5 6 19.8 17.4 16.3 16.4 15.7 17.8 17.5 21.6 14.9 15.3 17.1 27.6 34.4 23.8 34.3 18.4 26.2 9.5 10.4 28.1 14.2 0.4 6.4 8.4 15.4 6.3 15.5 0 1.9 1.1 5.5 7.5 9.6 1 2 2.9 5.8 12.4 8.9 9.8 9.7 12 7.3 12.2 9.4 5.8 12 5.7 17.2 12.1 10.7 13.5 8.8 5.4 3.7 7.3 15 3.7 7.5 0.2 1.3 6.5 10.8 0 4.3 10.1 10.4 9.4 3 2.2 3.3 5.7 3.2 3.3 2.1 1.8 10.2 8 6.3 14.9 4.6
7.8 7.4 13.9 11.3 6.1 9.4 7.8 14.6 20 14.2 3.4 5.9 8.6 10.8 15.2 2.9 4.8 11.4 10 8.7 5.9 8.5 4.1 4.1 9.8 6.7 5.8 4.7 7.2 5.9 5.9 5.2 5.1 6 5.8 5.8 6.9 6.6 7.3 8.1 7 6.1 3.6 8.1 5.2 0 0.4 5.6 3.6 0.1 10.1 0 0 0.9 0 0 0 0 0 0 0 0.9 0.5 0.6 0.3 0.1 0.3 0 0.1 0 0.1 3.2 0 5.7 0.6 1.7 1.4 0.6 0 0.1 0 0 0 0 0 0 0.8 11 0 0.3 0.2 1.1 0 0 0 0 0 0 0 0 0.6 0 0 0 0
17.7 19.8 21 26.8 22.1 40.5 34.3 24.8 30.9 25.7 14.2 20 14.2 24.4 15.5 16.5 8.8 35 45.3 23.2 10.8 22.5 24.9 22.6 32.2 29.2 30.9 29.6 20.3 24.4 25.7 30.6 18.8 21.7 23.6 27.1 39.8 26.6 42.5 27.7 31.6 19.9 17.2 44 21.3 3.6 8 14.8 20 12.1 23.4 0.1 1.8 6.6 6.7 1.8 3.6 0.5 2.4 2.2 4.4 5.1 4.4 3.4 7.3 5.4 1.4 6.9 6.9 1 2.8 7.2 3 3.3 0.6 2.1 1.7 0.4 0.1 0.3 0.2 0 0 0.4 0 2.6 1.3 0 0 0 0.1 0 0.1 0.7 0 0 0 0.5 0.4 0 7.9 2 0.7 0.2 0.6
0.1 2.4 7 6.7 3 13.4 14.3 16.8 16.2 11.3 1.7 10.7 3.7 11 5.6 8.7 5.1 15.6 16.9 5.2 3.5 15.6 23.5 18.7 13.2 16.4 15.2 10.4 17.7 14.8 7.1 17.1 14 11.2 11.7 18.2 23.9 14.7 35.8 21 43.2 14.3 18.8 23.9 14.9 0 4.3 9.9 7.3 1.2 11.2 0.2 0.4 3.5 2.1 1.7 1.9 0 1.3 1.7 0 3.3 0 1.6 15.6 4.3 4.5 4 6.3 1.1 2.2 1.4 1.1 1.1 0.5 0.6 0.3 3.8 2.5 0 0.6 0 1.1 0 0 1 0.6 0 0 0 0 0 0 0 0 0 0 0 0 0 5.7 1.4 2.3 3.1 1.4
7.3 4 11.2 6.6 7.2 13 9.7 28.6 23.8 18.7 5.5 6.7 7.1 5.9 10.2 5.1 8.7 8.8 11.3 2.9 5.5 8 6.4 4 6.8 7.8 6.1 3.8 6.4 6.6 5.7 5.4 4.8 4.1 5 9.4 9.9 8.4 9.9 4.3 3.9 2.2 2.3 5.6 5.8 0 1.9 6.6 5.9 0.3 7.4 0 0 0.4 1.3 0.5 0.2 0 0 0 0 0.1 0 0 1.2 0.1 0 0 0 0 0.1 1 0.3 0 0.7 0.6 1.9 0.1 0 0.2 0 0 0 0 0 0 0.7 13.8 0 0.4 0 0 0 0 0 0 0 0 0 0 5.2 1.4 1.3 0 0.9
8.7 3.4 9.3 5.3 6.5 11.4 2 17.1 25 11.9 1.4 2.7 16.4 11.8 16.3 5.2 1.9 19.6 15 24.2 10.7 17.4 9.3 6.7 21.2 23 25.7 15.7 13.3 15.6 17 15.2 14.7 13.4 11 12.1 15.6 13.5 19.3 13.3 13.1 8.9 8.1 17 9.8 0 3.7 10.4 7.6 4.8 7.9 0 0.1 0.4 0.1 0 0.4 0 0 0 0.5 1 0.8 1 1.2 0 0 0.1 0.1 0 0 2.3 1 3.5 0.7 0.4 1.6 0.1 0 0 0.3 0.2 0 0 0 0 0.5 0 0 0 0 0 0 0 0 0.1 0 0.8 0 0 5.3 8.4 1.5 2.5 0.1
10.8 5.8 10.1 9.4 4.1 9.8 11.6 4.6 7.4 7.5 0.8 5.6 3.8 9.8 4 1.4 2.7 12.2 9.5 7.2 4.6 7.5 1.5 0.7 8.7 11.8 9.7 8.6 7.3 11.1 8.2 10 7.8 7.5 7.3 5.9 6.4 6 6.6 7.7 13.7 4 5.1 12.6 10.2 0 3.9 8.3 11.4 1.1 10.6 0.3 0 4.6 1.2 0.8 2.1 0 0 0.1 0 2.7 0.5 1 1.5 0.2 0 0.2 0.4 0 0.3 21.6 1.3 4.1 0.4 0.2 0.5 1.1 0 0 0.2 0.1 0 0 0 0 0 15.7 0 0 0 0 0.4 0 0.4 0.2 0 0 0 0 4 0 0.1 0.4 1
31.9 5.1 22.2 19.1 6.2 47.6 39.7 33 25.5 22.2 0.5 38.2 5.9 5.3 12.4 4.5 13.1 15.6 28.8 2.1 3.4 12.9 8.2 2.5 14.8 12.2 13.6 13 7 16.1 11.9 16.6 12.7 14.8 12.5 27.8 36.7 25.2 44.9 11.3 24 8.7 10.8 23.2 9.7 0 1.2 8 20.2 0.7 14.7 0 0.1 7.7 0.2 0.6 0.3 0 0 0 0 0 0 0 0.5 0.3 0.9 0.3 0.1 1.4 0.4 0.7 0 0.6 0 0 0 0 0 0 0 0 0 0 1.6 1.5 0 0.1 0 0 0 0 0.3 0 0 0 0 0.1 0 0 10.4 0.9 0.1 0.6 4.1
37.9 8.2 39.8 25.4 9.4 42.9 42.4 86.5 92.1 79.9 16.5 34.4 2.5 2.9 33.2 8.7 17.4 11 16.1 5.1 2.4 15.7 26.6 17.4 24.4 25.1 24.5 23.6 16.1 32 26.1 30.2 19.8 19.1 21.9 23.6 26 35.8 35.6 19.2 52.5 5.5 4.8 31.5 10.5 0 2.2 10.7 39.2 0.5 28.2 0.6 3.7 12.4 0.4 0.1 3.6 0.7 1.7 1.4 4.5 0 0 0.2 0 0 0.1 0.5 0.2 0.3 2.5 3.1 0 0.5 0 0 0 0.5 0 0 0 0 0.1 0 0 0.3 0.1 1.5 0 0 0 0 0 0 0 0 0 0 0 1.4 8.1 0.4 1.8 6.9 1.7

Swallow · 发表于 2015-11-20 16:58:13

FORTRAN程序：
   program main
parameter(m=105,n=30,mnl=n,np=4,ll=m)
   parameter(ks=0,undef=-999.9)
!-----input array
   dimension f0(m,n),F(M,N)
!-----work array
   dimension gvt(ll,mnl),rgvt(ll,np),cof(mnl,n),rcof(np,n)
!-----output arrays
   dimension er(mnl,4),egvt(m,mnl),ecof(mnl,n)
   dimension rer(np,2),regvt(m,np),recof(np,n)

c-----read data
   open(1,file='njrr12.txt')
do i=1,m
c    read(1,101)(f0(i,j),J=1,N)
   read(1,*)(f0(i,j),j=1,n)
end do
101  FORMAT(33F10.9)
close(1)
c-----Remove the terrain or missing value.
   l=0
do j=1,m
   if(f0(j,1).ne.undef)then
      l=l+1
      do k=1,n
         f(l,k)=f0(j,k)
      enddo
   endif
enddo
   write(*,*)'ll=',l
c-----call the subroutine
   call reof(ll,n,mnl,np,f,ks,er,gvt,ecof,rer,rgvt,recof)
c-----Add the terrain or missing value.
   l=0
do i=1,m
   if(f0(i,1).ne.undef)then
      l=l+1
      do k=1,n
      egvt(i,k)=gvt(l,k)
      end do
do k=1,np
      regvt(i,k)=rgvt(l,k)
      end do
   else
      do k=1,n
      egvt(i,k)=undef
      end do
      do k=1,np
      regvt(i,k)=undef
      end do
   endif
enddo
!-----output the result
c-----output the error
ccccccccccccccccccccccccccccccc
   open(99,file='bzh-l.txt')
write(99,*)((f(i,j),j=1,n),i=1,m)
close(99)
ccccccccccccccccccccccccccccccc
   OPEN(10,file='er.dat')
!  write(10,*)'error=',sum-tr
   write(10,*)'EOF lanmda (eigenvalues) from big to small'
write(10,*)(er(i,1),i=1,mnl)
write(*,*)'lamda='
   write(*,*)(er(i,1),i=1,mnl)
write(10,*)'EOF accumulated eigenvalues from big to small'
write(10,*)(er(i,2),i=1,mnl)
write(10,*)'EOF explained variances'
write(10,*)(er(i,3),i=1,mnl)
write(10,*)'EOF accumulated explained variances'
write(10,*)(er(i,4),i=1,mnl)
write(10,*)'REOF explained variances'
write(10,*)(rer(i,1),i=1,np)
write(10,*)'REOF accumulated explained variances'
write(10,*)(rer(i,2),i=1,np)
c-----output eigenvactors matrix of EOF
   OPEN(11,FILE='egvt.dat',form='binary')
do i=1,m
write(11)(egvt(i,j),j=1,10)
end do
close(11)

   OPEN(11,FILE='egvt.txt')
do i=1,m
write(11,102)(egvt(i,j),j=1,10)
enddo
102 format(10f10.4)
close(11)
c-----output time coefficients matrix of EOF
   open(14,file='ecof.dat',form='binary')
   do i=1,n
write(14)(ecof(j,i),j=1,10)
end do
close(14)

   open(14,file='ecof-l.txt')
   do i=1,n
write(14,102)(ecof(j,i),j=1,10)
end do
close(14)
c-----output loading vectors of REOF
   OPEN(21,FILE='regvt.dat',form='binary')
   do i=1,m
   write(21)(regvt(i,j),j=1,20)
end do
close(21)

   OPEN(21,FILE='regvt.txt')
   do i=1,m
write(21,103)(regvt(i,j),j=1,20)
   end do
103 format(20f10.4)
close(21)
c-----output time coefficients matrix of REOF
   OPEN(22,FILE='recof.dat',form='binary')
   do j=1,n
   write(22)(recof(i,j),i=1,np)
end do
close(22)

   OPEN(22,FILE='recof.txt')
   do j=1,n
   write(22,104)(recof(i,j),i=1,np)
end do
104 format(33f10.4)
close(22)
   stop
end

c-----
   subroutine reof(m,n,mnl,np,f,ks,er,egvt,ecof,rer,regvt,recof)
c-----input array
   dimension f(m,n)
c-----work arrays
   dimension cov(mnl,mnl),s(mnl,mnl),d(mnl)
c-----output arrays
   dimension er(mnl,4),egvt(m,mnl),ecof(mnl,n)
   dimension rer(np,2),regvt(m,np),recof(np,n)

c---- Preprocessing data
   call transf(m,n,f,ks)
c---- Crossed product matrix of the data f
   call crossproduct(m,n,mnl,f,cov,sum)
c---- Eigenvalues and eigenvectors by the Jacobi method
   eps=1e-7
   call jcb(mnl,cov,s,d,eps)
c---- Specified eigenvalues
   call arrang(m,n,mnl,d,s,er,tr)
write(*,*)'error=',sum-tr
c---- Normalized eignvectors and their time coefficients
   call tcoeff(m,n,mnl,f,s,er,egvt,ecof)
write(*,*)'EOF accomplished'
c-----linear transposed (rotate)
   call rotaor(m,n,mnl,np,egvt,ecof,tr,rer,regvt,recof)
write(*,*)'REOF accomplished'
c---- Specified eignvectors and time coefficients with
c    explained variances of REOF (if you need)
   call arrange2(m,n,np,regvt,recof,rer)

   return
   end

   subroutine transf(m,n,f,ks)
!-----input array
   dimension f(m,n)
!-----work array
   dimension fw(n)

   if(ks.eq.-1)return
   if(ks.eq.0)then             !anomaly of f
      do i=1,m
      do j=1,n
         fw(j)=f(i,j)
      enddo
      call meanvar(n,fw,af,sf,vf)
      do j=1,n
         f(i,j)=f(i,j)-af
      enddo
      enddo
      return
   endif
   if(ks.eq.1)then                !normalizing f
      do i=1,m
      do j=1,n
         fw(j)=f(i,j)
      enddo
      call meanvar(n,fw,af,sf,vf)
      do j=1,n
         f(i,j)=(f(i,j)-af)/sf
      enddo
      enddo
   endif
   return
   end

c-----
   subroutine crossproduct(m,n,mnl,f,cov,sum)
!-----input array
   dimension f(m,n)
!-----work array
dimension cov(mnl,mnl)

   if(n-m) 10,50,50
  10  do 20 i=1,mnl
   do 20 j=i,mnl
      cov(i,j)=0.0
      do is=1,m
      cov(i,j)=cov(i,j)+f(is,i)*f(is,j)
      enddo
      cov(j,i)=cov(i,j)
  20  continue
   sum=0.
do i=1,mnl
sum=sum+cov(i,i)
end do
sum=sum/(mnl*1.)
   return
  50  do 60 i=1,mnl
   do 60 j=i,mnl
      cov(i,j)=0.0
      do js=1,n
      cov(i,j)=cov(i,j)+f(i,js)*f(j,js)
      enddo
      cov(j,i)=cov(i,j)
  60  continue
   sum=0.
do i=1,mnl
sum=sum+cov(i,i)
end do
sum=sum/(mnl*1.)
   return
   end

c-----
   subroutine jcb(m,a,s,d,eps)
!-----input array
   dimension a(m,m)
!-----output arrays
dimension s(m,m),d(m)

   do 30 i=1,m
   do 30 j=1,i
      if(i-j) 20,10,20
  10 s(i,j)=1.
      go to 30
  20 s(i,j)=0.
      s(j,i)=0.
  30  continue
   g=0.
   do 40 i=2,m
      i1=i-1
      do 40 j=1,i1
  40    g=g+2.*a(i,j)*a(i,j)
   s1=sqrt(g)
   s2=eps/float(m)*s1
   s3=s1
   l=0
  50  s3=s3/float(m)
  60  do 130 iq=2,m
      iq1=iq-1
      do 130 ip=1,iq1
      if(abs(a(ip,iq)).lt.s3) goto 130
      l=1
      v1=a(ip,ip)
      v2=a(ip,iq)
      v3=a(iq,iq)
      u=0.5*(v1-v3)
      if(u.eq.0.0) g=1.
      if(abs(u).ge.1e-10) g=-sign(1.,u)*v2/sqrt(v2*v2+u*u)
      st=g/sqrt(2.*(1.+sqrt(1.-g*g)))
      ct=sqrt(1.-st*st)
      do 110 i=1,m
      g=a(i,ip)*ct-a(i,iq)*st
      a(i,iq)=a(i,ip)*st+a(i,iq)*ct
      a(i,ip)=g
      g=s(i,ip)*ct-s(i,iq)*st
      s(i,iq)=s(i,ip)*st+s(i,iq)*ct
  110    s(i,ip)=g
      do 120 i=1,m
      a(ip,i)=a(i,ip)
  120    a(iq,i)=a(i,iq)
      g=2.*v2*st*ct
      a(ip,ip)=v1*ct*ct+v3*st*st-g
      a(iq,iq)=v1*st*st+v3*ct*ct+g
      a(ip,iq)=(v1-v3)*st*ct+v2*(ct*ct-st*st)
      a(iq,ip)=a(ip,iq)
  130 continue
   if(l-1) 150,140,150
  140 l=0
   go to 60
  150 if(s3.gt.s2) goto 50
   do 160 i=1,m
      d(i)=a(i,i)
  160 continue
   return
   end

c-----
   subroutine arrang(m,n,mnl,d,s,er,tr)
!-----input arrays
   dimension d(mnl),s(mnl,mnl)
!-----output array
dimension er(mnl,4)

tr=0.0
   do 10 i=1,mnl
      tr=tr+d(i)/(mnl*1.)
      er(i,1)=d(i)/(mnl*1.)
  10  continue
   mnl1=mnl-1
   do 20 k1=mnl1,1,-1
   do 20 k2=k1,mnl1
      if(er(k2,1).lt.er(k2+1,1)) then
      c=er(k2+1,1)
      er(k2+1,1)=er(k2,1)
      er(k2,1)=c
      do 15 i=1,mnl
         c=s(i,k2+1)
         s(i,k2+1)=s(i,k2)
         s(i,k2)=c
  15    continue
      endif
  20  continue
   er(1,2)=er(1,1)
   do 30 i=2,mnl
      er(i,2)=er(i-1,2)+er(i,1)
  30  continue
   do 40 i=1,mnl
      er(i,3)=er(i,1)*100./tr
      er(i,4)=er(i,2)*100./tr
  40  continue
   return
   end

c-----
   subroutine tcoeff(m,n,mnl,f,s,er,egvt,ecof)
!-----input arrays
   dimension f(m,n),s(mnl,mnl),er(mnl,4)
!-----work arrays
   dimension v(m),v1(n)
!-----output arrays
dimension egvt(m,mnl),ecof(mnl,n)

   do j=1,mnl
      do i=1,m
      egvt(i,j)=0.
      enddo
      do i=1,n
      ecof(j,i)=0.
      enddo
   enddo
c-----Normalizing the input eignvectors (c=sqrt(lamda))
   do 10 j=1,mnl
      c=0.
      do i=1,mnl
      c=c+s(i,j)*s(i,j)
      enddo
      c=sqrt(c)
      do i=1,mnl
      s(i,j)=s(i,j)/c
      enddo
  10  continue
c-----(m<n)
   if(m.le.n) then
   do js=1,mnl
      do i=1,m
         egvt(i,js)=s(i,js)
      enddo
      enddo
      do 30 j=1,n
      do i=1,m
         v(i)=f(i,j)
      enddo
      do is=1,mnl
         do i=1,m
            ecof(is,j)=ecof(is,j)+v(i)*egvt(i,is)
         enddo
      enddo
  30 continue
   else
c-----(m>n)
      do 40 i=1,m
      do j=1,n
         v1(j)=f(i,j)
      enddo
      do js=1,mnl
      do j=1,n
         egvt(i,js)=egvt(i,js)+v1(j)*s(j,js)
      enddo
      enddo
  40 continue

      do 50 js=1,mnl
      do j=1,n
         ecof(js,j)=s(j,js)*sqrt(abs(er(js,1)))
      enddo
      do i=1,m
         egvt(i,js)=egvt(i,js)/sqrt(abs(er(js,1)))
      enddo
  50 continue

   do js=1,mnl
   do i=1,m
      egvt(i,js)=(sqrt(abs(er(js,1)/(mnl*1.0))))*egvt(i,js)
   end do
   do i=1,n
      ecof(js,i)=(ecof(js,i))/(sqrt(abs(er(js,1)/(mnl*1.0))))
   end do
end do
end if
   return
   end

c-----
subroutine rotaor(m,n,mnl,np,egvt,ecof,tr,rer,regvt,recof)
c-----input arrays
dimension egvt(m,mnl),ecof(mnl,n)
c-----work arrays
dimension h(m),st(np),vrlv(50),er(mnl,4),s(m,np)
c-----output arrays
   dimension regvt(m,np),recof(np,n),rer(np,2)
   integer t,k

   write(*,*)'rotate beginning'
c-----Take out forward NP eigenvectors to rotate
   do j=1,np
      do i=1,m
      regvt(i,j)=egvt(i,j)
   end do
end do
c-----Take out forward NP time coefficients to rotate
   do i=1,np
      do j=1,n
recof(i,j)=ecof(i,j)
      end do
end do
c-----compute the common degree
   do i=1,m
   h(i)=0.0
      do j=1,np
h(i)=h(i)+regvt(i,j)**2
      end do
end do
   do i=1,m
   h(i)=sqrt(h(i))
   end do
c-----compute the variance of the variance contribution by per common degree
c-----(equal to the ratated one)
   vrlv0=0.0
   do k=1,np
   g1=0.0
      g2=0.0
      do i=1,m
g1=g1+(regvt(i,k)**2/h(i)**2)**2/real(m)
g2=g2+(regvt(i,k)**2/h(i)**2)/real(m)
      end do
   g2=g2**2
   vrlv0=vrlv0+g1-g2
   end do
c-----rotated
   lll=0
write(*,*)'rotate times'
800  continue
   do 505 t=1,np
   do 505 k=1,np
      if(t.ge.k) goto 505
call rot(regvt,recof,h,t,k,m,n,np)
505  continue
   lll=lll+1
write(*,*)'LLL=',LLL
   vrlv(lll)=0.0
   do k=1,np
   g1=0.0
   g2=0.0
      do i=1,m
      g1=g1+(regvt(i,k)**2/h(i)**2)**2/real(m)
      g2=g2+(regvt(i,k)**2/h(i)**2)/real(m)
      end do
   g2=g2**2
   vrlv(lll)=vrlv(lll)+g1-g2
   end do
   if(lll.lt.2) goto 800
ci=(vrlv(lll)-vrlv(lll-1))/vrlv0
if(ci.lt.0.001) goto 600
if(lll.ge.40) goto 600
   goto 800
600  continue
c-----compute the explained variances
do j=1,np
   st(j)=0.0
      do i=1,m
st(j)=st(j)+regvt(i,j)**2
      end do
   end do
   do j=1,np
   rer(j,1)=st(j)*100/tr
end do
c-----compute the accumulated explained variances
   ddd=0.0
   do k=1,np
      ddd=ddd+st(k)/tr
      rer(k,2)=ddd*100.
   enddo
   return
   end

c-----
   subroutine rot(a,b,h,t,k,m,n,np)
c-----input arrays
   dimension a(m,np),b(np,n),h(m)
c-----work arrays
   dimension u(m),vr(m),wt(m),wk(m),wbt(n),wbk(n)
c-----output arrays
c    dimension a(m,np),b(np,n)
   integer t,k

c-----compute fi
   do 25 i=1,m
   u(i)=(a(i,t)/h(i))**2-(a(i,k)/h(i))**2
25 vr(i)=2.0*(a(i,t)/h(i))*(a(i,k)/h(i))
   c=0.0
   d=0.0
   s=0.0
   g=0.0
   do 30 i=1,m
   c=c+(u(i)**2-vr(i)**2)
   d=d+2.0*u(i)*vr(i)
   s=s+u(i)
30 g=g+vr(i)
   tg1=d-2.0*s*g/(m*1.)
   tg2=c-(s**2-g**2)/(m*1.)
   fi=atan2(tg1,tg2)/4.0
c-----compute new a and b with fi
   do 75 i=1,m
   wt(i)=a(i,t)
75 wk(i)=a(i,k)
   do 84 kk=1,n
   wbt(kk)=b(t,kk)
84 wbk(kk)=b(k,kk)
   do 78 i=1,m
   a(i,t)=wt(i)*cos(fi)+wk(i)*sin(fi)
78 a(i,k)=wt(i)*(-sin(fi))+wk(i)*cos(fi)
   do 89 it=1,n
   b(t,it)=wbt(it)*cos(fi)+wbk(it)*sin(fi)
89 b(k,it)=wbt(it)*(-sin(fi))+wbk(it)*cos(fi)
   return
   end

c-----
   subroutine arrange2(m,n,np,regvt,recof,rer)
c-----input and output arrays
   dimension regvt(m,np),recof(np,n),rer(np,2)

   mnl1=np-1
   do 20 k1=mnl1,1,-1
   do 20 k2=k1,mnl1
      if(rer(k2,1).lt.rer(k2+1,1)) then
      c=rer(k2+1,1)
      rer(k2+1,1)=rer(k2,1)
      rer(k2,1)=c
      do i=1,m
         d=regvt(i,k2+1)
         regvt(i,k2+1)=regvt(i,k2)
         regvt(i,k2)=d
      end do
      do i=1,n
         e=recof(k2+1,i)
         recof(k2+1,i)=recof(k2,i)
         recof(k2,i)=e
      end do
      endif
  20  continue
   do i=1,np
   rer(i,2)=0.0
end do
   rer(1,2)=rer(1,1)
   do 30 i=2,np
      rer(i,2)=rer(i-1,2)+rer(i,1)
  30  continue
   return
   end

   subroutine meanvar(n,x,ax,sx,vx)
!-----input array
   dimension x(n)

   ax=0.
   vx=0.
   sx=0.
   do 10 i=1,n
      ax=ax+x(i)
  10  continue
   ax=ax/float(n)
   do 20 i=1,n
      vx=vx+(x(i)-ax)**2
  20  continue
   vx=vx/float(n)
   sx=sqrt(vx)
   return
   end

Swallow · 发表于 2015-11-20 17:06:50

编译时无错误，但有6个警告！读取数据就存在问题，请各位大侠帮忙查错！

Swallow · 发表于 2015-11-20 17:11:33

数据txt转置过来，也不行！到底怎么了？

Swallow · 发表于 2015-11-20 17:44:43

添加文件路径也不行，为什么？

chende2008x · 发表于 2015-11-21 17:04:15

Swallow 发表于 2015-11-20 17:44
添加文件路径也不行，为什么？

excel转txt要控制好数据格式。
如果不确定，最好避免用F10.9等明确的格式控制。

		自动登录	找回密码
密码			立即注册

[求助] FORTRAN程序读取数据问题

登录后查看更多精彩内容~

浏览过的版块