1c----------------------------------------------------------------------- 2c 3c R : A Computer Language for Statistical Data Analysis 4c Copyright (C) 1999-2020 The R Core Team 5c 6c This program is free software; you can redistribute it and/or modify 7c it under the terms of the GNU General Public License as published by 8c the Free Software Foundation; either version 2 of the License, or 9c (at your option) any later version. 10c 11c This program is distributed in the hope that it will be useful, 12c but WITHOUT ANY WARRANTY; without even the implied warranty of 13c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14c GNU General Public License for more details. 15c 16c You should have received a copy of the GNU General Public License 17c along with this program; if not, a copy is available at 18c https://www.R-project.org/Licenses/ 19c 20c----------------------------------------------------------------------- 21 22C These now all call C functions via F77_NAME(.) in ./print.c : 23 24 subroutine intpr(label, nchar, data, ndata) 25 integer nchar, ndata 26 character*(*) label 27 integer data(ndata) 28 integer nc 29 nc = nchar 30 if(nc .lt. 0) nc = len(label) 31 call intpr0(label, nc, data, ndata) 32 end 33 34 subroutine realpr(label, nchar, data, ndata) 35 integer nchar, ndata 36 character*(*) label 37 real data(ndata) 38 integer nc 39 nc = nchar 40 if(nc .lt. 0) nc = len(label) 41 call realp0(label, nc, data, ndata) 42 end 43 44 subroutine dblepr(label, nchar, data, ndata) 45 integer nchar, ndata 46 character*(*) label 47 double precision data(ndata) 48 integer nc 49 nc = nchar 50 if(nc .lt. 0) nc = len(label) 51 call dblep0(label, nc, data, ndata) 52 end 53 54c Avoid 'Rank mismatch warning from gcc 10' 55 subroutine intpr1(label, nchar, var) 56 integer nchar 57 character*(*) label 58 integer var, data(1) 59 integer nc 60 nc = nchar 61 if(nc .lt. 0) nc = len(label) 62 data(1) = var 63 call intpr0(label, nc, data, 1) 64 end 65 66 subroutine realpr1(label, nchar, var) 67 integer nchar 68 character*(*) label 69 real var, data(1) 70 integer nc 71 nc = nchar 72 if(nc .lt. 0) nc = len(label) 73 data(1) = var 74 call realp0(label, nc, data, 1) 75 end 76 77 subroutine dblepr1(label, nchar, var) 78 integer nchar 79 character*(*) label 80 double precision var, data(1) 81 integer nc 82 nc = nchar 83 if(nc .lt. 0) nc = len(label) 84 data(1) = var 85 call dblep0(label, nc, data, 1) 86 end 87 88 subroutine labelpr(label, nchar) 89 integer nchar 90 character*(*) label 91 integer data(1) 92 integer nc 93 nc = nchar 94 if(nc .lt. 0) nc = len(label) 95 data(1) = 0 96 call intpr0(label, nc, data, 0) 97 end 98 99C R-only Fortran versions of error and warning 100 subroutine rexit(msg) 101 character*(*) msg 102 call rexitc(msg, len(msg)) 103 end 104 105 subroutine rwarn(msg) 106 character*(*) msg 107 call rwarnc(msg, len(msg)) 108 end 109