Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Convert logical to MASK_TYPE (aka integer*4) #7

Merged
merged 11 commits into from
Dec 18, 2024
Merged

Convert logical to MASK_TYPE (aka integer*4) #7

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
24cfbc5
Standardize parameter declaration
mabruzzo Oct 22, 2024
21fb999
standardized the format of precision-dependent tolerance
mabruzzo Oct 22, 2024
3f747da
adding include-directive for the sake of consistency.
mabruzzo Oct 27, 2024
ed05328
Convert most logicals to MASK_TYPE
mabruzzo Oct 29, 2024
2d24754
minor refactoring of cool1d_multi_g so that it is easier to transcribe
mabruzzo Oct 27, 2024
0de37a1
fixing a type declaration.
mabruzzo Oct 27, 2024
ecc61f2
reformatted some lines into a more-friendly format for transcription.
mabruzzo Dec 4, 2024
db6d0dd
Removed unused argument from lookup_cool_rates0d
mabruzzo Dec 4, 2024
a0f244c
Define dummy_iter_arg within cool_multi_time_g
mabruzzo Dec 4, 2024
2916da1
update readme for this special development branch
mabruzzo Dec 4, 2024
234a676
Minor tweaks to improve transcription
mabruzzo Dec 4, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,9 @@
> [!IMPORTANT]
> This is a special version of the [brittonsmith:gen2024](https://github.com/brittonsmith/grackle/tree/gen2024) branch (i.e. the branch of changes proposed for merging in the grackle-project/grackle#177 Pull Request).
>
> This branch includes additional changes that are needed to simplify the transcription process to C++. There are pending PRs to merge all of these changes into the gen2024 branch ([see this list of PRs](https://github.com/brittonsmith/grackle/pulls/mabruzzo))


# Grackle

[![Users' Mailing List](https://img.shields.io/badge/Users-List-lightgrey.svg)](https://groups.google.com/forum/#!forum/grackle-cooling-users)
Expand Down
19 changes: 10 additions & 9 deletions src/clib/calc_grain_size_increment_1d.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ subroutine calc_grain_size_increment_1d(

! in
integer in, jn, kn, is, ie, j, k
logical itmask(in)
MASK_TYPE itmask(in)
integer immulti, imabund, idspecies, igrgr
real*8 dom
R_PREC d(in,jn,kn)
Expand Down Expand Up @@ -369,7 +369,7 @@ subroutine calc_grain_size_increment_1d(
endif

do i = is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then

if (idspecies .gt. 0) then
sgtot (i) = sgMgSiO3 (i)
Expand Down Expand Up @@ -434,9 +434,12 @@ subroutine calc_grain_size_increment_species_1d(


implicit NONE

#include "grackle_fortran_types.def"

! input
integer in, jn, kn, is, ie, j, k
logical itmask(in)
MASK_TYPE itmask(in)
integer igrgr
integer iSN, nSN, SN0_N
real*8 dom
Expand All @@ -457,9 +460,8 @@ subroutine calc_grain_size_increment_species_1d(
real*8 dsp0, SN_sgsp, SN_kpsp
real*8 SN_dsp0(SN0_N), SN_nsp0(SN0_N)
real*8 drsp(in)
real*8 pi, mh
parameter (pi = pi_val)
parameter (mh = mass_h)
real*8, parameter :: pi = pi_val
real*8, parameter :: mh = mass_h
! debug
real*8 SN_dsp(SN0_N), SN_msp(SN0_N), dsp1
integer iTd, iTd0
Expand All @@ -478,7 +480,7 @@ subroutine calc_grain_size_increment_species_1d(
! enddo

do i = is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then
!!!!!!!!!!!!!
!!!! if( dsp(i,j,k) .gt. 1.d-15*d(i,j,k) ) then
!!!!!!!!!!!!!
Expand Down Expand Up @@ -649,8 +651,7 @@ subroutine solve_cubic_equation(a, b, c, root)
real*8 q, r, m
real*8 th
real*8 s,t
real*8 pi
parameter (pi = pi_val)
real*8, parameter :: pi = pi_val

q = (a*a - 3.d0*b)/9.d0
r = (2.d0*a*a*a - 9.d0*a*b + 27.d0*c)/54.d0
Expand Down
73 changes: 35 additions & 38 deletions src/clib/calc_tdust_1d_g.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,23 +60,22 @@ subroutine calc_tdust_1d_g(

! Iteration mask

logical itmask(in)
MASK_TYPE itmask(in)

! Parameters

integer idspecies
real*8 t_subl
parameter(t_subl = 1.5e3_DKIND) ! grain sublimation temperature
real*8 radf
parameter(radf = 4._DKIND * sigma_sb)
real*8 kgr1
parameter(kgr1 = 4.0e-4_DKIND / 0.009387d0)
! grain sublimation temperature
real*8, parameter :: t_subl = 1.5e3_DKIND
real*8, parameter :: radf = 4._DKIND * sigma_sb
real*8, parameter :: kgr1 = 4.0e-4_DKIND / 0.009387d0
!! should be normalized with local fgr. [GC20200701]
real*8 tol, bi_tol, minpert, gamma_isrf(in)
parameter(tol = 1.e-5_DKIND, bi_tol = 1.e-3_DKIND,
& minpert = 1.e-10_DKIND)
integer itmax, bi_itmax
parameter(itmax = 50, bi_itmax = 30)
real*8 gamma_isrf(in)
real*8, parameter :: tol = 1.e-5_DKIND
real*8, parameter :: bi_tol = 1.e-3_DKIND
real*8, parameter :: minpert = 1.e-10_DKIND
integer, parameter :: itmax = 50
integer, parameter :: bi_itmax = 30

! Locals

Expand All @@ -90,7 +89,7 @@ subroutine calc_tdust_1d_g(
& slope(in), tdplus(in), tdustnow(in), tdustold(in),
& pert(in),
& bi_t_mid(in), bi_t_high(in)
logical nm_itmask(in), bi_itmask(in)
MASK_TYPE nm_itmask(in), bi_itmask(in)

!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\/////////////////////////////////
!=======================================================================
Expand All @@ -106,7 +105,7 @@ subroutine calc_tdust_1d_g(
Td_N(1) = gr_N(2)
Td_Size = gr_N(2)
do i = is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then
logalsp(:,i) = log10(alsp(:,i))
endif
enddo
Expand All @@ -120,25 +119,25 @@ subroutine calc_tdust_1d_g(
! Set local iteration mask and initial guess

do i = is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then
gamma_isrf(i) = isrf(i) * gamma_isrfa(i)
endif
enddo

do i = is+1, ie+1
nm_itmask(i) = itmask(i)
bi_itmask(i) = itmask(i)
if ( nm_itmask(i) ) then
if ( nm_itmask(i) .ne. MASK_FALSE ) then

if (trad .ge. tgas(i)) then
tdustnow(i) = trad
nm_itmask(i) = .false.
bi_itmask(i) = .false.
nm_itmask(i) = MASK_FALSE
bi_itmask(i) = MASK_FALSE
c_done = c_done + 1
nm_done = nm_done + 1
else if (tgas(i) .gt. t_subl) then
! Use bisection if T_gas > grain sublimation temperature.
nm_itmask(i) = .false.
nm_itmask(i) = MASK_FALSE
nm_done = nm_done + 1
else
tdustnow(i) = max(trad,
Expand All @@ -159,7 +158,7 @@ subroutine calc_tdust_1d_g(
! Loop over slice

do i = is+1, ie+1
if ( nm_itmask(i) ) then
if ( nm_itmask(i) .ne. MASK_FALSE ) then

tdplus(i) = max(1.e-3_DKIND, ((1._DKIND + pert(i))
& * tdustnow(i)))
Expand All @@ -186,7 +185,7 @@ subroutine calc_tdust_1d_g(
& gamma_isrf, nh, nm_itmask, solplus, in, is, ie)

do i = is+1, ie+1
if ( nm_itmask(i) ) then
if ( nm_itmask(i) .ne. MASK_FALSE ) then

! Use Newton's method to solve for Tdust

Expand All @@ -204,13 +203,13 @@ subroutine calc_tdust_1d_g(

! If negative solution calculated, give up and wait for bisection step.
if (tdustnow(i) .lt. trad) then
nm_itmask(i) = .false.
nm_itmask(i) = MASK_FALSE
nm_done = nm_done + 1
! Check for convergence of solution
else if (abs(sol(i) / solplus(i)) .lt. tol) then
nm_itmask(i) = .false.
nm_itmask(i) = MASK_FALSE
c_done = c_done + 1
bi_itmask(i) = .false.
bi_itmask(i) = MASK_FALSE
nm_done = nm_done + 1
endif

Expand All @@ -235,7 +234,7 @@ subroutine calc_tdust_1d_g(
! If iteration count exceeded, try once more with bisection
if (c_done .lt. c_total) then
do i = is+1, ie+1
if ( bi_itmask(i) ) then
if ( bi_itmask(i) .ne. MASK_FALSE ) then
tdustnow(i) = trad
! bi_t_high(i) = tgas(i)
bi_t_high(i) = 3e3_DKIND
Expand All @@ -245,7 +244,7 @@ subroutine calc_tdust_1d_g(
do iter = 1, bi_itmax

do i = is+1, ie+1
if ( bi_itmask(i) ) then
if ( bi_itmask(i) .ne. MASK_FALSE ) then

bi_t_mid(i) = 0.5_DKIND * (tdustnow(i) + bi_t_high(i))
if (iter .eq. 1) then
Expand All @@ -263,7 +262,7 @@ subroutine calc_tdust_1d_g(
& gamma_isrf, nh, bi_itmask, sol, in, is, ie)

do i = is+1, ie+1
if ( bi_itmask(i) ) then
if ( bi_itmask(i) .ne. MASK_FALSE ) then

if (sol(i) .gt. 0._DKIND) then
tdustnow(i) = bi_t_mid(i)
Expand All @@ -273,7 +272,7 @@ subroutine calc_tdust_1d_g(

if ((abs(bi_t_high(i) - tdustnow(i)) / tdustnow(i))
& .le. bi_tol) then
bi_itmask(i) = .false.
bi_itmask(i) = MASK_FALSE
c_done = c_done + 1
endif

Expand Down Expand Up @@ -309,7 +308,7 @@ subroutine calc_tdust_1d_g(

! Copy values back to thrown slice
do i = is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then

! Check for bad solutions
if (tdustnow(i) .lt. 0._DKIND) then
Expand Down Expand Up @@ -380,13 +379,12 @@ subroutine calc_kappa_gr_g(

! Iteration mask

logical itmask(in)
MASK_TYPE itmask(in)

! Parameters

real*8 kgr1, kgr200
parameter(kgr1 = 4.0e-4_DKIND / 0.009387d0
& , kgr200 = 16.0_DKIND / 0.009387d0)
real*8, parameter :: kgr1 = 4.0e-4_DKIND / 0.009387d0
real*8, parameter :: kgr200 = 16.0_DKIND / 0.009387d0
!! should be normalized with local fgr. [GC20200701]
!! This value is valid only for Td < 50 K (Omukai 2000).

Expand All @@ -409,7 +407,7 @@ subroutine calc_kappa_gr_g(
!=======================================================================

do i = is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then

if(idspecies.eq.0) then

Expand Down Expand Up @@ -494,12 +492,11 @@ subroutine calc_gr_balance_g(

! Iteration mask

logical itmask(in)
MASK_TYPE itmask(in)

! Parameters

real*8 radf
parameter(radf = 4._DKIND * sigma_sb)
real*8, parameter :: radf = 4._DKIND * sigma_sb

! Locals

Expand All @@ -513,7 +510,7 @@ subroutine calc_gr_balance_g(
!=======================================================================

do i = is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then

sol(i) = gamma_isrf(i) + radf * kgr(i) *
& (trad4 - tdust(i)**4) +
Expand Down
13 changes: 6 additions & 7 deletions src/clib/calc_tdust_3d_g.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -187,8 +187,7 @@ subroutine calc_tdust_3d_g(

! Parameters

real*8 mh
parameter (mh = mass_h)
real*8, parameter :: mh = mass_h

! Locals

Expand Down Expand Up @@ -218,7 +217,7 @@ subroutine calc_tdust_3d_g(
& vibh(in)
! Iteration mask for multi_cool

logical itmask(in)
MASK_TYPE itmask(in)

!\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\/////////////////////////////////
!=======================================================================
Expand Down Expand Up @@ -378,7 +377,7 @@ subroutine calc_tdust_3d_g(

! Set itmask to all true

itmask(i) = .true.
itmask(i) = MASK_TRUE

enddo

Expand All @@ -387,7 +386,7 @@ subroutine calc_tdust_3d_g(
if (imetal .eq. 1) then
do i = is+1, ie + 1
if (metal(i,j,k) .lt. 1.e-9_DKIND * d(i,j,k)) then
itmask(i) = .false.
itmask(i) = MASK_FALSE
endif
enddo
endif
Expand Down Expand Up @@ -431,7 +430,7 @@ subroutine calc_tdust_3d_g(
endif

do i = is+1, ie+1
if(itmask(i)) then
if(itmask(i) .ne. MASK_FALSE) then
! Calculate metallicity

if (imetal .eq. 1) then
Expand Down Expand Up @@ -721,7 +720,7 @@ subroutine calc_tdust_3d_g(
! Copy slice values back to grid

do i = is+1, ie+1
if (itmask(i)) then
if (itmask(i) .ne. MASK_FALSE) then
if (itdmulti .eq. 0) then
dust_temp(i,j,k) = tdust(i)
else
Expand Down
13 changes: 6 additions & 7 deletions src/clib/calc_temp1d_cloudy_g.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,14 +78,13 @@ subroutine calc_temp1d_cloudy_g(d, metal, e, rhoH,

! Iteration mask

logical itmask(in)
MASK_TYPE itmask(in)

! Parameters

integer ti_max
real*8 mu_metal
parameter (mu_metal = 16._DKIND) ! approx. mean molecular weight of metals
parameter (ti_max = 20)
! approx. mean molecular weight of metals
real*8, parameter :: mu_metal = 16._DKIND
integer, parameter :: ti_max = 20

! Locals

Expand Down Expand Up @@ -148,14 +147,14 @@ subroutine calc_temp1d_cloudy_g(d, metal, e, rhoH,
endif

do i=is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then
! Calculate proper log(n_H)
log_n_h(i) = log10(rhoH(i) * dom)
endif
enddo

do i=is+1, ie+1
if ( itmask(i) ) then
if ( itmask(i) .ne. MASK_FALSE ) then
munew = 1._DKIND
do ti = 1, ti_max
muold = munew
Expand Down
Loading