1! Program to test SELECTED_REAL_KIND intrinsic function. 2Program test_sr_kind 3 integer res, i4, i8, t 4 real*4 r4 5 real*8 r8 6 7 i4 = int (log10 (huge (r4))) 8 t = - int (log10 (tiny (r4))) 9 if (i4 .gt. t) i4 = t 10 11 i8 = int (log10 (huge (r8))) 12 t = - int (log10 (tiny (r8))) 13 if (i8 .gt. t) i8 = t 14 15 res = selected_real_kind (r = i4) 16 if (res .ne. 4) STOP 1 17 18 res = selected_real_kind (r = i8) 19 if (res .ne. 8) STOP 2 20 21! We can in fact have kinds wider than r8. How do we want to check? 22! res = selected_real_kind (r = (i8 + 1)) 23! if (res .ne. -2) STOP 3 24 25 res = selected_real_kind (p = precision (r4)) 26 if (res .ne. 4) STOP 4 27 28 res = selected_real_kind (p = precision (r4), r = i4) 29 if (res .ne. 4) STOP 5 30 31 res = selected_real_kind (p = precision (r4), r = i8) 32 if (res .ne. 8) STOP 6 33 34! res = selected_real_kind (p = precision (r4), r = i8 + 1) 35! if (res .ne. -2) STOP 7 36 37 res = selected_real_kind (p = precision (r8)) 38 if (res .ne. 8) STOP 8 39 40 res = selected_real_kind (p = precision (r8), r = i4) 41 if (res .ne. 8) STOP 9 42 43 res = selected_real_kind (p = precision (r8), r = i8) 44 if (res .ne. 8) STOP 10 45 46! res = selected_real_kind (p = precision (r8), r = i8 + 1) 47! if (res .ne. -2) STOP 11 48 49! res = selected_real_kind (p = (precision (r8) + 1)) 50! if (res .ne. -1) STOP 12 51 52! res = selected_real_kind (p = (precision (r8) + 1), r = i4) 53! if (res .ne. -1) STOP 13 54 55! res = selected_real_kind (p = (precision (r8) + 1), r = i8) 56! if (res .ne. -1) STOP 14 57 58! res = selected_real_kind (p = (precision (r8) + 1), r = i8 + 1) 59! if (res .ne. -3) STOP 15 60 61end 62 63