TAP_support/ADFirstAidKit/testMemSizef.f

b4daa24319 Shre*0001 C$Id$
                0002       program testmemsize
                0003       external countsetbits
                0004       integer countsetbits
                0005       integer i, j, ti(10), ci0(10), ci1(10)
                0006       integer*8 i8, ti8(10), ci80(10), ci81(10)
                0007       real r, tr(10), cr0(10), cr1(10)
                0008       real*4 r4, tr4(10), cr40(10), cr41(10)
                0009       real(4) rp4, trp4(10), crp40(10), crp41(10)
                0010       real*8 r8, tr8(10), cr80(10), cr81(10)
                0011       real(8) rp8, trp8(10), crp80(10), crp81(10)
                0012 c      real*16 r16, tr16(10), cr160(10), cr161(10)
                0013       double precision d, td(10), cd0(10), cd1(10)
                0014       complex cx, tcx(10), ccx0(10), ccx1(10)
                0015       complex*8 cx8, tcx8(10), ccx80(10), ccx81(10)
                0016       complex(8) cxp8, tcxp8(10), ccxp80(10), ccxp81(10)
                0017       complex*16 cx16, tcx16(10), ccx160(10), ccx161(10)
                0018       double complex cxd, tcxd(10), ccxd0(10), ccxd1(10)
                0019       logical l, tl(10), cl0(10), cl1(10)
                0020       character c, tc(10), cc0(10), cc1(10)
                0021 c
                0022       integer tci0(10000)
                0023       common /cbuf0/ tci0
                0024       equivalence (tci0(1),ci0(1))
                0025       equivalence (tci0(1),ci80(1))
                0026       equivalence (tci0(1),cr0(1))
                0027       equivalence (tci0(1),cr40(1))
                0028       equivalence (tci0(1),crp40(1))
                0029       equivalence (tci0(1),cr80(1))
                0030       equivalence (tci0(1),crp80(1))
                0031 c      equivalence (tci0(1),cr160(1))
                0032       equivalence (tci0(1),cd0(1))
                0033       equivalence (tci0(1),ccx0(1))
                0034       equivalence (tci0(1),ccx80(1))
                0035       equivalence (tci0(1),ccxp80(1))
                0036       equivalence (tci0(1),ccx160(1))
                0037       equivalence (tci0(1),ccxd0(1))
                0038       equivalence (tci0(1),cl0(1))
                0039       equivalence (tci0(1),cc0(1))
                0040 c
                0041       integer tci1(10000)
                0042       common /cbuf1/ tci1
                0043       equivalence (tci1(1),ci1(1))
                0044       equivalence (tci1(1),ci81(1))
                0045       equivalence (tci1(1),cr1(1))
                0046       equivalence (tci1(1),cr41(1))
                0047       equivalence (tci1(1),crp41(1))
                0048       equivalence (tci1(1),cr81(1))
                0049       equivalence (tci1(1),crp81(1))
                0050 c      equivalence (tci1(1),cr161(1))
                0051       equivalence (tci1(1),cd1(1))
                0052       equivalence (tci1(1),ccx1(1))
                0053       equivalence (tci1(1),ccx81(1))
                0054       equivalence (tci1(1),ccxp81(1))
                0055       equivalence (tci1(1),ccx161(1))
                0056       equivalence (tci1(1),ccxd1(1))
                0057       equivalence (tci1(1),cl1(1))
                0058       equivalence (tci1(1),cc1(1))
                0059 c
                0060       integer nb
                0061 c
                0062       do i = 1,10
                0063          ti(i) = (i-1)*i*i*i*i*i*i*i*i*i
                0064          ti8(i) = (i-1)*i*i*i*i*i*i*i*i*i
                0065          tr(i) = (i-1)*i*exp(2.0*i+0.001)
                0066          tr4(i) = (i-1)*i*exp(2.0*i+0.001)
                0067          trp4(i) = (i-1)*i*exp(2.0*i+0.001)
                0068          tr8(i) = (i-1)*i*exp(2.0*i+0.001)
                0069          trp8(i) = (i-1)*i*exp(2.0*i+0.001)
                0070 c         tr16(i) = (i-1)*i*exp(2.0*i+0.001)
                0071          td(i) = (i-1)*i*exp(2.d0*i+1.d-3)
                0072          tcx(i) = cmplx(tr(i),tr(i)+12.3)
                0073          tcxp8(i) = cmplx(trp8(i),tr(i)+12.3)
                0074          tcx8(i) = cmplx(tr8(i),tr(i)+12.3)
                0075          tcx16(i) = cmplx(tr8(i),tr(i)+12.3)
                0076          tcxd(i) = cmplx(td(i),td(i)+12.3d0)
                0077          tl(i) = (((i/3)*3).eq.i)
                0078       enddo
                0079       tc(1) = 'a'
                0080       tc(2) = 'b'
                0081       tc(3) = 'c'
                0082       tc(4) = 'd'
                0083       tc(5) = 'e'
                0084       tc(6) = 'f'
                0085       tc(7) = 'g'
                0086       tc(8) = 'h'
                0087       tc(9) = 'i'
                0088       tc(10) = 'j'
                0089
                0090       i = 12345
                0091       i8 = 12345
                0092       r = sqrt(12345.0)
                0093       r4 = sqrt(12345.0)
                0094       rp4 = sqrt(12345.0)
                0095       r8 = sqrt(12345.0)
                0096       rp8 = sqrt(12345.0)
                0097 c      r16 = sqrt(12345.0)
                0098       d = sqrt(12345.d0)
                0099       cx = cmplx(-12.34,56.78)
                0100       cx8 = cmplx(-12.34,56.78)
                0101       cxp8 = cmplx(-12.34,56.78)
                0102       cx16 = cmplx(-12.34,56.78)
                0103       cxd = cmplx(-12.34d0,56.78d0)
                0104       l = .true.
                0105       c = 'z'
                0106 c
                0107       call allzero(tci0(1))
                0108       call allones(tci1(1))
                0109 c      call displaybits(tci0(1), 3)
                0110 c      call displaybits(tci1(1), 3)
                0111       print *, ' '
                0112 c
                0113       call allzero(tci0(1))
                0114       call allones(tci1(1))
                0115       do j=1,8
                0116          ci0(j) = ti(j+2)
                0117          ci1(j) = ti(j+2)
                0118       enddo
                0119       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0120       print 100, 'INTEGER:', nb, ' bytes'
                0121 c
                0122       call allzero(tci0(1))
                0123       call allones(tci1(1))
                0124       do j=1,8
                0125          ci80(j) = ti8(j+2)
                0126          ci81(j) = ti8(j+2)
                0127       enddo
                0128       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0129       print 100, 'INTEGER*8:', nb, ' bytes'
                0130 c
                0131       call allzero(tci0(1))
                0132       call allones(tci1(1))
                0133       do j=1,8
                0134          cr0(j) = tr(j+2)
                0135          cr1(j) = tr(j+2)
                0136       enddo
                0137       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0138       print 100, 'REAL:', nb, ' bytes'
                0139 c
                0140       call allzero(tci0(1))
                0141       call allones(tci1(1))
                0142       do j=1,8
                0143          cr40(j) = tr4(j+2)
                0144          cr41(j) = tr4(j+2)
                0145       enddo
                0146       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0147       print 100, 'REAL*4:', nb, ' bytes'
                0148 c
                0149       call allzero(tci0(1))
                0150       call allones(tci1(1))
                0151       do j=1,8
                0152          crp40(j) = trp4(j+2)
                0153          crp41(j) = trp4(j+2)
                0154       enddo
                0155       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0156       print 100, 'REAL(4):', nb, ' bytes'
                0157 c
                0158       call allzero(tci0(1))
                0159       call allones(tci1(1))
                0160       do j=1,8
                0161          cr80(j) = tr8(j+2)
                0162          cr81(j) = tr8(j+2)
                0163       enddo
                0164       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0165       print 100, 'REAL*8:', nb, ' bytes'
                0166 c
                0167       call allzero(tci0(1))
                0168       call allones(tci1(1))
                0169       do j=1,8
                0170          crp80(j) = trp8(j+2)
                0171          crp81(j) = trp8(j+2)
                0172       enddo
                0173       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0174       print 100, 'REAL(8):', nb, ' bytes'
                0175 c
                0176       call allzero(tci0(1))
                0177       call allones(tci1(1))
                0178       do j=1,8
                0179          cd0(j) = td(j+2)
                0180          cd1(j) = td(j+2)
                0181       enddo
                0182       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0183       print 100, 'DOUBLE PRECISION:', nb, ' bytes'
                0184 c
                0185       call allzero(tci0(1))
                0186       call allones(tci1(1))
                0187       do j=1,8
                0188          ccx0(j) = tcx(j+2)
                0189          ccx1(j) = tcx(j+2)
                0190       enddo
                0191       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0192       print 100, 'COMPLEX:', nb, ' bytes'
                0193 c
                0194       call allzero(tci0(1))
                0195       call allones(tci1(1))
                0196       do j=1,8
                0197          ccx80(j) = tcx8(j+2)
                0198          ccx81(j) = tcx8(j+2)
                0199       enddo
                0200       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0201       print 100, 'COMPLEX*8:', nb, ' bytes'
                0202 c
                0203       call allzero(tci0(1))
                0204       call allones(tci1(1))
                0205       do j=1,8
                0206          ccxp80(j) = tcxp8(j+2)
                0207          ccxp81(j) = tcxp8(j+2)
                0208       enddo
                0209       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0210       print 100, 'COMPLEX(8):', nb, ' bytes'
                0211 c
                0212       call allzero(tci0(1))
                0213       call allones(tci1(1))
                0214       do j=1,8
                0215          ccx160(j) = tcx16(j+2)
                0216          ccx161(j) = tcx16(j+2)
                0217       enddo
                0218       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0219       print 100, 'COMPLEX*16:', nb, ' bytes'
                0220 c
                0221       call allzero(tci0(1))
                0222       call allones(tci1(1))
                0223       do j=1,8
                0224          ccxd0(j) = tcxd(j+2)
                0225          ccxd1(j) = tcxd(j+2)
                0226       enddo
                0227       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0228       print 100, 'DOUBLE COMPLEX:', nb, ' bytes'
                0229 c
                0230       call allzero(tci0(1))
                0231       call allones(tci1(1))
                0232       do j=1,8
                0233          cl0(j) = tl(j+2)
                0234          cl1(j) = tl(j+2)
                0235       enddo
                0236       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0237       print 100, 'LOGICAL:', nb, ' bytes'
                0238 c
                0239       call allzero(tci0(1))
                0240       call allones(tci1(1))
                0241       do j=1,8
                0242          cc0(j) = tc(j+2)
                0243          cc1(j) = tc(j+2)
                0244       enddo
                0245       nb = countsetbits(tci0(1), tci1(1), 8, 100)
                0246       print 100, 'CHARACTER:', nb, ' bytes'
                0247 c
                0248  100  format(a18,i3,a6)
                0249       end