From ec654793d2f8efcd79bb8f28e670dc9ac65c0cbf Mon Sep 17 00:00:00 2001 From: eschnett Date: Wed, 26 Jan 2011 16:14:37 +0000 Subject: Replace stop commands with calls to CCTK_WARN, since stop with a string argument is not supported by all Fortran compilers. git-svn-id: http://svn.einsteintoolkit.org/cactus/EinsteinEOS/EOS_Omni/trunk@33 8e189c6b-2ab8-4400-aa02-70a9cfce18b9 --- src/nuc_eos/linterp.f | 4 +++- src/nuc_eos/linterp_many.F90 | 6 ++++-- src/nuc_eos/make.code.defn | 2 +- src/nuc_eos/nuc_eos.F90 | 29 ++++++++++++++++------------- src/nuc_eos/readtable.F90 | 8 ++++---- 5 files changed, 28 insertions(+), 21 deletions(-) diff --git a/src/nuc_eos/linterp.f b/src/nuc_eos/linterp.f index 282d090..600c11e 100644 --- a/src/nuc_eos/linterp.f +++ b/src/nuc_eos/linterp.f @@ -1,3 +1,5 @@ +#include "cctk.h" + SUBROUTINE intp3d ( x, y, z, f, kt, ft, nx, ny, nz, xt, yt, zt, . d1, d2, d3 ) c @@ -50,7 +52,7 @@ c double precision dx,dy,dz,dxi,dyi,dzi,dxyi,dxzi,dyzi,dxyzi integer n,ix,iy,iz - IF (kt .GT. ktx) STOP'***KTX**' + IF (kt .GT. ktx) call CCTK_WARN (0, '***KTX**') c c c------ determine spacing parameters of (equidistant!!!) table diff --git a/src/nuc_eos/linterp_many.F90 b/src/nuc_eos/linterp_many.F90 index 05d9c7a..d0ddb08 100644 --- a/src/nuc_eos/linterp_many.F90 +++ b/src/nuc_eos/linterp_many.F90 @@ -1,3 +1,5 @@ +#include "cctk.h" + SUBROUTINE intp3d_many ( x, y, z, f, kt, ft, nx, ny, nz, nvars, xt, yt, zt) ! implicit none @@ -43,7 +45,7 @@ real*8 dx,dy,dz,dxi,dyi,dzi,dxyi,dxzi,dyzi,dxyzi integer n,ix,iy,iz - IF (kt .GT. ktx) STOP'***KTX**' + IF (kt .GT. ktx) call CCTK_WARN(0, '***KTX**') ! ! !------ determine spacing parameters of (equidistant!!!) table @@ -65,7 +67,7 @@ ! !------- loop over all points to be interpolated ! - dO n = 1, kt + do n = 1, kt ! !------- determine location in (equidistant!!!) table ! diff --git a/src/nuc_eos/make.code.defn b/src/nuc_eos/make.code.defn index 1b5de60..26dfaaf 100644 --- a/src/nuc_eos/make.code.defn +++ b/src/nuc_eos/make.code.defn @@ -1,6 +1,6 @@ SRCS = eosmodule.F90 nuc_eos.F90 bisection.F90 \ findtemp.F90 findrho.F90 linterp_many.F90 readtable.F90 \ - linterp.f + linterp.F SUBDIRS = diff --git a/src/nuc_eos/nuc_eos.F90 b/src/nuc_eos/nuc_eos.F90 index 18928cf..b576ce0 100644 --- a/src/nuc_eos/nuc_eos.F90 +++ b/src/nuc_eos/nuc_eos.F90 @@ -17,6 +17,9 @@ ! 1 -> coming in with temperature ! 2 -> coming in with entropy ! + +#include "cctk.h" + subroutine nuc_eos_full(xrho,xtemp,xye,xenr,xprs,xent,xcs2,xdedt,& xdpderho,xdpdrhoe,xxa,xxh,xxn,xxp,xabar,xzbar,xmu_e,xmu_n,xmu_p, & xmuhat,keytemp,keyerr,rfeps) @@ -45,11 +48,11 @@ subroutine nuc_eos_full(xrho,xtemp,xye,xenr,xprs,xent,xcs2,xdedt,& keyerrr = 0 if(xrho.gt.eos_rhomax) then - stop "nuc_eos: rho > rhomax" + call CCTK_WARN(0, "nuc_eos: rho > rhomax") endif if(xrho.lt.eos_rhomin) then - stop "nuc_eos: rho < rhomin" + call CCTK_WARN (0, "nuc_eos: rho < rhomin") endif if(xye.gt.eos_yemax) then @@ -64,11 +67,11 @@ subroutine nuc_eos_full(xrho,xtemp,xye,xenr,xprs,xent,xcs2,xdedt,& if(keytemp.eq.1) then if(xtemp.gt.eos_tempmax) then - stop "nuc_eos: temp > tempmax" + call CCTK_WARN (0, "nuc_eos: temp > tempmax") endif if(xtemp.lt.eos_tempmin) then - stop "nuc_eos: temp < tempmin" + call CCTK_WARN (0, "nuc_eos: temp < tempmin") endif endif @@ -84,7 +87,7 @@ subroutine nuc_eos_full(xrho,xtemp,xye,xenr,xprs,xent,xcs2,xdedt,& !need to find temperature based on xeps call findtemp(lr,lt,y,leps,keyerrt,rfeps) if(keyerrt.ne.0) then - stop "Did not find temperature" + call CCTK_WARN (0, "Did not find temperature") endif xtemp = 10.0d0**lt @@ -206,7 +209,7 @@ subroutine nuc_eos_short(xrho,xtemp,xye,xenr,xprs,xent,xcs2,xdedt,& keyerrr = 0 if(xrho.gt.eos_rhomax) then - stop "nuc_eos: rho > rhomax" + call CCTK_WARN (0, "nuc_eos: rho > rhomax") endif if(xrho.lt.eos_rhomin*1.2d0) then @@ -227,7 +230,7 @@ subroutine nuc_eos_short(xrho,xtemp,xye,xenr,xprs,xent,xcs2,xdedt,& if(keytemp.eq.1) then if(xtemp.gt.eos_tempmax) then - stop "nuc_eos: temp > tempmax" + call CCTK_WARN (0, "nuc_eos: temp > tempmax") endif if(xtemp.lt.eos_tempmin) then @@ -329,7 +332,7 @@ subroutine nuc_eos_press_eps(xrho,xtemp,xye,xenr,xprs,& keyerrt = 0 if(xrho.gt.eos_rhomax) then - stop "nuc_eos: rho > rhomax" + call CCTK_WARN (0, "nuc_eos: rho > rhomax") endif if(xrho.lt.eos_rhomin*1.2d0) then @@ -349,7 +352,7 @@ subroutine nuc_eos_press_eps(xrho,xtemp,xye,xenr,xprs,& if(keytemp.eq.1) then if(xtemp.gt.eos_tempmax) then - stop "nuc_eos: temp > tempmax" + call CCTK_WARN (0, "nuc_eos: temp > tempmax") endif if(xtemp.lt.eos_tempmin) then @@ -361,7 +364,7 @@ subroutine nuc_eos_press_eps(xrho,xtemp,xye,xenr,xprs,& keyerr = 0 if(keytemp.gt.1) then - stop "eos_nuc_press does not support keytemp other than 0 and 1" + call CCTK_WARN (0, "eos_nuc_press does not support keytemp other than 0 and 1") endif lr = log10(xrho) @@ -408,7 +411,7 @@ subroutine nuc_eos_dpdr_dpde(xrho,xtemp,xye,xenr,xdpdrhoe,& keyerrt = 0 if(xrho.gt.eos_rhomax) then - stop "nuc_eos: rho > rhomax" + call CCTK_WARN (0, "nuc_eos: rho > rhomax") endif if(xrho.lt.eos_rhomin*1.2d0) then @@ -428,7 +431,7 @@ subroutine nuc_eos_dpdr_dpde(xrho,xtemp,xye,xenr,xdpdrhoe,& if(keytemp.eq.1) then if(xtemp.gt.eos_tempmax) then - stop "nuc_eos: temp > tempmax" + call CCTK_WARN (0, "nuc_eos: temp > tempmax") endif if(xtemp.lt.eos_tempmin) then @@ -455,7 +458,7 @@ subroutine nuc_eos_dpdr_dpde(xrho,xtemp,xye,xenr,xdpdrhoe,& xtemp = 10.0d0**lt elseif(keytemp.gt.1) then - stop "eos_nuc_press does not support keytemp > 1" + call CCTK_WARN (0, "eos_nuc_press does not support keytemp > 1") endif ! have temperature, proceed: diff --git a/src/nuc_eos/readtable.F90 b/src/nuc_eos/readtable.F90 index 4d16d2d..b865b39 100644 --- a/src/nuc_eos/readtable.F90 +++ b/src/nuc_eos/readtable.F90 @@ -42,7 +42,7 @@ subroutine nuc_eos_readtable(eos_filename) call h5dclose_f(dset_id,error) if(error.ne.0) then - stop "Could not read EOS table file" + call CCTK_WARN (0, "Could not read EOS table file") endif dims1(1)=1 @@ -51,7 +51,7 @@ subroutine nuc_eos_readtable(eos_filename) call h5dclose_f(dset_id,error) if(error.ne.0) then - stop "Could not read EOS table file" + call CCTK_WARN (0, "Could not read EOS table file") endif dims1(1)=1 @@ -60,7 +60,7 @@ subroutine nuc_eos_readtable(eos_filename) call h5dclose_f(dset_id,error) if(error.ne.0) then - stop "Could not read EOS table file" + call CCTK_WARN (0, "Could not read EOS table file") endif ! write(message,"(a25,1P3i5)") "We have nrho ntemp nye: ", nrho,ntemp,nye @@ -213,7 +213,7 @@ subroutine nuc_eos_readtable(eos_filename) accerr=accerr+error if(accerr.ne.0) then - stop "Problem reading EOS table file" + call CCTK_WARN (0, "Problem reading EOS table file") endif call h5fclose_f (file_id,error) -- cgit v1.2.3