Commits

Daniel Reynolds committed d992797

Updated a few bugs in Enzo's fortran precision handling, with respect to the 'float()' function

Comments (0)

Files changed (17)

src/enzo/cluster_maker.F

          do j=1+ibuff,ny-ibuff
             do i=1+ibuff,nx-ibuff
 
-               this_pos(1) = xstart + (float(i)-0.5_RKIND)*dx
-               this_pos(2) = ystart + (float(j)-0.5_RKIND)*dx
-               this_pos(3) = zstart + (float(k)-0.5_RKIND)*dx
+               this_pos(1) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               this_pos(2) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               this_pos(3) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
 c
 c              1) finest level of refinement?
 c
 c
 c        Photoelectric heating  
 c
-         edot(i) = edot(i) + float(igammah)*gammaha*dom_inv
+         edot(i) = edot(i) + REAL(igammah,RKIND)*gammaha*dom_inv
 c
       enddo
 c

src/enzo/cool1d_multi.F

 
 !                    Photoelectric heating by UV-irradiated dust
 
-     &             + float(igammah)*gammaha*(HI(i,j,k)+HII(i,j,k))
+     &             + REAL(igammah,RKIND)*gammaha*(HI(i,j,k)+HII(i,j,k))
      &             *dom_inv)
 
          if (edot(i) .ne. edot(i)) then
      &               + gaHe(i) * HeI(i,j,k) + gaHp(i) * HII(i,j,k)
      &               + gael(i) * de(i,j,k)
             gphdl1 = gphdl(i)/dom
-            edot(i) = edot(i) - float(ih2co)*fudge*H2I(i,j,k)*
+            edot(i) = edot(i) - REAL(ih2co,RKIND)*fudge*H2I(i,j,k)*
      &           gphdl(i)/(1._RKIND + gphdl1/galdl(i)) / (2._RKIND*dom)
 
             end if
                 fudge = 1._RKIND
             endif
             gphdl1 = gphdl(i)/(HI(i,j,k)*dom)
-            edot(i) = edot(i) - float(ih2co)*fudge*H2I(i,j,k)*
+            edot(i) = edot(i) - REAL(ih2co,RKIND)*fudge*H2I(i,j,k)*
      &           gphdl(i)/(1._RKIND + gphdl1/gpldl(i)) / (2._RKIND*dom)
 
             end if
             fudge = min(fudge, 1._RKIND)
 #endif /* OPTICAL_DEPTH_FUDGE */
 
