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

Jump to bottom

NRL single-precision changes #797

Closed
wants to merge 3 commits into from
Closed

NRL single-precision changes #797

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
805c62c
add single precision code changes from michalakes fork, jm-nrl-32bitf…
grantfirl Dec 7, 2021
b17a7e7
Merge branch 'main' into sing_prec_from_main
grantfirl Dec 7, 2021
239710b
Merge branch 'main' into sing_prec_from_main
grantfirl Jan 13, 2022
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
77 changes: 42 additions & 35 deletions physics/calpreciptype.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,17 +26,18 @@ subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, &
! --------------------------------------------------------------------
use funcphys, only : fpvs,ftdp,fpkap,ftlcl,stma,fthe
use physcons
use machine , only : kind_phys
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
real, parameter :: pthresh = 0.0, oneog = 1.0/con_g
real(kind=kind_phys), parameter :: pthresh = 0.0, oneog = 1.0/con_g
integer,parameter :: nalg = 5
!
! declare variables.
!
integer,intent(in) :: kdt,nrcm,im,ix,lm,lp1
real,intent(in) :: xlat(im),xlon(im)
real,intent(in) :: randomno(ix,nrcm)
real(kind=kind_phys),intent(in) :: xlat(im),xlon(im)
real(kind=kind_phys),intent(in) :: randomno(ix,nrcm)
real(kind=kind_phys),dimension(im), intent(in) :: prec,tskin
real(kind=kind_phys),dimension(ix,lm), intent(in) :: gt0,gq0,prsl
real(kind=kind_phys),dimension(ix,lp1),intent(in) :: prsi,phii
Expand Down Expand Up @@ -220,8 +221,9 @@ subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, &
!! This subroutine computes precipitation type using a decision tree approach that uses
!! variables such as integrated wet bulb temperatue below freezing and lowest layer
!! temperature (Baldwin et al. 1994 \cite baldwin_et_al_1994)
subroutine calwxt(lm,lp1,t,q,pmid,pint, &
d608,rog,epsq,zint,iwx,twet)
subroutine calwxt(lm,lp1,t,q,pmid,pint, &
d608,rog,epsq,zint,iwx,twet)
use machine , only : kind_phys
!
! file: calwxt.f
! written: 11 november 1993, michael baldwin
Expand All @@ -247,10 +249,10 @@ subroutine calwxt(lm,lp1,t,q,pmid,pint, &
! t,q,pmid,htm,lmh,zint
!
integer,intent(in) :: lm,lp1
real,dimension(lm),intent(in) :: t,q,pmid,twet
real,dimension(lp1),intent(in) :: zint,pint
real(kind=kind_phys),dimension(lm),intent(in) :: t,q,pmid,twet
real(kind=kind_phys),dimension(lp1),intent(in) :: zint,pint
integer,intent(out) :: iwx
real,intent(in) :: d608,rog,epsq
real(kind=kind_phys),intent(in) :: d608,rog,epsq


! output:
Expand All @@ -264,10 +266,10 @@ subroutine calwxt(lm,lp1,t,q,pmid,pint, &
!
! internal:
!
! real, allocatable :: twet(:)
real, parameter :: d00=0.0
! real(kind=kind_phys), allocatable :: twet(:)
real(kind=kind_phys), parameter :: d00=0.0
integer karr,licee
real tcold,twarm
real(kind=kind_phys) tcold,twarm

! subroutines called:
! wetbulb
Expand All @@ -282,7 +284,7 @@ subroutine calwxt(lm,lp1,t,q,pmid,pint, &
!

integer l,lice,iwrml,ifrzl
real psfck,tdchk,a,tdkl,tdpre,tlmhk,twrmk,areas8,areap4, &
real(kind=kind_phys) psfck,tdchk,a,tdkl,tdpre,tlmhk,twrmk,areas8,areap4, &
surfw,surfc,dzkl,area1,pintk1,pintk2,pm150,pkl,tkl,qkl

! allocate ( twet(lm) )
Expand Down Expand Up @@ -486,27 +488,28 @@ subroutine calwxt_ramer(lm,lp1,t,q,pmid,rh,td,pint,ptyp)
! use params_mod
! use ctlblk_mod
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use machine , only : kind_phys
implicit none
!
real,parameter :: twice=266.55,rhprcp=0.80,deltag=1.02, &
real(kind=kind_phys),parameter :: twice=266.55,rhprcp=0.80,deltag=1.02, &
& emelt=0.045,rlim=0.04,slim=0.85
real,parameter :: twmelt=273.15,tz=273.15,efac=1.0 ! specify in params now
real(kind=kind_phys),parameter :: twmelt=273.15,tz=273.15,efac=1.0 ! specify in params now
!
integer*4 i, k1, lll, k2, toodry
!
real xxx ,mye, icefrac
real(kind=kind_phys) xxx ,mye, icefrac
integer, intent(in) :: lm,lp1
real,dimension(lm), intent(in) :: t,q,pmid,rh,td
real,dimension(lp1),intent(in) :: pint
real(kind=kind_phys),dimension(lm), intent(in) :: t,q,pmid,rh,td
real(kind=kind_phys),dimension(lp1),intent(in) :: pint
integer, intent(out) :: ptyp
!
real,dimension(lm) :: tq,pq,rhq,twq
real(kind=kind_phys),dimension(lm) :: tq,pq,rhq,twq
!
integer j,l,lev,ii
real rhmax,twmax,ptop,dpdrh,twtop,rhtop,wgt1,wgt2, &
real(kind=kind_phys) rhmax,twmax,ptop,dpdrh,twtop,rhtop,wgt1,wgt2, &
rhavg,dtavg,dpk,ptw,pbot
! real b,qtmp,rate,qc
real,external :: xmytw
! real(kind=kind_phys) b,qtmp,rate,qc
! real(kind=kind_phys),external :: xmytw (now inside the module)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, xmytw is not in a module; it is inside this file outside of a module. Removing the "external" causes it to be undefined and the code fails to compile.

Copy link
Contributor

@michalakes michalakes May 3, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It looks like the module declaration in my original pull request (https://github.com/NCAR/ccpp-physics/pull/772/files#) didn't make it into the current fork that you're reviewing. The original PR version of this file can be compared from here:

https://github.com/NCAR/ccpp-physics/pull/772/files#diff-e6c0659a30420d8a82797b25ef6b176c4d2c13241d6272e33bb9f956abb92b8d

The intent of this and a number of other changes to enclose bare external subroutines into modules was to make it easier to debug the code (especially catching type mismatches) by making subroutine interfaces visible, and I'd recommend keeping them.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I see you added a lot of "module...end module" in CCPP files that presently use Fortran 77 calling conventions. That seems like a good idea to me, though I'll have to adjust the names slightly to match CCPP's latest file naming standard. (Or rename the files.)

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I was able to get your "module...end module" addition to many files working, though I needed to add "use" statements in more files than you did.

!
! initialize.
icefrac = -9999.
Expand All @@ -521,7 +524,7 @@ subroutine calwxt_ramer(lm,lp1,t,q,pmid,rh,td,pint,ptyp)
! causing problems later in this subroutine
! qtmp=max(h1m12,q(l))
! rhqtmp(lev)=qtmp/qc
rhq(lev) = rh(l)
rhq(lev) = rh(l)
pq(lev) = pmid(l) * 0.01
tq(lev) = t(l)
enddo
Expand Down Expand Up @@ -753,10 +756,11 @@ subroutine calwxt_ramer(lm,lp1,t,q,pmid,rh,td,pint,ptyp)
!--------------------------------------------------------------------------
function xmytw(t,td,p)
!
use machine , only : kind_phys
implicit none
!
integer*4 cflag, l
real f, c0, c1, c2, k, kd, kw, ew, t, td, p, ed, fp, s, &
real(kind=kind_phys) f, c0, c1, c2, k, kd, kw, ew, t, td, p, ed, fp, s, &
& de, xmytw
data f, c0, c1, c2 /0.0006355, 26.66082, 0.0091379024, 6106.3960/
!
Expand Down Expand Up @@ -877,19 +881,20 @@ function xmytw(t,td,p)
!! \cite bourgouin_2000.
!of aes (canada) 1992
subroutine calwxt_bourg(lm,lp1,rn,g,t,q,pmid,pint,zint,ptype)
use machine , only : kind_phys
implicit none
!
! input:
integer,intent(in) :: lm,lp1
real,intent(in) :: g,rn(2)
real,intent(in), dimension(lm) :: t, q, pmid
real,intent(in), dimension(lp1) :: pint, zint
real(kind=kind_phys),intent(in) :: g,rn(2)
real(kind=kind_phys),intent(in), dimension(lm) :: t, q, pmid
real(kind=kind_phys),intent(in), dimension(lp1) :: pint, zint
!
! output:
integer, intent(out) :: ptype
!
integer ifrzl,iwrml,l,lhiwrm
real pintk1,areane,tlmhk,areape,pintk2,surfw,area1,dzkl,psfck,r1,r2
real(kind=kind_phys) pintk1,areane,tlmhk,areape,pintk2,surfw,area1,dzkl,psfck,r1,r2
!
! initialize weather type array to zero (ie, off).
! we do this since we want ptype to represent the
Expand Down Expand Up @@ -1076,6 +1081,7 @@ subroutine calwxt_revised(lm,lp1,t,q,pmid,pint, &
! use params_mod
! use ctlblk_mod
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use machine , only : kind_phys
implicit none
!
! list of variables needed
Expand All @@ -1087,9 +1093,9 @@ subroutine calwxt_revised(lm,lp1,t,q,pmid,pint, &
! t,q,pmid,htm,lmh,zint

integer,intent(in) :: lm,lp1
real,dimension(lm),intent(in) :: t,q,pmid,twet
real,dimension(lp1),intent(in) :: pint,zint
real,intent(in) :: d608,rog,epsq
real(kind=kind_phys),dimension(lm),intent(in) :: t,q,pmid,twet
real(kind=kind_phys),dimension(lp1),intent(in) :: pint,zint
real(kind=kind_phys),intent(in) :: d608,rog,epsq
! output:
! iwx - instantaneous weather type.
! acts like a 4 bit binary
Expand All @@ -1101,12 +1107,12 @@ subroutine calwxt_revised(lm,lp1,t,q,pmid,pint, &
integer, intent(out) :: iwx
! internal:
!
real, parameter :: d00=0.0
real(kind=kind_phys), parameter :: d00=0.0
integer karr,licee
real tcold,twarm
real(kind=kind_phys) tcold,twarm
!
integer l,lmhk,lice,iwrml,ifrzl
real psfck,tdchk,a,tdkl,tdpre,tlmhk,twrmk,areas8,areap4,area1, &
real(kind=kind_phys) psfck,tdchk,a,tdkl,tdpre,tlmhk,twrmk,areas8,areap4,area1, &
surfw,surfc,dzkl,pintk1,pintk2,pm150,qkl,tkl,pkl,area0,areap0

! subroutines called:
Expand Down Expand Up @@ -1316,14 +1322,15 @@ subroutine calwxt_dominant(nalg,rain,freezr,sleet,snow, &
! algorithms and sums them up to give a dominant type
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use machine , only : kind_phys
implicit none
!
! input:
integer,intent(in) :: nalg
real,intent(out) :: doms,domr,domzr,domip
real(kind=kind_phys),intent(out) :: doms,domr,domzr,domip
integer,dimension(nalg),intent(in) :: rain,snow,sleet,freezr
integer l
real totsn,totip,totr,totzr
real(kind=kind_phys) totsn,totip,totr,totzr
!--------------------------------------------------------------------------
! print* , 'into dominant'
domr = 0.
Expand Down
Loading