From bf3fc7c940c1b43ae9a5a753bf917f6312a0b133 Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Thu, 15 Jun 2023 19:13:16 +0000 Subject: [PATCH 1/3] Correct Fortran 2008 compliance in cu_ntiedtke.F MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This commit corrects several issues of use-before-declaration of dummy arguments in the cu_ntiedtke.F file. These were caught with the GNU Fortran compiler with the -std=f2008 flag. For example: cu_ntiedtke.F:2530:35: 2530 | logical,intent(in),dimension(klon):: ldcum | 1 Error: GNU Extension: Symbol ‘klon’ is used before it is typed at (1) --- .../physics/physics_mmm/cu_ntiedtke.F | 24 ++++++++++++------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F b/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F index e5b4137f87..041bb67456 100644 --- a/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F +++ b/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F @@ -2527,9 +2527,10 @@ subroutine cudlfsn & implicit none !--- input arguments: + integer,intent(in):: klon logical,intent(in),dimension(klon):: ldcum - integer,intent(in):: klev,klon + integer,intent(in):: klev integer,intent(in),dimension(klon):: lndj integer,intent(in),dimension(klon):: kcbot,kctop @@ -2737,9 +2738,10 @@ subroutine cuddrafn & implicit none !--- input arguments: + integer,intent(in)::klon logical,intent(in),dimension(klon):: lddraf - integer,intent(in)::klev,klon + integer,intent(in)::klev real(kind=kind_phys),intent(in),dimension(klon,klev):: ptenh,pqenh,puen,pven real(kind=kind_phys),intent(in),dimension(klon,klev):: pgeo,pmfu @@ -2980,9 +2982,10 @@ subroutine cuflxn & implicit none !--- input arguments: + integer,intent(in):: klon logical,intent(in),dimension(klon):: ldcum - integer,intent(in):: klev,klon + integer,intent(in):: klev integer,intent(in),dimension(klon):: lndj integer,intent(in),dimension(klon):: kcbot,kctop,kdtop @@ -3237,9 +3240,10 @@ subroutine cudtdqn(klon,klev,ktopm2,kctop,kdtop,ldcum, & implicit none !--- input arguments: + integer,intent(in):: klon logical,intent(in),dimension(klon):: ldcum,lddraf - integer,intent(in):: klon,klev,ktopm2 + integer,intent(in):: klev,ktopm2 integer,intent(in),dimension(klon):: kctop,kdtop real(kind=kind_phys),intent(in):: ztmst @@ -3323,8 +3327,9 @@ subroutine cududvn(klon,klev,ktopm2,ktype,kcbot,kctop,ldcum, & implicit none !--- input arguments: + integer,intent(in):: klon logical,intent(in),dimension(klon):: ldcum - integer,intent(in):: klon,klev,ktopm2 + integer,intent(in):: klev,ktopm2 integer,intent(in),dimension(klon):: ktype,kcbot,kctop real(kind=kind_phys),intent(in):: ztmst @@ -3466,8 +3471,9 @@ subroutine cuadjtqn & implicit none !--- input arguments: + integer,intent(in):: klon logical,intent(in),dimension(klon):: ldflag - integer,intent(in):: kcall,kk,klev,klon + integer,intent(in):: kcall,kk,klev real(kind=kind_phys),intent(in),dimension(klon):: psp @@ -3597,8 +3603,9 @@ subroutine cubasmcn & ! ---------------------------------------------------------------- !--- input arguments: + integer,intent(in):: klon logical,intent(in),dimension(klon):: ldcum - integer,intent(in):: klon,kk,klev,klevm1 + integer,intent(in):: kk,klev,klevm1 real(kind=kind_phys),intent(in),dimension(klon,klev):: pten,pqen,pqsen,pgeo,pverv real(kind=kind_phys),intent(in),dimension(klon,klev):: puen,pven ! not used. @@ -3657,9 +3664,10 @@ subroutine cuentrn(klon,klev,kk,kcbot,ldcum,ldwork, & !--- input arguments: logical,intent(in):: ldwork + integer,intent(in):: klon logical,intent(in),dimension(klon):: ldcum - integer,intent(in):: klon,klev,kk + integer,intent(in):: klev,kk integer,intent(in),dimension(klon):: kcbot real(kind=kind_phys),intent(in),dimension(klon,klev):: pmfu From f56ee3c2227ac0ae364ec8b28368354df9864f50 Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Thu, 15 Jun 2023 19:16:21 +0000 Subject: [PATCH 2/3] Correct Fortran 2008 compliance in module_libmassv.F This commit corrects several issues with non-standard kind specifications in module_libmassv.F. These issues were caught by the GNU Fortran compiler with -std=f2008. For example: module_libmassv.F:25:8: 25 | real*8,dimension(*),intent(in):: x | 1 Error: GNU Extension: Nonstandard type declaration REAL*8 at (1) To provide standard kind specifications, local module variables R4KIND and R8KIND, that should specify single- and double-precision, respectively, have been defined as private parameters in module_libmassv. --- .../physics/physics_mmm/module_libmassv.F | 22 ++++++++++--------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/core_atmosphere/physics/physics_mmm/module_libmassv.F b/src/core_atmosphere/physics/physics_mmm/module_libmassv.F index 4e731e6e59..60ff9fa022 100644 --- a/src/core_atmosphere/physics/physics_mmm/module_libmassv.F +++ b/src/core_atmosphere/physics/physics_mmm/module_libmassv.F @@ -14,6 +14,8 @@ module module_libmassv module procedure vsqrt_s end interface + integer, parameter, private :: R4KIND = selected_real_kind(6) + integer, parameter, private :: R8KIND = selected_real_kind(12) contains @@ -22,14 +24,14 @@ module module_libmassv subroutine vrec_d(y,x,n) !================================================================================================================= integer,intent(in):: n - real*8,dimension(*),intent(in):: x - real*8,dimension(*),intent(out):: y + real(kind=R8KIND),dimension(*),intent(in):: x + real(kind=R8KIND),dimension(*),intent(out):: y integer:: j !----------------------------------------------------------------------------------------------------------------- do j=1,n - y(j)=1.d0/x(j) + y(j)=real(1.0,kind=R8KIND)/x(j) enddo end subroutine vrec_d @@ -38,14 +40,14 @@ end subroutine vrec_d subroutine vrec_s(y,x,n) !================================================================================================================= integer,intent(in):: n - real*4,dimension(*),intent(in):: x - real*4,dimension(*),intent(out):: y + real(kind=R4KIND),dimension(*),intent(in):: x + real(kind=R4KIND),dimension(*),intent(out):: y integer:: j !----------------------------------------------------------------------------------------------------------------- do j=1,n - y(j)=1.e0/x(j) + y(j)=real(1.0,kind=R4KIND)/x(j) enddo end subroutine vrec_s @@ -54,8 +56,8 @@ end subroutine vrec_s subroutine vsqrt_d(y,x,n) !================================================================================================================= integer,intent(in):: n - real*8,dimension(*),intent(in):: x - real*8,dimension(*),intent(out):: y + real(kind=R8KIND),dimension(*),intent(in):: x + real(kind=R8KIND),dimension(*),intent(out):: y integer:: j !----------------------------------------------------------------------------------------------------------------- @@ -71,8 +73,8 @@ subroutine vsqrt_s(y,x,n) !================================================================================================================= integer,intent(in):: n - real*4,dimension(*),intent(in):: x - real*4,dimension(*),intent(out):: y + real(kind=R4KIND),dimension(*),intent(in):: x + real(kind=R4KIND),dimension(*),intent(out):: y integer:: j From 1a3eed0d4183b88acb971d162aaa621ed24e59af Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Thu, 15 Jun 2023 19:19:00 +0000 Subject: [PATCH 3/3] Address Fortran 2008 compliance in mp_radar.F MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This commit corrects Fortran 2008 compliance issues in mp_radar.F that were caught by the GNU Fortran compiler using the -std=f2008 flag. These issues are related to the use of non-standard kind specifications and intrinsics. For example: mp_radar.F:41:12: 41 | complex*16,public:: m_w_0, m_i_0 | 1 Error: GNU Extension: Nonstandard type declaration COMPLEX*16 at (1) ... mp_radar.F:138:37: 138 | xxdx(n) = dexp(dfloat(n-1)/dfloat(nrbins) & | 1 Error: Function ‘dfloat’ at (1) has no IMPLICIT type To provide standard kind specifications, local module variables R4KIND and R8KIND, that should specify single- and double-precision, respectively, have been defined as private parameters in module_libmassv. --- .../physics/physics_mmm/mp_radar.F | 37 ++++++++++--------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/src/core_atmosphere/physics/physics_mmm/mp_radar.F b/src/core_atmosphere/physics/physics_mmm/mp_radar.F index 35e8a5125d..00b8ed47f4 100644 --- a/src/core_atmosphere/physics/physics_mmm/mp_radar.F +++ b/src/core_atmosphere/physics/physics_mmm/mp_radar.F @@ -30,6 +30,9 @@ module mp_radar !.. calculations based on 50 individual size bins of the distributions. !+---+-----------------------------------------------------------------+ + integer, parameter, private :: R4KIND = selected_real_kind(6) + integer, parameter, private :: R8KIND = selected_real_kind(12) + integer,parameter,public:: nrbins = 50 integer,parameter,public:: slen = 20 character(len=slen), public:: & @@ -38,7 +41,7 @@ module mp_radar mixingrulestring_g, matrixstring_g, inclusionstring_g, & hoststring_g, hostmatrixstring_g, hostinclusionstring_g - complex*16,public:: m_w_0, m_i_0 + complex(kind=R8KIND),public:: m_w_0, m_i_0 double precision,dimension(nrbins+1),public:: xxdx double precision,dimension(nrbins),public:: xxds,xdts,xxdg,xdtg @@ -123,7 +126,7 @@ subroutine radar_init xxdx(1) = 100.d-6 xxdx(nrbins+1) = 0.02d0 do n = 2, nrbins - xxdx(n) = dexp(dfloat(n-1)/dfloat(nrbins) & + xxdx(n) = dexp(real(n-1,kind=R8KIND)/real(nrbins,kind=R8KIND) & * dlog(xxdx(nrbins+1)/xxdx(1)) +dlog(xxdx(1))) enddo do n = 1, nrbins @@ -135,7 +138,7 @@ subroutine radar_init xxdx(1) = 100.d-6 xxdx(nrbins+1) = 0.05d0 do n = 2, nrbins - xxdx(n) = dexp(dfloat(n-1)/dfloat(nrbins) & + xxdx(n) = dexp(real(n-1,kind=R8KIND)/real(nrbins,kind=R8KIND) & * dlog(xxdx(nrbins+1)/xxdx(1)) +dlog(xxdx(1))) enddo do n = 1, nrbins @@ -196,7 +199,7 @@ subroutine rayleigh_soak_wetgraupel(x_g,a_geo,b_geo,fmelt,meltratio_outside,m_w, character(len=*), intent(in):: mixingrule, matrix, inclusion, & host, hostmatrix, hostinclusion - complex*16,intent(in):: m_w, m_i + complex(kind=R8KIND),intent(in):: m_w, m_i double precision, intent(in):: x_g, a_geo, b_geo, fmelt, lambda, meltratio_outside @@ -206,7 +209,7 @@ subroutine rayleigh_soak_wetgraupel(x_g,a_geo,b_geo,fmelt,meltratio_outside,m_w, !--- local variables: integer:: error - complex*16:: m_core, m_air + complex(kind=R8KIND):: m_core, m_air double precision, parameter:: pix=3.1415926535897932384626434d0 double precision:: d_large, d_g, rhog, x_w, xw_a, fm, fmgrenz, & @@ -340,7 +343,7 @@ real(kind=kind_phys) function gammln(xx) end function gammln !================================================================================================================= - complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & + complex(kind=R8KIND) function get_m_mix_nested (m_a, m_i, m_w, volair, & volice, volwater, mixingrule, host, matrix, & inclusion, hostmatrix, hostinclusion, cumulerror) implicit none @@ -350,7 +353,7 @@ complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & character(len=*),intent(in):: mixingrule, host, matrix, & inclusion, hostmatrix, hostinclusion - complex*16,intent(in):: m_a, m_i, m_w + complex(kind=R8KIND),intent(in):: m_a, m_i, m_w double precision,intent(in):: volice, volair, volwater @@ -360,7 +363,7 @@ complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & !--- local variables: integer:: error - complex*16:: mtmp + complex(kind=R8KIND):: mtmp double precision:: vol1, vol2 @@ -481,7 +484,7 @@ complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & end function get_m_mix_nested !================================================================================================================= - complex*16 function get_m_mix (m_a, m_i, m_w, volair, volice, & + complex(kind=R8KIND) function get_m_mix (m_a, m_i, m_w, volair, volice, & volwater, mixingrule, matrix, inclusion, & error) implicit none @@ -490,7 +493,7 @@ complex*16 function get_m_mix (m_a, m_i, m_w, volair, volice, & !--- input arguments: character(len=*),intent(in):: mixingrule, matrix, inclusion - complex*16, intent(in):: m_a, m_i, m_w + complex(kind=R8KIND), intent(in):: m_a, m_i, m_w double precision, intent(in):: volice, volair, volwater @@ -531,7 +534,7 @@ complex*16 function get_m_mix (m_a, m_i, m_w, volair, volice, & end function get_m_mix !================================================================================================================= - complex*16 function m_complex_maxwellgarnett(vol1, vol2, vol3, & + complex(kind=R8KIND) function m_complex_maxwellgarnett(vol1, vol2, vol3, & m1, m2, m3, inclusion, error) implicit none !================================================================================================================= @@ -539,7 +542,7 @@ complex*16 function m_complex_maxwellgarnett(vol1, vol2, vol3, & !--- input arguments: character(len=*),intent(in):: inclusion - complex*16,intent(in):: m1,m2,m3 + complex(kind=R8KIND),intent(in):: m1,m2,m3 double precision,intent(in):: vol1,vol2,vol3 @@ -548,7 +551,7 @@ complex*16 function m_complex_maxwellgarnett(vol1, vol2, vol3, & integer,intent(out):: error !--- local variables: - complex*16 :: beta2, beta3, m1t, m2t, m3t + complex(kind=R8KIND) :: beta2, beta3, m1t, m2t, m3t !----------------------------------------------------------------------------------------------------------------- @@ -576,7 +579,7 @@ complex*16 function m_complex_maxwellgarnett(vol1, vol2, vol3, & else write(radar_debug,*) 'M_COMPLEX_MAXWELLGARNETT: ', 'unknown inclusion: ', inclusion call physics_message(radar_debug) - m_complex_maxwellgarnett=dcmplx(-999.99d0,-999.99d0) + m_complex_maxwellgarnett=cmplx(-999.99d0,-999.99d0,kind=R8KIND) error = 1 return endif @@ -587,7 +590,7 @@ complex*16 function m_complex_maxwellgarnett(vol1, vol2, vol3, & end function m_complex_maxwellgarnett !================================================================================================================= - complex*16 function m_complex_water_ray(lambda,t) + complex(kind=R8KIND) function m_complex_water_ray(lambda,t) implicit none !================================================================================================================= @@ -603,7 +606,7 @@ complex*16 function m_complex_water_ray(lambda,t) double precision,parameter:: pix=3.1415926535897932384626434d0 double precision:: epsinf,epss,epsr,epsi double precision:: alpha,lambdas,sigma,nenner - complex*16,parameter:: i = (0d0,1d0) + complex(kind=R8KIND),parameter:: i = (0d0,1d0) !----------------------------------------------------------------------------------------------------------------- @@ -627,7 +630,7 @@ complex*16 function m_complex_water_ray(lambda,t) end function m_complex_water_ray !================================================================================================================= - complex*16 function m_complex_ice_maetzler(lambda,t) + complex(kind=R8KIND) function m_complex_ice_maetzler(lambda,t) implicit none !=================================================================================================================