fortran66のブログ

fortran について書きます。

【ニュース】ドイツ Fortran 5日間講習会メニュー その他

PRACE Course: Advanced Fortran Topics

https://www.lrz.de/services/compute/courses/2019-09-09_hftn1s19/

上級コースは F2003 以降で付加された機能を5日間で学ぶようです。

Days 1-3:

  • Best Practices
    • global objects and interfaces
    • abstract interfaces and the IMPORT statement
  • object based programmingObject-Oriented Programming
    • type extension, polymorphism and inheritance
    • binding of procedures to types and objects
    • generic type-bound procedures
    • abstract types and deferred bindings
  • IEEE features and floating point exceptions
  • Interoperability with C
    • mixed language programming patterns
  • Fortran 2003 I/O extensions

Days 4-5 (PRACE course (tbc.)):

  • OO Design Patterns: application of object-oriented programming
    • creation and destruction of objects
    • polymorphic objects and function arguments
    • interacting objects
    • dependency inversion: submodules and plugins
  • Coarrays
    • PGAS concepts and coarray basics
    • dynamic entities
    • advanced synchronization
    • parallel programming patterns
    • recent enhancements: collectives, events, teams, atomic subroutines
    • performance aspects of coarray programming

HP が Cray を買収

pc.watch.impress.co.jp

最近、アメリカ政府の HPC 案件を次々落札していた Cray ですが、それでも直近では赤字だったようです。

Cray の Chapel 言語はどうなってしまうのか?Coarray Fortran 以外の PGAS 言語の将来は如何?今後のニュースを注視したいところです。

なお Sun が Oracle に買収されたときは、PGAS 言語の Fortress 開発は廃止、その後 Java もライセンス変えるなどの影響が出ました。

また DEC が HP に買収されたときは、Fortran 部門は丸ごと Intel に売却されました。

(PGAS: Partitioned Global Address Space。本邦では Xcalable 語が属します。)

イラン外相緊急来日!

アメリカ・イスラエルの圧迫を受けて、仲介を求めて日印中と行脚のようです。二兎を追うもの一兎も得ず、アメリカはペルシャには目もくれず只管打坐、撃ちてし止まぬの精神でただただ支那・朝鮮を叩くべし!イランにミサイル・核兵器開発技術を流している北朝鮮およびその支援国韓国を叩けば、イラン攻撃にもなる。

この前辞意表明したザリフ外相ですが、慰留されてまだ外相やってるようです。

イランの日本語ニュースサイトより。
parstoday.com

ザリーフ外相は17日金曜、ツイッタートルクメニスタン、インド、日本、中国への今回の歴訪に触れ、「日本の安倍総理や河野外相、中国の王毅外相をはじめとする、今回の訪問先の国々の政府関係者らと有意義な対話ができた」と述べました。

parstoday.com

parstoday.com

イランのザリーフ外相は、日本の政府関係者との協議のあと、同国メディアのインタビューに答え、「文明世界は、安保理決議や法を履行する人々に対するアメリカの威圧な行動に抵抗する必要がある」と語りました。

