Merge branch 'atmosphere/physics_mmm_f2008_compliance' into release-v8.0.0 (PR #1086)

This merge corrects Fortran 2008 compliance issues in physics modules that were
caught by the GNU Fortran compiler when using the -std=f2008 flag. Most of these
issues are related to the use of non-standard kind/type specifications.

Author: mgduda

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

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
 

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,15 +534,15 @@ 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
 !=================================================================================================================
 
 !--- 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
 !=================================================================================================================