[go: up one dir, main page]
Menu ▾ ▴

[4cf102]: / toybox_template.f  Maximize  Restore  History

Download this file

146 lines (145 with data), 4.8 kB 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
        module dumpster

            interface dump

                module procedure d_dump, f_dump, i8_dump, i4_dump

                module procedure i2_dump, i1_dump, l8_dump, l4_dump

                module procedure l2_dump, l1_dump

            end interface

        contains

            subroutine d_dump(x)

                implicit none

                real(kind=8) :: x

                integer(kind=1) :: b(8)

                integer :: i

                print '(A)', 'real (kind=8)'

                b = transfer(x,b);

                print '(8(Z2.2,1X))', (b(i),i=1,8)

                return

            end subroutine

            subroutine f_dump(x)

                implicit none

                real(kind=4) :: x

                integer :: i

                integer(kind=1) :: b(4)

                print '(A)', 'real (kind=4)'

                b = transfer(x,b);

                print '(4(Z2.2,1X))', (b(i),i=1,4)

                return

            end subroutine

            subroutine i8_dump(x)

                implicit none

                integer(kind=8) :: x

                integer :: i

                integer(kind=1) :: b(8)

                print '(A)', 'integer (kind=8)'

                b = transfer(x,b);

                print '(8(Z2.2,1X))', (b(i),i=1,8)

                return

            end subroutine

            subroutine i4_dump(x)

                implicit none

                integer(kind=4) :: x

                integer :: i

                integer(kind=1) :: b(4)

                print '(A)', 'integer (kind=4)'

                b = transfer(x,b);

                print '(4(Z2.2,1X))', (b(i),i=1,4)

                return

            end subroutine

            subroutine i2_dump(x)

                implicit none

                integer(kind=2) :: x

                integer :: i

                integer(kind=1) :: b(2)

                print '(A)', 'integer (kind=2)'

                b = transfer(x,b);

                print '(2(Z2.2,1X))', (b(i),i=1,2)

                return

            end subroutine

            subroutine i1_dump(x)

                implicit none

                integer(kind=1) :: x

                integer :: i

                print '(A)', 'integer (kind=1)'

                print '(Z2.2)', x

                return

            end subroutine

            subroutine l8_dump(x)

                implicit none

                logical(kind=8) :: x

                integer :: i

                integer(kind=1) :: b(8)

                print '(A)', 'logical (kind=8)'

                b = transfer(x,b);

                print '(8(Z2.2,1X))', (b(i),i=1,8)

                return

            end subroutine

            subroutine l4_dump(x)

                implicit none

                logical(kind=4) :: x

                integer :: i

                integer(kind=1) :: b(4)

                print '(A)', 'logical (kind=4)'

                b = transfer(x,b);

                print '(4(Z2.2,1X))', (b(i),i=1,4)

                return

            end subroutine

            subroutine l2_dump(x)

                implicit none

                logical(kind=2) :: x

                integer :: i

                integer(kind=1) :: b(2)

                print '(A)', 'logical (kind=2)'

                b = transfer(x,b);

                print '(2(Z2.2,1X))', (b(i),i=1,2)

                return

            end subroutine

            subroutine l1_dump(x)

                implicit none

                logical(kind=1) :: x

                integer :: i

                integer(kind=1) :: b

                print '(A)', 'logical (kind=1)'

                b = transfer(x,b);

                print '(Z2.2)', b

                return

            end subroutine

        end module

        program main

            use dumpster

            implicit none

            real (kind=8) :: r8

            real (kind=4) :: r4

            integer (kind=8) :: i8

            integer (kind=4) :: i4

            integer (kind=2) :: i2

            integer (kind=1) :: i1

            logical (kind=8) :: l8

            logical (kind=4) :: l4

            logical (kind=2) :: l2

            logical (kind=1) :: l1

            real (kind=4) :: abc = 12.5

            r8 = 12.50001

            r4 = 12.501

            i8 = 1001010010

            i4 = 65537

            i2 = 30231

            i1 = 65

            l8 = .true.

            l4 = .true.

            l2 = .true.

            l1 = .true.

            call dump(r8)

            call dump(r4)

            call dump(i8)

            call dump(i4)

            call dump(i2)

            call dump(i1)

            call dump(l8)

            call dump(l4)

            call dump(l2)

            call dump(l1)

            call dump(125)

            call dump(6 .lt. 10)

            call dump(abc)

            stop

        end program main