(強調は原文ママ

魔法の妖精 ペルシャ DVD COLLECTION BOX 1

魔法の妖精 ペルシャ DVD COLLECTION BOX 1

魔法の妖精ペルシャ DVD COLLECTION BOX 2

魔法の妖精ペルシャ DVD COLLECTION BOX 2

Modern Fortran Explained (赤本) Exercise 9-1 の注 その2の巻

Modern Fortran Explained -2018- p.495

昨日に引き続き、MFE(赤)の二次方程式の問題です。
M.Metcalf の FORTRAN77 例と MFE 中の Fortran90 の解答例を実行してみます。

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

FORTRAN77

注意すべき点は、装置番号を * にした標準出力で carriage control を使っていることで、Intel Fortran の場合はコンパイル時のオプション /ccdefault:fortran で有効にすることが出来ます。

なお行頭1文字目を出力装置制御に使う carriage control は Fortran2008 で廃止になりました。

Fortran Primer

Fortran Primer

Encyclopedia of Physical Science and Technology, Volume 5, Third Edition

Encyclopedia of Physical Science and Technology, Volume 5, Third Edition

ソース・プログラム
      PROGRAM QROOTS
*        Solution of quadratic equation
*         (Based on code in FORTRAN66)
      CHARACTER*6 ANAME
      COMPLEX COMP
*     
*     Read title and number of solutions from terminal
    1 READ(*, *, END = 999) ANAME, N
      WRITE(*, '('' ROOTS OF QUADRATIC EQUATIONS FROM '',A)') ANAME
      DO 21 I = 1, N
         READ(*, *) A, B, C
         WRITE(*, '(A, I2/3(A,F8.2:TR12))')
     +            '0set No. ', I, ' A = ', A, 'B = ', B, 'C = ', C
         IF (A.EQ.0.) THEN
            IF (B.NE.0.) THEN
               WRITE(*, '('' LINEAR'',TR25,A,F10.3)') 'X = ', -C/B
            ELSE
               WRITE(*, '('' NO ROOTS'')')
            END IF
         ELSE
            D = B**2 - 4.*A*C
            IF (D.LT.0.) THEN
               COMP = CMPLX(-B/(2.*A), SQRT(-D)/(2.*A))
               WRITE(*, '('' COMPLEX'',TR21,''R(X1)= '',F10.3,TR11,
     +                ''I(X1)= '',F10.3/T30,''R(X2)= '',F10.3,TR11,
     +                ''I(X2)= '',F10.3)') COMP, CONJG(COMP)
            ELSE
               SQRTD = SQRT(D)
               REAL1 = (-B + SQRTD)/(2.0*A)
               REAL2 = (-B - SQRTD)/(2.0*A)
               WRITE(*, '('' REAL '',TR25,2(A,F10.3:TR13))')       
     +               'X1 = ', REAL1, 'X2 = ', REAL2
            END IF         
         END IF                
   21 CONTINUE
      WRITE(*, '(''0END OF '',A)') ANAME
      GO TO 1
  999 END
出力結果
 J.DOE 4
ROOTS OF QUADRATIC EQUATIONS FROM J.DOE
        2.        4.        1.

set No.  1
A =     2.00            B =     4.00            C =     1.00
REAL                          X1 =     -0.293             X2 =     -1.707
        2.        4.        3.

set No.  2
A =     2.00            B =     4.00            C =     3.00
COMPLEX                     R(X1)=     -1.000           I(X1)=      0.707
                            R(X2)=     -1.000           I(X2)=     -0.707
        0.      5.67    -11.83

set No.  3
A =     0.00            B =     5.67            C =   -11.83
LINEAR                         X =      2.086
    536.28   -275.61      2.11

set No.  4
A =   536.28            B =  -275.61            C =     2.11
REAL                          X1 =      0.506             X2 =      0.008

END OF J.DOE
^Z
続行するには何かキーを押してください . . .

Fortran90

ソース・プログラム

実数解の時に、-b\pm\sqrt{b^2-4ac} のところで桁落ちが小さくなるような符号の組み合わせを選び、解と係数の関係からもう一方の解を求めているのが近代的進化点です。

                x1 = -(b + sign(sqrt(d), b)) / (2.0*a)
                x2 = c / (x1*a)
!  MFE2018  Solution 9.1 p.494 
!
    program qroots
         
        implicit none
        real :: a, b, c, d, x1, x2
        
        read (*, *) a, b, c
        write(*, *) ' a= ', a, ' b= ', b, ' c= ', c
        if (a == 0.0) then 
            if (b /= 0.0) then 
                write(*, *) ' Linear: x = ', -c/b
            else 
                write(*, *) ' No roots!'
            end if
        else
            d = b**2 - 4.0*a*c
            if (d < 0.0) then
                write(*, *) ' Complex: ', -b/(2.0*a), '+-', sqrt(-d)/(2.0*a)
            else
                x1 = -(b + sign(sqrt(d), b)) / (2.0*a)
                x2 = c / (x1*a)
                write(*, *) ' Real roots:', x1, x2
            end if
        end if
    
    end program qroots
出力結果

単発の計算を4回やっています。

        2.        4.        1.
  a=    2.000000      b=    4.000000      c=    1.000000
  Real roots:  -1.707107     -0.2928932
        2.        4.        3.
  a=    2.000000      b=    4.000000      c=    3.000000
  Complex:   -1.000000     +-  0.7071068
        0.      5.67    -11.83
  a=   0.0000000E+00  b=    5.670000      c=   -11.83000
  Linear: x =    2.086420
    536.28   -275.61      2.11
  a=    536.2800      b=   -275.6100      c=    2.110000
  Real roots:  0.5061559      7.7733188E-03

Modern Fortran Explained (赤本) Exercise 9-1 の注

Modern Fortran Explained -2018- p.495

Modern Fortran Explained ~ Fortran 2018 対応版は赤い表紙なので赤本としておきます。前の版の Modern Fortran Explained は緑でした。

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

その章末問題 9-1 に二次方程式の解を求めるものがあるのですが、巻末(pp.494-495)に解答が与えられています。

その脚注に、1963 年の E. Organick の FORTRAN Primer の解答例を参照するもよしとあって、さらにそれを採録し FORTRAN66 および FORTRAN77 でも書き直した M. Metcalf の記事も参照するもよしとあるので、見てみることにします。

MFE の解答例では、桁落ち対処がなされていますが、Organick/Metcalf は二次方程式の解の公式そのまま使っています。

以下では基本的にプログラムは M. Matcalf が Encyclopedia of Physical Science and Technology, Vol.5 に書いた記事中のプログラムを微修正して、入力データは E. Organick のものを用いることにします。

今日は FORTRAN II と IV のプログラムを IBM7090 エミュレータで実行した結果を示します。FORTRAN IV のプログラムの方は標準的 FORTRAN66 で書かれているので、今のコンパイラでも一応コンパイル&実行できます。(正確にいえば FORTRAN66 とは細かな仕様差があるのですが、基本的な使い方ならまま行けます。) 明日以降に FORTRAN77 と Fortran90 の結果を示すことにします。

JOB CARD は私が適当にいじりました。
参考:
www.frobenius.com

驚くべきことに、Intel Visual Fortran では Visual Studio 2017 でシンタックス・カラリングがホレリス型に対応していて、ホレリス型の桁数分だけ色を変えてくれます。さすが21世紀!

FORTRAN II

参考ページ
fortran66.hatenablog.com

入力
$JOB           QUADRATIC EQUATION
$EXECUTE       FORTRAN
*      ID      QUAD
*      XEQ
C   SOLUTION OF QUADRATIC EQUATION 
C   (P. 122 OF A FORTRAN PRIMER BY E. ORGANICK)
    1 READ INPUT TAPE 5, 51, ANAME, N
   51 FORMAT(A6,I2)
      WRITE OUTPUT TAPE 6, 52, ANAME
   52 FORMAT(1H1,33HROOTS OF QUADRATIC EQUATIONS FROM A6)
      DO 21 I = 1, N
      READ INPUT TAPE 5, 53, A, B, C
   53 FORMAT(3F10.2)
      WRITE OUTPUT TAPE 6, 54, I, A, B, C
   54 FORMAT(1H0,8HSET NO. I2/5H A = F8.2,12X,4HB = F8.2,12X,4HC = F8.2)
      IF (A) 10, 7, 10
    7 RLIN = -C/B
      WRITE OUTPUT TAPE 6, 55, RLIN
   55 FORMAT(7H LINEAR,25X,4HX = F10.3)
      GO TO 21
   10 D = B**2 - 4.*A*C
      IF (D) 12, 17, 17
   12 COMPR = -B/(2.*A)
      COMP1 = SQRTF(-D)/(2.*A)
      COMP2 = -COMP1
      WRITE OUTPUT TAPE 6, 56, COMPR, COMP1, COMPR, COMP2
   56 FORMAT(8H COMPLEX,21X,7HR(X1)= F10.3,11X,7HI(X1)= F10.3,/1H ,28X,
     17HR(X2)= F10.3,11X,7HI(X2)= F10.3)
   16 GO TO 21
   17 REAL1 = (-B + SQRTF(D))/(2.*A)
      REAL2 = (-B - SQRTF(D))/(2.*A)
   20 WRITE OUTPUT TAPE 6, 57, REAL1, REAL2
   57 FORMAT(6H REAL 25X,5HX1 = F10.3,13X,5HX2 = F10.3)
   21 CONTINUE
      WRITE OUTPUT TAPE 6, 58, ANAME
   58 FORMAT(8H0END OF A6)
      GOTO 1
      END
*     DATA
 J.DOE 4
        2.        4.        1.
        2.        4.        3.
        0.      5.67    -11.83
    536.28   -275.61      2.11
sim>  do  do_ibsys.txt quad.job out
date.txt
quad.job
eof.dat
ibsys.ctl
        1 個のファイルをコピーしました。
CDR: unit is read only
CDP: creating new file
LPT: creating new file
MTA: creating new file
MTA: creating new file
MTA: creating new file
MTA: creating new file
MTA: creating new file
MTA: creating new file
MTA: creating new file

HALT instruction, PC: 07465 (SXA 7510,4)
sim>
出力(核心部分)

入力の J.DOE (John Doe) は英語版「名無しの権兵衛」「山田太郎」式の名前です。Organick の入力麗そのままです。結果は Organick のものを再現しています。

ROOTS OF QUADRATIC EQUATIONS FROM J.DOE

SET NO.  1
A =     2.00            B =     4.00            C =     1.00
REAL                          X1 =     -0.293             X2 =     -1.707

SET NO.  2
A =     2.00            B =     4.00            C =     3.00
COMPLEX                     R(X1)=     -1.000           I(X1)=      0.707
                            R(X2)=     -1.000           I(X2)=     -0.707

SET NO.  3
A =     0.              B =     5.67            C =   -11.83
LINEAR                         X =      2.086

SET NO.  4
A =   536.28            B =  -275.61            C =     2.11
REAL                          X1 =      0.506             X2 =      0.008

END OF  J.DOE
全出力
           $LIST
           $DATE          051819


           $JOB           QUADRATIC EQUATION
           $EXECUTE       FORTRAN

     *      ID      QUAD

     *      XEQ
         SOLUTION OF QUADRATIC EQUATION                                          5/18/19        PAGE 1

     C   (P. 122 OF A FORTRAN PRIMER BY E. ORGANICK)
         1 READ INPUT TAPE 5, 51, ANAME, N
        51 FORMAT(A6,I2)
           WRITE OUTPUT TAPE 6, 52, ANAME
        52 FORMAT(1H1,33HROOTS OF QUADRATIC EQUATIONS FROM A6)
           DO 21 I = 1, N
           READ INPUT TAPE 5, 53, A, B, C
        53 FORMAT(3F10.2)
           WRITE OUTPUT TAPE 6, 54, I, A, B, C
        54 FORMAT(1H0,8HSET NO. I2/5H A = F8.2,12X,4HB = F8.2,12X,4HC = F8.2)
           IF (A) 10, 7, 10
         7 RLIN = -C/B
           WRITE OUTPUT TAPE 6, 55, RLIN
        55 FORMAT(7H LINEAR,25X,4HX = F10.3)
           GO TO 21
        10 D = B**2 - 4.*A*C
           IF (D) 12, 17, 17
        12 COMPR = -B/(2.*A)
           COMP1 = SQRTF(-D)/(2.*A)
           COMP2 = -COMP1
           WRITE OUTPUT TAPE 6, 56, COMPR, COMP1, COMPR, COMP2
        56 FORMAT(8H COMPLEX,21X,7HR(X1)= F10.3,11X,7HI(X1)= F10.3,/1H ,28X,
          17HR(X2)= F10.3,11X,7HI(X2)= F10.3)
        16 GO TO 21
        17 REAL1 = (-B + SQRTF(D))/(2.*A)
           REAL2 = (-B - SQRTF(D))/(2.*A)
        20 WRITE OUTPUT TAPE 6, 57, REAL1, REAL2
        57 FORMAT(6H REAL 25X,5HX1 = F10.3,13X,5HX2 = F10.3)
        21 CONTINUE
           WRITE OUTPUT TAPE 6, 58, ANAME
        58 FORMAT(8H0END OF A6)
           GOTO 1
           END(1,0,0,0,0,0,1,0,0,1,0,0,0,0,0)
         SOLUTION OF QUADRATIC EQUATION                                          5/18/19        PAGE 2

                                                STORAGE NOT USED BY PROGRAM
             DEC   OCT               DEC   OCT
              228 00344             32561 77461

               STORAGE LOCATIONS FOR VARIABLES NOT APPEARING IN COMMON, DIMENSION, OR EQUIVALENCE STATEMENT
             DEC   OCT               DEC   OCT               DEC   OCT               DEC   OCT               DEC   OCT
      ANAME   227 00343           A   226 00342           B   225 00341       COMP1   224 00340       COMP2   223 00337
      COMPR   222 00336           C   221 00335           D   220 00334           I   219 00333           N   218 00332
      REAL1   217 00331       REAL2   216 00330        RLIN   215 00327

                                 SYMBOLS AND LOCATIONS FOR SOURCE PROGRAM FORMAT STATEMENTS
             EFN   LOC               EFN   LOC               EFN   LOC               EFN   LOC               EFN   LOC
       8)1J    51 00323        8)1K    52 00321        8)1L    53 00311        8)1M    54 00307        8)1N    55 00275
       8)1O    56 00270        8)1P    57 00250        8)1Q    58 00240
                                LOCATIONS FOR OTHER SYMBOLS NOT APPEARING IN SOURCE PROGRAM

             DEC   OCT               DEC   OCT               DEC   OCT               DEC   OCT               DEC   OCT
         1)   212 00324          2)   146 00222          3)   150 00226          4) 32767 77777          6)   152 00230
      C)200   214 00326         E)5    80 00120
                                           LOCATIONS OF NAMES IN TRANSFER VECTOR
             DEC   OCT               DEC   OCT               DEC   OCT               DEC   OCT               DEC   OCT
       SQRT     5 00005       (FIL)     4 00004       (FPT)     0 00000       (RTN)     2 00002       (STH)     3 00003
      (TSH)     1 00001
                                    ENTRY POINTS TO SUBROUTINES NOT OUTPUT FROM LIBRARY

     SQRT        (FIL)       (FPT)       (RTN)       (STH)       (TSH)

                  EXTERNAL FORMULA NUMBERS WITH CORRESPONDING INTERNAL FORMULA NUMBERS AND OCTAL LOCATIONS
       EFN   IFN   LOC         EFN   IFN   LOC         EFN   IFN   LOC         EFN   IFN   LOC         EFN   IFN   LOC
          1    10 00013           7    20 00070          10    24 00104          12    26 00121          16    31 00156
         17    32 00157          20    34 00200          21    36 00210



