Try this patch.
Martyn
On Mon, 2014-09-22 at 22:33 +0000, Wang, Zhu wrote:
> Hello,
>
> I submitted a package which used Fortran functions isnan and lgamma. However,
> I was told that:
>
> isnan and lgamma are not Fortran 95 functions.
>
> I was asked to write 'cross-platform portable code' and so should not be
> writing GNU extensions to Fortran.
>
> See http://cran.r-project.org/web/checks/check_results_mpath.html, which will
> shortly show installation failures under Solaris.
>
> I will appreciate advice on how to replace these two functions to avoid
> failure on some platforms.
>
> Thanks in advance,
>
> Zhu Wang
>
>
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-devel@r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
-----------------------------------------------------------------------
This message and its attachments are strictly confidential. If you are
not the intended recipient of this message, please immediately notify
the sender and delete it. Since its integrity cannot be guaranteed,
its content cannot involve the sender's responsibility. Any misuse,
any disclosure or publication of its content, either whole or partial,
is prohibited, exception made of formally approved use
-----------------------------------------------------------------------
diff -uNr mpath/src/cfuns.c mpath-fixed/src/cfuns.c
--- mpath/src/cfuns.c 1970-01-01 01:00:00.000000000 +0100
+++ mpath-fixed/src/cfuns.c 2014-09-23 09:56:24.303347209 +0200
@@ -0,0 +1,5 @@
+#include <R.h>
+#include <Rmath.h>
+
+int F77_SUB(cisnan)(double *x) { return ISNAN(*x); }
+double F77_SUB(rlgamma)(double *x) { return lgammafn(*x); }
diff -uNr mpath/src/midloop.f mpath-fixed/src/midloop.f
--- mpath/src/midloop.f 2014-09-22 19:32:25.000000000 +0200
+++ mpath-fixed/src/midloop.f 2014-09-23 09:56:55.455497773 +0200
@@ -255,6 +255,8 @@
integer n, family, i
double precision dev, y(n), mu(n), theta, weights(n),tmp
+ integer cisnan
+ external cisnan
dev = 0.0D0
do 10 i=1, n
@@ -282,7 +284,7 @@
dev=dev+2*(weights(i)*(y(i)*dlog(max(1.0D0,y(i))/mu(i))-
+ (y(i)+theta)*dlog((y(i)+theta)/(mu(i) + theta))))
endif
- if(isnan(dev)) then
+ if(cisnan(dev).NE.0) then
call intpr("i=", -1, i, 1)
call dblepr("y(i)=", -1, y(i), 1)
call dblepr("mu(i)=", -1, mu(i), 1)
@@ -300,6 +302,8 @@
integer n, family, i, y0
double precision ll, y(n), mu(n), theta, w(n)
+ double precision rlgamma
+ external rlgamma
ll = 0
do 10 i=1,n
@@ -309,8 +313,8 @@
else
y0=0
endif
- ll=ll + w(i) * (lgamma(theta+y(i))-lgamma(theta)-
- + lgamma(y(i)+1)+
+ ll=ll + w(i) * (rlgamma(theta+y(i))-rlgamma(theta)-
+ + rlgamma(y(i)+1)+
+ theta*log(theta) + y(i)*log(mu(i)+y0) - (theta + y(i))*
+ log(theta + mu(i)))
else if(family .EQ. 1)then !gaussian
@@ -320,7 +324,7 @@
ll=ll + w(i)*(y(i)*log(mu(i)/(1-mu(i)))+log(1-mu(i)))
endif
else if(family .EQ. 3) then !poisson
- ll=ll + w(i)*(-mu(i) + y(i)*log(mu(i))-lgamma(y(i)+1))
+ ll=ll + w(i)*(-mu(i) + y(i)*log(mu(i))-rlgamma(y(i)+1))
endif
10 continue
return
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