-            edot(i) = edot(i) - float(ih2co)*fudge*H2I(i,j,k)*(
+            edot(i) = edot(i) - REAL(ih2co,RKIND)*fudge*H2I(i,j,k)*(
      &           vibh(i)/(1._RKIND+vibh(i)/max(   vibl,tiny)) +
      &           roth(i)/(1._RKIND+roth(i)/max(qq*rotl(i),tiny))     
      &           )/2._RKIND/dom
                x = max(HII(i,j,k)/(HI(i,j,k)+HII(i,j,k)), 1.e-4_RKIND)
                factor = 0.9971_RKIND*(1._RKIND
      &              -(1._RKIND-x**0.2663_RKIND)**1.3163_RKIND)
-               edot(i) = edot(i) + float(ipiht)*factor*(
+               edot(i) = edot(i) + REAL(ipiht,RKIND)*factor*(
      &                + piHI  *HI  (i,j,k)             ! pi of HI
      &                + piHeI *HeI (i,j,k)*0.25_RKIND  ! pi of HeI
      &                + piHeII*HeII(i,j,k)*0.25_RKIND  ! pi of HeII
 
             do i = is+1, ie+1
                if ( itmask(i) ) then
-               edot(i) = edot(i) + float(ipiht)*(
+               edot(i) = edot(i) + REAL(ipiht,RKIND)*(
      &                + piHI  *HI  (i,j,k)            ! pi of HI
      &                + piHeI *HeI (i,j,k)*0.25_RKIND     ! pi of HeI
      &                + piHeII*HeII(i,j,k)*0.25_RKIND     ! pi of HeII
          do i = is+1, ie+1
             if ( itmask(i) ) then
 
-            edot(i) = edot(i) + float(ipiht)*(
+            edot(i) = edot(i) + REAL(ipiht,RKIND)*(
      &                + piHI  *HI  (i,j,k)*
      &                   exp(-avgsighp*HI(i,j,k)*dom)
      &                + piHeI *HeI (i,j,k)*0.25_RKIND*
          rtunits = ev2erg/utim/coolunit/dom
          do i = is+1, ie+1
             if (itmask(i)) then
-               edot(i) = edot(i) + float(ipiht) * photogamma(i,j,k) * 
-     &              rtunits * HI(i,j,k)
+               edot(i) = edot(i) + REAL(ipiht,RKIND) * photogamma(i,j,k)
+     &              * rtunits * HI(i,j,k)
 c               if (photogamma(i,j,k)>0) then
 c                  print*, i,j,k,edot(i), photogamma(i,j,k),rtunits,dom,
 c     $                 aye,utim,coolunit,d(i,j,k),hi(i,j,k),tgas(i)
 c            8.5e-26 came from Gamma_pe, assuming epsilon=0.05, G_0=1.7
 c            (see Gerritsen & Icke '97, or Joung & Mac Low '06, Sec. 2.2)
 c
-	    metal_heat = float(igammah) * boost_factor * 
+	    metal_heat = REAL(igammah,RKIND) * boost_factor * 
      &           gammaha * xi * (HI(i,j,k)+HII(i,j,k)) * dom_inv
 c
 c           MKRJ 10/15/08 -- Gamma (in erg/s) should weakly depend on 

src/enzo/cool1d_sep.F

 #endif /* OPTICAL_DEPTH_FUDGE */
 c
             gphdl1 = gphdl(i)/(HI(i,j,k)*dom)
-            edot(i,15) = -float(ih2co)*fudge*H2I(i,j,k)*
+            edot(i,15) = -REAL(ih2co,RKIND)*fudge*H2I(i,j,k)*
      .           gphdl(i)/(1._RKIND + gphdl1/gpldl(i)) / (2._RKIND*dom)
             endif
          enddo
             fudge = min(fudge, 1._RKIND)
 #endif /* OPTICAL_DEPTH_FUDGE */
 c
-            edot(i,15) = -float(ih2co)*fudge*H2I(i,j,k)*(
+            edot(i,15) = -REAL(ih2co,RKIND)*fudge*H2I(i,j,k)*(
      .           vibh(i)/(1._RKIND+vibh(i)/max(   vibl,tiny)) +
      .           roth(i)/(1._RKIND+roth(i)/max(qq*rotl(i),tiny))     
      .           )/2._RKIND/dom
       kspan=ks
       nn=nt-inc
       jc=ks/n
-      radf=rad*float(jc)*0.5_RKIND
+      radf=rad*REAL(jc,RKIND)*0.5_RKIND
       i=0
       jf=0
 c  determine the factors of n
       j=j-1
       if(j .ne. 0) go to 90
 c  compute fourier transform
-  100 sd=radf/float(kspan)
+  100 sd=radf/REAL(kspan,RKIND)
       cd=2.0*sin(sd)**2
       sd=sin(sd+sd)
       kk=1
       if(k .eq. 5) go to 510
       if(k .eq. jf) go to 640
       jf=k
-      s1=rad/float(k)
+      s1=rad/REAL(k,RKIND)
       c1=cos(s1)
       s1=sin(s1)
       if(jf .gt. maxf) go to 998
       R_PREC    tempi, tempr
 c     real*8 twopi, theta, wr, wi, wpr, wpi, wtemp
       R_PREC    twopi, theta, wr, wi, wpr, wpi, wtemp
-      parameter (twopi=6.2831853071796_RKIND)
+      parameter (twopi=6.2831853071796d0)
 c
 c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\///////////////////////////////////
 c=======================================================================

src/enzo/particle_splitter.F

 c     currently set to be dx (=CellWidth), but can be changed. 
 c     (i.e. ParticleSplitterChildrenParticleSeparation = 1 by default)
 c
-      rad = dx * separation**float(iterations)
+      rad = dx * separation**REAL(iterations,RKIND)
 c
 c
 c     Loop over existing (parent) particles; It implicitly assumes that 

src/enzo/pop3_color_maker.F

 
                type(ii) = -ctype
                tcp(ii) = t
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
 c
 c              Star velocities averaged over multiple cells to
 c              avoid "runaway star particle" phenomenon

src/enzo/pop3_maker.F

 
                type(ii) = -ctype
                tcp(ii) = t
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
 c
 c     Record amount of star formation
                justburn = justburn + mp(ii)

src/enzo/smooth_deposit.F

 c        loop over grid
 c
          do k=1, dim3
-            zpos = leftedge(3) + (float(k) - 0.5_RKIND)*cellsize
+            zpos = leftedge(3)+(REAL(k,RKIND)-0.5_RKIND)*cellsize
             do j=1, dim2
-               ypos = leftedge(2) + (float(j) - 0.5_RKIND)*cellsize
+               ypos = leftedge(2)+(REAL(j,RKIND)-0.5_RKIND)*cellsize
                do i=1, dim1
-                  xpos = leftedge(1) + (float(i) - 0.5_RKIND)*cellsize
+                  xpos = leftedge(1)+(REAL(i,RKIND)-0.5_RKIND)*cellsize
 c
 c                 Loop over particles
 c

src/enzo/star_maker1.F

                mp(ii)  = starfraction * d(i,j,k)
                tcp(ii) = t
                tdp(ii) = tdyn
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
                if (imethod .eq. 2) then
                   up(ii) = 0.5_RKIND*(u(i,j,k)+u(i+1,j,k))
                   vp(ii) = 0.5_RKIND*(v(i,j,k)+v(i,j+1,k))

src/enzo/star_maker2.F

                mp(ii)  = starfraction * d(i,j,k)
                tcp(ii) = t
                tdp(ii) = tdyn
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
                if (imethod .eq. 2) then
                   up(ii) = 0.5_RKIND*(u(i,j,k)+u(i+1,j,k))
                   vp(ii) = 0.5_RKIND*(v(i,j,k)+v(i,j+1,k))

src/enzo/star_maker3.F

                mp(ii)  = starfraction * d(i,j,k)
                tcp(ii) = t
                tdp(ii) = tdyn
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
 c
 c              Star velocities averaged over multiple cells to
 c              avoid "runaway star particle" phenomenon

src/enzo/star_maker4.F

                mp(ii)  = gasfrac * d(i,j,k)
                tcp(ii) = t
                tdp(ii) = timeconstant
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
                if (imethod .eq. 2) then
                   up(ii) = 0.5_RKIND*(u(i,j,k)+u(i+1,j,k))
                   vp(ii) = 0.5_RKIND*(v(i,j,k)+v(i,j+1,k))

src/enzo/star_maker5.F

               if(d(i,j,k) .le. odthresh) goto 10
 
 c         Don't consider this cell if it's not in the refinement region.
-              tempx = xstart + (float(i)-0.5_RKIND)*dx
-              tempy = ystart + (float(j)-0.5_RKIND)*dx
-              tempz = zstart + (float(k)-0.5_RKIND)*dx
+              tempx = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+              tempy = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+              tempz = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
               if (tempx .lt. rr_left0 .or. tempx .gt. rr_right0 .or. 
      &          tempy .lt. rr_left1 .or. tempy .gt. rr_right1 .or. 
      &          tempz .lt. rr_left2 .or. tempz .gt. rr_right2) then

src/enzo/star_maker7.F

                mp(ii)  = starfraction * d(i,j,k)
                tcp(ii) = t
                tdp(ii) = tdyn
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
                if (imethod .eq. 2) then
                   up(ii) = 0.5_RKIND*(u(i,j,k)+u(i+1,j,k))
                   vp(ii) = 0.5_RKIND*(v(i,j,k)+v(i,j+1,k))

src/enzo/star_maker_h2reg.F

                mp(ii)  = starmass
                tcp(ii) = t
                tdp(ii) = timeconstant
-               xp(ii) = xstart + (float(i)-0.5_RKIND)*dx
-               yp(ii) = ystart + (float(j)-0.5_RKIND)*dx
-               zp(ii) = zstart + (float(k)-0.5_RKIND)*dx
+               xp(ii) = xstart + (REAL(i,RKIND)-0.5_RKIND)*dx
+               yp(ii) = ystart + (REAL(j,RKIND)-0.5_RKIND)*dx
+               zp(ii) = zstart + (REAL(k,RKIND)-0.5_RKIND)*dx
 
 #define AVERAGE_PARTICLE_VELOCITY
 #ifdef AVERAGE_PARTICLE_VELOCITY