LIBRARY ENTRY POINTS,
     (FPT)       (TSHM)      (RTN)       (STHM)      (FIL)       SQRT

LOGICAL   MACHINE       TOTAL       TOTAL         NOISE RECORDS        TOTAL REDUNDANCIES          POSITIONING
 TAPE      TAPE        WRITES       READS      WRITING     READING     WRITING     READING           ERRORS
    1        A1             0          31           0           0           0           0                 0
    2        A6            69          66           0           0           0           0                 0
    3        A9            15          15           0           0           0           0                 0
    4        A5            45          46           0           0           0           0                 0
    5        A3             0          39           0           0           0           0                 0
    6        A4            56           1           0           0           0           0                 0
    7        A8            16          13           0           0           0           0                 0

       EXECUTION
ROOTS OF QUADRATIC EQUATIONS FROM J.DOE

SET NO.  1
A =     2.00            B =     4.00            C =     1.00
REAL                          X1 =     -0.293             X2 =     -1.707

SET NO.  2
A =     2.00            B =     4.00            C =     3.00
COMPLEX                     R(X1)=     -1.000           I(X1)=      0.707
                            R(X2)=     -1.000           I(X2)=     -0.707

SET NO.  3
A =     0.              B =     5.67            C =   -11.83
LINEAR                         X =      2.086

SET NO.  4
A =   536.28            B =  -275.61            C =     2.11
REAL                          X1 =      0.506             X2 =      0.008

END OF  J.DOE

         93 LINES OUTPUT THIS JOB.


     FORTRAN MONITOR RETURNING TO IBSYS
           $STOP


            PERIPHERAL UNIT POSITIONS AT END OF JOBS

            SYSPP1  IS   A8    REC. 00000, FILE 00002
            SYSOU1  IS   A4    REC. 00083, FILE 00000
            SYSIN1  IS   A3    REC. 00002, FILE 00001

           END OF JOBS


EOF  END OF OUTPUT

FORTRAN IV

こちらはジョブカードの最後に EOF をつけなければならないのですが、勘違いで苦労しました。エミュレータ付属のファイル中に、eof.dat というファイルがあるので、これからコピペすればおkです。

入力

ここでは EOF は見えません。メモ帳ではスペードマークに見えてます。

$JOB           QUADRATIC EQUATION
$EXECUTE       IBJOB
$IBJOB         GO 
$IBFTC QUADRA    
C      SOLUTION OF QUADRATIC EQUATION
C      (BASED ON CODE IN FORTRAN II)
      COMPLEX COMP(2)

    1 READ(5, 51) ANAME, N
   51 FORMAT(A6, I2)
      WRITE(6, 52) ANAME
   52 FORMAT(1H1,33HROOTS OF QUADRATIC EQUATIONS FROM A6)
      DO 21 I = 1, N
         READ(5, 53) A, B, C
   53    FORMAT(3F10.2)
         WRITE(6, 54) I, A, B, C
   54    FORMAT(1H0,8HSET NO. I2/5H A = F8.2,12X,4HB = F8.2,12X,4HC = 
     +   F8.2)
         IF (A.NE.0.) GO TO 10
         IF (B.NE.0.) GO TO  7
         WRITE(6, 59) 
   59    FORMAT(9H NO ROOTS)
         GO TO 21
    7    RLIN = -C/B
         WRITE(6, 55) RLIN
   55    FORMAT(7H LINEAR,25X,4HX = F10.3)
         GO TO 21
   10    D = B**2 - 4.*A*C
         IF (D.GE.0.) GO TO 17
         COMP(1) = CMPLX(-B/(2.*A), SQRT(-D)/(2.*A))
         COMP(2) = CONJG(COMP(1))
         WRITE(6, 56) COMP
   56    FORMAT(8H COMPLEX,21X,7HR(X1)= F10.3,11X,7HI(X1)= F10.3,/1H ,
     +   28X,7HR(X2)= F10.3,11X,7HI(X2)= F10.3)
         GO TO 21
   17    SQRTD = SQRT(D)
         REAL1 = (-B + SQRTD)/(2.*A)
         REAL2 = (-B - SQRTD)/(2.*A)
         WRITE(6, 57) REAL1, REAL2
   57    FORMAT(6H REAL 25X,5HX1 = F10.3,13X,5HX2 = F10.3)
   21 CONTINUE
      WRITE(6, 58) ANAME
   58 FORMAT(8H0END OF A6)
      GO TO 1
      END
$DATA
J.DOE  4
        2.        4.        1.                                                 
        2.        4.        3.                                                  
        0.      5.67    -11.83                                                   
    536.28   -275.61      2.11  
出力(核心部分)
ROOTS OF QUADRATIC EQUATIONS FROMJ.DOE

SET NO.  1
A =     2.00            B =     4.00            C =     1.00
REAL                          X1 =     -0.293             X2 =     -1.707

SET NO.  2
A =     2.00            B =     4.00            C =     3.00
COMPLEX                     R(X1)=     -1.000           I(X1)=      0.707
                            R(X2)=     -1.000           I(X2)=     -0.707

SET NO.  3
A =     0.              B =     5.67            C =   -11.83
LINEAR                         X =      2.086

SET NO.  4
A =   536.28            B =  -275.61            C =     2.11
REAL                          X1 =      0.506             X2 =      0.008

END OF J.DOE
全出力
           $LIST
           $DATE          051819


           $JOB           QUADRATIC EQUATION
           $EXECUTE       IBJOB
IBJOB VERSION 5 HAS CONTROL.
$IBJOB         GO
$IBFTC QUADRA
                                                                       05/18/19                            PAGE  1
           QUADRA     -  EFN   SOURCE STATEMENT  -  IFN(S)  -


C      SOLUTION OF QUADRATIC EQUATION
C      (BASED ON CODE IN FORTRAN II)
      COMPLEX COMP(2)

    1 READ(5, 51) ANAME, N                                                          1
   51 FORMAT(A6, I2)
      WRITE(6, 52) ANAME                                                            3
   52 FORMAT(1H1,33HROOTS OF QUADRATIC EQUATIONS FROM A6)
      DO 21 I = 1, N
         READ(5, 53) A, B, C                                                        6
   53    FORMAT(3F10.2)
         WRITE(6, 54) I, A, B, C                                                    7
   54    FORMAT(1H0,8HSET NO. I2/5H A = F8.2,12X,4HB = F8.2,12X,4HC =
     +   F8.2)
         IF (A.NE.0.) GO TO 10
         IF (B.NE.0.) GO TO  7
         WRITE(6, 59)                                                               13
   59    FORMAT(9H NO ROOTS)
         GO TO 21
    7    RLIN = -C/B
         WRITE(6, 55) RLIN                                                          16
   55    FORMAT(7H LINEAR,25X,4HX = F10.3)
         GO TO 21
   10    D = B**2 - 4.*A*C
         IF (D.GE.0.) GO TO 17
         COMP(1) = CMPLX(-B/(2.*A), SQRT(-D)/(2.*A))                                22
         COMP(2) = CONJG(COMP(1))
         WRITE(6, 56) COMP                                                          23
   56    FORMAT(8H COMPLEX,21X,7HR(X1)= F10.3,11X,7HI(X1)= F10.3,/1H ,
     +   28X,7HR(X2)= F10.3,11X,7HI(X2)= F10.3)
         GO TO 21
   17    SQRTD = SQRT(D)                                                            27
         REAL1 = (-B + SQRTD)/(2.*A)
         REAL2 = (-B - SQRTD)/(2.*A)
         WRITE(6, 57) REAL1, REAL2                                                  28
   57    FORMAT(6H REAL 25X,5HX1 = F10.3,13X,5HX2 = F10.3)
   21 CONTINUE
      WRITE(6, 58) ANAME                                                            31
   58 FORMAT(8H0END OF A6)
      GO TO 1
      END
                                                                       05/18/19                            PAGE  2
           QUADRA                                    STORAGE  MAP

                                                      MAIN PROGRAM
                                                DIMENSIONED PROGRAM VARIABLES

SYMBOL      LOCATION      TYPE            SYMBOL      LOCATION      TYPE            SYMBOL      LOCATION      TYPE
COMP         00001         C
                                              UNDIMENSIONED PROGRAM VARIABLES

SYMBOL      LOCATION      TYPE            SYMBOL      LOCATION      TYPE            SYMBOL      LOCATION      TYPE
ANAME        00005         R              N            00006         I              I            00007         I
A            00010         R              B            00011         R              C            00012         R
RLIN         00013         R              D            00014         R              SQRTD        00015         R
REAL1        00016         R              REAL2        00017         R
                                                      ENTRY POINTS

      ......      SECTION     2
                                                      SUBROUTINES CALLED

      .FRDD.      SECTION     3                 .FWRD.      SECTION     4                 SQRT        SECTION     5
      .FSLO.      SECTION     6                 .UN05.      SECTION     7                 .FRTN.      SECTION     8
      .FCNV.      SECTION     9                 .UN06.      SECTION     10                .FFIL.      SECTION     11
      E.1         SECTION     12                E.2         SECTION     13                E.3         SECTION     14
      E.4         SECTION     15                SYSLOC      SECTION     16
                                                EFN   IFN   CORRESPONDENCE

EFN         IFN         LOCATION          EFN         IFN         LOCATION          EFN         IFN         LOCATION
1            1A          00130            51          FORMAT       00035            52          FORMAT       00037
21           29A         00376            53          FORMAT       00047            54          FORMAT       00051
10           18A         00251            7            15A         00233            59          FORMAT       00064
55          FORMAT       00067            17           26A         00335            56          FORMAT       00074
57          FORMAT       00115            58          FORMAT       00125
 THE FIRST LOCATION NOT USED BY THIS PROGRAM IS 00427.
                                                                       05/18/19                            PAGE  3


$DATA
               IBLDR                                                   05/18/19                            PAGE  4
           * MEMORY MAP *



SYSTEM                               00000 THRU  02717
FILE BLOCK ORIGIN                    02720
FILES      1.     UNIT05
           2.     UNIT06
FILE LIST ORIGIN                     02750
PRE-EXECUTION INITIALIZATION         02754
CALL ON OBJECT PROGRAM               02777
OBJECT PROGRAM                       03004 THRU  16374

      DECK  ORIGIN       CONTROL SECTIONS (/NAME/=NON 0 LENGTH, (LOC)=DELETED, 'LOC'=MOVED, *=NOT REFERENCED)

  1. QUADRA  03004       ......  03417 *
  2. .LXCON  03433       .LXSTR  03433 *   .LXSTP  03436     .LXOUT  03504 *   .LXERR  03513     .LXCAL  03516 *
                         .LXRTN  03516     IBEXIT  03516 *   .DBCLS  03700 *   .LXARG  04047 *   .L0     04072 *
                         .CLSE   04100     .LFBL   04101 *   .LUNB   04102     .DFOUT  04103
  3. .IODEF  04107       .DEFIN  04107     .ATTAC  04113 *   .CLOSE  04115     .OPEN   04117     .READ   04121
                         .WRITE  04123     .BSR    04133 *   .READR  04143     .RELES  04145 *   .LAREA  04156
                         .LFBLK  04174     .LTSX   04177 *   .RLHLD  04207 *   .AREA1  04212     .LUNBL  04220
                         .ENTRY  04224     .GOA    04261     .GO     04265     .DERR   04301     .NOPXI  04302
                         .COMXI  04304     .EX34   04326
  4. .LXSL   04333       .LXSLB  04333 *   .LXSEL  04334     .LXSL1  04335     .LXTST  04340 *   .LXOVL  04403 *
                         .LXMOD  04445 *   .LXIND  04471 *   .LXDIS  04474 *   .LXFLG  04475 *   .LTCH   04476
  5. .FPTRP  04505       .FFPT.  04505 *   .FPOUT  04634 *   .FPARG  04642 *  /.COUNT/ 04644 *   OVFLOW  04710 *
  6. .ERAS.  04715       E.1     04715     E.2     04716     E.3     04717     E.4     04720
  7. FXEM    04721       .FXEM.  04721     TRACE   04727 *  /.OPTW./ 05264 *
  8. FCOM    05300       .FCOM.  05300    /FORCOM/ 05403 *
  9. FRDD    05415       .FRDD.  05415     .FWRD.  05420
 10. FIOS    05532       .FIOS.  05532     .FSEL.  05721     .FRTB.  05736     .FRTD.  05753    /.FBF1./ 06205 *
 11. FIOH    06211       .FIOH.  06211     .FCNV.  06770     .FFIL.  07065     .FRTN.  07065
 12. FCNV    07204       .FCON.  07204
 13. FIOT    12272       .FIOT.  12272     .FIOE.  12363
 14. UN05    12411       .UN05.  12411
 15. UN06    12412       .UN06.  12412     ..UN06  12412 *
 16. FSQR    12413       SQRT    12413
 17. FSLDO   12466       .FSLO.  12504     .FSDO.  12512 *
 18. FSLO    12523       .SLO.   12523     .SLO2.  12531     .SDO.   12536     .SDO2.  12550
 19. .IOCS   12562       .L(0)   12562     .MONSW  12602     .TEOR   12651     .DEFI.  12731     .JOINX  12775 *
                         .CLOS.  13014     .ATTC.  13027     .SH1    13241 *   .SH9    13303 *   .OPEN.  13324
                         .OP4    13352 *   .OP7    13403 *   .OP9.2  13417 *   .RLSE.  13471     .RER2.  13471
                         .READ.  13472     .RER1.  13515     .WRIT.  13517     .MNT1A  13707 *   .EOFEX  13770 *
                         .FEEIT  14040     .GTIOX  14061     .RW7    14177 *   .RE7    14616 *   .ENDTR  15257
                         .SEL59  15261 *   .BSR.   15700     .EOTOF  16025     .ETOF3  16033 *   .SWITC  16062
                         .TCHEX  16367     .BASIO  16372 *
 20. .IOCSM  16375

I/O BUFFERS                          16375 THRU  77764

UNUSED CORE                          77765 THRU  77777


ROOTS OF QUADRATIC EQUATIONS FROMJ.DOE

SET NO.  1
A =     2.00            B =     4.00            C =     1.00
REAL                          X1 =     -0.293             X2 =     -1.707

SET NO.  2
A =     2.00            B =     4.00            C =     3.00
COMPLEX                     R(X1)=     -1.000           I(X1)=      0.707
                            R(X2)=     -1.000           I(X2)=     -0.707

SET NO.  3
A =     0.              B =     5.67            C =   -11.83
LINEAR                         X =      2.086

SET NO.  4
A =   536.28            B =  -275.61            C =     2.11
REAL                          X1 =      0.506             X2 =      0.008

END OF J.DOE
        141 LINES OUTPUT.
           $STOP


            PERIPHERAL UNIT POSITIONS AT END OF JOBS

            SYSPP1  IS   A8    REC. 00022, FILE 00000
            SYSOU1  IS   A4    REC. 00149, FILE 00000
            SYSIN1  IS   A3    REC. 00005, FILE 00001

           END OF JOBS


EOF  END OF OUTPUT

【メモ帳】gfortran-9

gfortran version 9.0.1

手抜きインストールとして個人リポジトリ利用が出来るようです。

バックドア混入コンパイラの記事を読んだばかりですが突撃です。
https://ascii.jp/elem/000/001/858/1858028/


askubuntu.com


sudo add-apt-repository ppa:jonathonf/gcc-9.0
sudo apt-get install gfortran-9
$ gfortran-9 --version
GNU Fortran (Ubuntu 9-20190428-1ubuntu1~18.04.york0) 9.0.1 20190428 (prerelease) [gcc-9-branch revision 270630]
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.


gcc.gnu.org

文法面では、大幅な進歩はないようです。

gfortran 9 (current development version)

GCC 9 releases, GCC 9 release notes, documentation

Fortran 2003

Asynchronous I/O is now fully supported; a program needs to be linked against the pthreads library in order to use it.

Fortran 2008

The BACK argument for MINLOC and MAXLOC has been implemented.

FINDLOC has been implemented.

IS_CONTIGUOUS has been implemented.

Direct access to the real and imaginary parts of a complex variable via c%re and c%im has been implemented.

Type parameter inquiry via str%len and a%kind has been implemented.

Fortran 2018

C descriptors, the ISO_Fortran_binding.h file and associated procedures have been implemented.

The MAX and MIN intrinsics are no longer guaranteed to return any particular value in case one of the arguments is a NaN. Note that this conforms to the Fortran standard and to what other Fortran compilers do. If there is a need to handle that case in some specific way, one needs to explicitly check for NaN's before calling MAX or MIN, e.g. by using the IEEE_IS_NAN function from the intrinsic module IEEE_ARITHMETIC.

Introduction to Computational Economics Using Fortran

Introduction to Computational Economics Using Fortran

コボルのおばちゃま

よくみると、バックドア付加コンパイラ記事の双子のお姉さんの着ているシャツの絵柄は、COBOLのおばちゃまグレース・ホッパー女史です。

狙われるコンパイラ……“バックドア入りアプリ量産”のリスクと対策


https://ascii.jp/elem/000/001/858/1858028/

f:id:fortran66:20190516130432j:plain
COBOL

【ネタ】英シンクレア ZX 用 FORTRAN

シンクレア

昭和マイコンブームのころ世界各地で独自のマイコンが登場しましたが、イギリスでもスコットランドのシンクレア社が ZX マイコンを出しておりました。ZX シリーズはいくつかあって、spectrum は後期型の高級なものだと思います。

そのシンクレア ZX Spectrum 用の FORTRAN コンパイラが 40 年ぶりに英人某の屋根裏の物置部屋にあったカセットテープから発掘され、エミュレータで稼働させられたようです。

www.walkingrandomly.com

素数を求めていますが、プログラムはエラトステネスの篩の様であって、MOD で余りを計算しているので、実はエラトステネスの篩になってない負荷の重い計算をしています。Hutton の Haskell 本もそうなっているので、英伝統芸なのでしょう。本来は表にチェックを入れるだけで割り算無用です。まぁいちいち割れば、配列が要らないのでメモリー節約になりますが。

プログラミングHaskell

プログラミングHaskell

なお今一つイギリス製のマイコンとしては、 BBC コンピュータがあります。BBC コンピュータはイギリス教育テレビのマイコン教材用で、現在ブイブイ言わせている ARM につながる血統を持つマイコンです。インラインアセンブラ付きの BASIC を装備しており、それは究極の BASIC として知られていました。

マイコンFORTRAN としては、他に APPLE IICOMMODORE 64、汎用 CP/M などの存在が確認されています。なお Microsoft が BASIC の次に発売したプログラム言語は FORTRAN コンパイラです。

FORTRAN は雑草のようにどこにでも生える」という言葉がありますが、これは FORTRAN が昔の Lingua Franca であったことを指しています。

【朗報】WSL 上でも Intel Fortran v.19.1 で coarray 稼働

WSL Ubuntu 18.04 CAF Intel Fortran v.19.1

Windows Subsystem for LinuxUbuntu 18.04 上で、Intel Fortran が使えます。

install は、GUI 版ではなくコマンドライン版でやりました。途中でる警告は無視。一般ユーザー権限でもインストール可能で、自分のホームディレクト上に install されます。

おととしは install できず、去年は install 出来るが coarray 不可でしたが、今年は coarray も動きました。(ただし、正常終了しないことが多いようですw)日々新たにそしてまた新たに。堯の教えに忠実の模様です。

fortran66.hatenablog.com

path などは手動で設定する必要があります。

export PATH="~/intel/bin:$PATH"
source ~/intel/bin/ifortvars.sh intel64

#source ~/intel/mkl/bin/mklvars.sh intel64

実行例

$ cat caf2020.f90
    program Console5
        implicit none
        integer :: im, ne
        real(kind(0.0d0)) :: x

        im = this_image()
        ne = num_images()

        if (im == 1) x = 1111.1111
        call co_broadcast(x, 1) ! implicit sync all?

        print *, im, x
        sync all
        stop
    end program Console5

$ ifort -coarray=shared -coarray-num-images=4 caf2020.f90
$ ./a.out
           1   1111.11108398438
           3   1111.11108398438
           2   1111.11108398438
           4   1111.11108398438

===================================================================================
=   BAD TERMINATION OF ONE OF YOUR APPLICATION PROCESSES
=   RANK 3 PID 338 RUNNING AT HP8
=   KILLED BY SIGNAL: 9 (Killed)
===================================================================================
$

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Numerical Methods of Mathematics Implemented in Fortran (Forum for Interdisciplinary Mathematics)

Numerical Methods of Mathematics Implemented in Fortran (Forum for Interdisciplinary Mathematics)

【メモ帳】ベル音消す

https://linuxfan.info/bow-stop-beep

bash

echo "set bell-style none" >> ~/.inputrc

vim

echo "set visualbell t_vb=" >> ~/.vimrc

【メモ帳】Intel Fortran v.19.1 beta 試し

coarray 集合演算 co_xxx

整数でしか正しい答えを与えない上に、result_image を省略すれば broadcast するはずなのに、image 0 は存在しないとかいう実行エラーを吐く。

beta だからしょうがないネ!

ソース・プログラム

co_sum のみならず co_min, co_max も同様。
大寒小寒、山から小僧が飛んできた~

    program caf2020
        implicit none
        integer :: nm, im
        im = this_image()
        nm = num_images()
        block
           integer :: ix 
           ix = im * 10 
           print *, 'number of images=', nm, 'image no.=', im, 'ix=', ix
           call co_sum(ix, result_image = 1)   
           if (im == 1) print *, 'sum of ix=', ix
        end block  
        
        sync all
        
        block
           real :: x 
           x = im * 10.0
           print *, 'number of images=', nm, 'image no.=', im, ' x=', x
           call co_sum(x, result_image = 1)   
           if (im == 1) print *, 'sum of  x=', x
        end block  
        sync all 
        stop
    end program caf2020

実行結果

 number of images= 8 image no.= 1 ix= 10
 number of images= 8 image no.= 3 ix= 30
 number of images= 8 image no.= 4 ix= 40
 number of images= 8 image no.= 2 ix= 20
 number of images= 8 image no.= 7 ix= 70
 number of images= 8 image no.= 6 ix= 60
 number of images= 8 image no.= 8 ix= 80
 number of images= 8 image no.= 5 ix= 50
 sum of ix= 360
 number of images= 8 image no.= 5  x= 50.00000
 number of images= 8 image no.= 1  x= 10.00000
 sum of  x= 10.00000
 number of images= 8 image no.= 2  x= 20.00000
 number of images= 8 image no.= 3  x= 30.00000
 number of images= 8 image no.= 6  x= 60.00000
 number of images= 8 image no.= 4  x= 40.00000
 number of images= 8 image no.= 7  x= 70.00000
 number of images= 8 image no.= 8  x= 80.00000

co_bradcast は実数もおk 単倍4皆

ソース・プログラム

    program Console5
        implicit none
        integer :: im, ne
        real(kind(0.0d0)) :: x 
        
        im = this_image()
        ne = num_images()
        
        if (im == 1) x = 1111.1111
        call co_broadcast(x, 1) ! implicitly sync all?   
        
        print *, im, x
        sync all
        stop
    end program Console5

実行結果

 4 1111.11108398438
 3 1111.11108398438
 7 1111.11108398438
 8 1111.11108398438
 1 1111.11108398438
 2 1111.11108398438
 6 1111.11108398438
 5 1111.11108398438

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

select rank

y =>xの associate 部分がまたもおかしい。y へのポインタ関連付けを省略できないのに、y に正しい情報が入っていない。x を生で呼べば解決するが。バグだらけ。

[1:5] の構文は非標準だけれど Thinking Machine 社の CM Fortran に淵源する由緒ある記法なので使うw

forall は、1行で書けてインデックスを一時変数としてその場で使い捨てられるので便利。

ソース・プログラム

    module m_test
        implicit none
    contains
        subroutine sub(x)
            real, intent(in) :: x(..)
            select rank (y => x)
            rank (0)
                print *, 'scalar ', y
            rank (1)
                print *, '1D array ', size(y), y
            rank default
                print *, 'nD array of rank', rank(x), 'shape ', shape(x)
                print *, 'nD array of rank', rank(y), 'shape '!, shape(y) !Internal compiler error
            end select 
        end subroutine sub
    end module m_test

    
    program Console4
        use m_test
        implicit none
        real :: x, y(5), z(2, 2, 2)
        x = 99.0
        y = real([1:5]) ! non-standard intel  (CM Fortran) ! real([(i, i = 1, 5)])
        forall (integer:: i = 1:2, j = 1:2, k = 1:2) z(i, j, k) = real(i + 10 * j + 100 * k)
        print *, z
        
        call sub(x)
        call sub(y)
        call sub(z)
    end program Console4

実行結果

   111.0000       112.0000       121.0000       122.0000       211.0000
   212.0000       221.0000       222.0000
 scalar    99.00000
 1D array            5   1.000000       2.000000       3.000000
   4.000000       5.000000
 nD array of rank           3 shape            2           2           2
 nD array of rank  -858993460 shape