From e68614b5b2c159cc7cfdebdeb0ec5ee69b93c33f Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Fri, 12 Jan 2024 21:03:01 -0700 Subject: [PATCH 1/6] Adding w3emc wrapper to reduce the number of warnings for calling the real w3emc library. That library doesn't use interfaces so there is no way to get rid of all the warnings. --- physics/GWD/cires_tauamf_data.F90 | 3 +- .../UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 | 1 + .../GFS_time_vary_pre.scm.meta | 7 +- .../UFS_SCM_NEPTUNE/iccninterp.F90 | 1 + .../Interstitials/UFS_SCM_NEPTUNE/sfcsub.F | 2 + physics/MP/Morrison_Gettelman/aerinterp.F90 | 2 +- physics/w3emc_wrapper.F90 | 93 +++++++++++++++++++ 7 files changed, 104 insertions(+), 5 deletions(-) create mode 100644 physics/w3emc_wrapper.F90 diff --git a/physics/GWD/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 index 364c79409..4d0aca08f 100644 --- a/physics/GWD/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -171,8 +171,9 @@ end subroutine tau_amf_interp !> subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) - + use machine, only: kind_phys + use w3emc, only: w3movdat implicit none ! input integer, intent(in) :: idate(4) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index 3293e09e4..326b5cf63 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 @@ -70,6 +70,7 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec + use w3emc, only: w3difdat implicit none diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta index af9afcdfe..51abbe8ef 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta @@ -3,6 +3,7 @@ type = scheme relative_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F +ay to get rid of all the warnings.):physics/GFS_time_vary_pre.scm.meta ######################################################################## [ccpp-arg-table] @@ -73,14 +74,14 @@ [nsswr] standard_name = number_of_timesteps_between_shortwave_radiation_calls long_name = number of timesteps between shortwave radiation calls - units = + units = dimensions = () type = integer intent = in [nslwr] standard_name = number_of_timesteps_between_longwave_radiation_calls long_name = number of timesteps between longwave radiation calls - units = + units = dimensions = () type = integer intent = in @@ -176,7 +177,7 @@ [ipt] standard_name = index_of_horizontal_gridpoint_for_debug_output long_name = horizontal index for point used for diagnostic printout - units = index + units = index dimensions = () type = integer intent = out diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 index b90b6fca7..9c56be741 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @@ -134,6 +134,7 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & ! USE MACHINE, ONLY : kind_phys, kind_dbl_prec use iccn_def + use w3emc, only: w3movdat implicit none integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i real(kind=kind_phys) fhour,temj, tx1, tx2,temi diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F index 2ff33498b..f0b917ef1 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @@ -7069,6 +7069,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & &, tile_num_ch, i_index, j_index) ! use machine , only : kind_io8,kind_io4, kind_dbl_prec + use w3emc, only: w3movdat implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) @@ -8574,6 +8575,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & &, outlat, outlon, me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec use sfccyc_module, only : mdata + use w3emc, only: w3movdat implicit none integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & diff --git a/physics/MP/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index 74ae4726c..9de1ea263 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -6,7 +6,7 @@ !! This module contain subroutines of reading and interpolating !! aerosol data for MG microphysics. module aerinterp - + use w3emc, only: w3movdat implicit none private read_netfaer diff --git a/physics/w3emc_wrapper.F90 b/physics/w3emc_wrapper.F90 new file mode 100644 index 000000000..aed091efa --- /dev/null +++ b/physics/w3emc_wrapper.F90 @@ -0,0 +1,93 @@ +!> \file scm_kinds.f90 +!! Wrapper with generic interfaces for w3emc library to reduce warnings +! Modules wrap w3emc routines: +! - w3difdat: https://www.nco.ncep.noaa.gov/pmb/docs/libs/w3lib/w3difdat.html +! - w3movdat: https://www.nco.ncep.noaa.gov/pmb/docs/libs/w3lib/w3movdat.html +! +! Example of w3difdat: +! 1. w3emc module has w3difdat interface which calls w3difdat_wrapper +! 2. w3emc_wrapper has w3difdat_wrapper interface which calls true w3difdat +module w3emc_wrapper + use iso_fortran_env, only: real32, real64 + + interface w3difdat_wrapper + module procedure :: w3difdat32 + module procedure :: w3difdat64 + end interface w3difdat_wrapper + + interface w3movdat_wrapper + module procedure :: w3movdat32 + module procedure :: w3movdat64 + end interface w3movdat_wrapper + +contains + subroutine w3difdat32(jdat, idat, it, rinc) + integer, intent(in) :: jdat(8), idat(8), it + real(real32), intent(out) :: rinc(5) + call w3difdat(jdat, idat, it, rinc) + end subroutine w3difdat32 + + subroutine w3difdat64(jdat, idat, it, rinc) + integer, intent(in) :: jdat(8), idat(8), it + real(real64), intent(out) :: rinc(5) + call w3difdat(jdat, idat, it, rinc) + end subroutine w3difdat64 + + subroutine w3movdat32(rinc, idat, jdat) + real(real32), intent(in) :: rinc(5) + integer, intent(in) :: idat(8) + integer, intent(out) :: jdat(8) + call w3movdat(rinc, idat, jdat) + end subroutine w3movdat32 + + subroutine w3movdat64(rinc, idat, jdat) + real(real64), intent(in) :: rinc(5) + integer, intent(in) :: idat(8) + integer, intent(out) :: jdat(8) + call w3movdat(rinc, idat, jdat) + end subroutine w3movdat64 +end module w3emc_wrapper + +! Module to be loaded +module w3emc + use iso_fortran_env, only: real32, real64 + use w3emc_wrapper, only: w3difdat_wrapper, w3movdat_wrapper + implicit none + + interface w3difdat + module procedure :: w3difdat32 + module procedure :: w3difdat64 + end interface w3difdat + + interface w3movdat + module procedure :: w3movdat32 + module procedure :: w3movdat64 + end interface w3movdat + +contains + subroutine w3difdat32(jdat, idat, it, rinc) + integer, intent(in) :: jdat(8), idat(8), it + real(real32), intent(out) :: rinc(5) + call w3difdat_wrapper(jdat, idat, it, rinc) + end subroutine w3difdat32 + + subroutine w3difdat64(jdat, idat, it, rinc) + integer, intent(in) :: jdat(8), idat(8), it + real(real64), intent(out) :: rinc(5) + call w3difdat_wrapper(jdat, idat, it, rinc) + end subroutine w3difdat64 + + subroutine w3movdat32(rinc, idat, jdat) + real(real32), intent(in) :: rinc(5) + integer, intent(in) :: idat(8) + integer, intent(out) :: jdat(8) + call w3movdat_wrapper(rinc, idat, jdat) + end subroutine w3movdat32 + + subroutine w3movdat64(rinc, idat, jdat) + real(real64), intent(in) :: rinc(5) + integer, intent(in) :: idat(8) + integer, intent(out) :: jdat(8) + call w3movdat_wrapper(rinc, idat, jdat) + end subroutine w3movdat64 +end module w3emc From ac91637009fdf2d4b8e73ba658798f9bbff8a7aa Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sat, 13 Jan 2024 15:48:55 -0700 Subject: [PATCH 2/6] Checking to define macro CCPP only if it is not defined reduces macro redefinition warnings --- physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 | 2 ++ physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 | 2 ++ physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 2 ++ 3 files changed, 6 insertions(+) diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 index bcb157c54..f2ade5384 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 @@ -1,4 +1,6 @@ +#ifndef CCPP #define CCPP +#endif !> \file module_sf_noahmp_glacier.F90 !! This file contains the NoahMP Glacier scheme. diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index a76a354e6..92b499598 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 @@ -1,4 +1,6 @@ +#ifndef CCPP #define CCPP +#endif !> \file module_sf_noahmplsm.F90 !! This file contains the NoahMP land surface model. diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 1313e9ff3..de5e12878 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -1,4 +1,6 @@ +#ifndef CCPP #define CCPP +#endif !> \file noahmpdrv.F90 !! This file contains the NoahMP land surface scheme driver. From 30ecf04b1cd3a051bb826878d044647112500cb6 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sat, 13 Jan 2024 16:45:49 -0700 Subject: [PATCH 3/6] Setting true and false integer parameters to fix type conversion warning --- physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 index 797a1cd95..fbd1cb121 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 @@ -72,6 +72,7 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, integer, intent(out) :: errflg integer :: i + integer, parameter :: true = 1, false = 0 ! to match type of use_lake_model real(kind=kind_phys) :: rho, q1_non_neg, w_thv1, rho_cp_inverse, rho_hvap_inverse, Obukhov_length, thv1, tvs, & dtv, adtv, wind10m, u_fraction, roughness_length_m From 24ffa231caef56f44271aaf415fff273dc99369e Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Wed, 17 Jan 2024 12:27:43 -0700 Subject: [PATCH 4/6] Fixing 'Warning: Deleted feature: Start expression in DO loop at (1) must be integer' message by calling nint intrinsic. Copying the other do loops --- physics/SFC_Models/Lake/CLM/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 index 6dd973c8d..052d54d8c 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.f90 +++ b/physics/SFC_Models/Lake/CLM/clm_lake.f90 @@ -5626,7 +5626,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, ! initial t_soisno3d ! in snow if(snowdp2d(i) > 0.) then - do k = snl2d(i)+1, 0 + do k = nint(snl2d(i))+1, 0 t_soisno3d(i,k) =min(tfrz,tsfc(i)) enddo endif From 8fe9f1182a42c056000a3b3139974aa9b347d9f5 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Wed, 17 Jan 2024 17:32:35 -0700 Subject: [PATCH 5/6] More accurate variable names for setting use_lake_model and comment fix --- .../Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 | 8 ++++---- physics/w3emc_wrapper.F90 | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 index fbd1cb121..43d71a2d9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 @@ -72,7 +72,7 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, integer, intent(out) :: errflg integer :: i - integer, parameter :: true = 1, false = 0 ! to match type of use_lake_model + integer, parameter :: lake_model_on = 1, lake_model_off = 0 ! to match type of use_lake_model real(kind=kind_phys) :: rho, q1_non_neg, w_thv1, rho_cp_inverse, rho_hvap_inverse, Obukhov_length, thv1, tvs, & dtv, adtv, wind10m, u_fraction, roughness_length_m @@ -212,12 +212,12 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, do i = 1, im if ((wet(i) .or. icy(i)) .and. lakefrac(i) > 0.0_kind_phys) then if (lkm == 1 .and. lakefrac(i) >= 0.15 .and. lakedepth(i) > 1.0_kind_phys) then - use_lake_model(i) = 1 + use_lake_model(i) = lake_model_on else - use_lake_model(i) = 0 + use_lake_model(i) = lake_model_off endif else - use_lake_model(i) = 0 + use_lake_model(i) = lake_model_off endif enddo ! diff --git a/physics/w3emc_wrapper.F90 b/physics/w3emc_wrapper.F90 index aed091efa..e121cef6c 100644 --- a/physics/w3emc_wrapper.F90 +++ b/physics/w3emc_wrapper.F90 @@ -1,4 +1,4 @@ -!> \file scm_kinds.f90 +!> \file w3emc_wrapper.f90 !! Wrapper with generic interfaces for w3emc library to reduce warnings ! Modules wrap w3emc routines: ! - w3difdat: https://www.nco.ncep.noaa.gov/pmb/docs/libs/w3lib/w3difdat.html From e6d218e0075eafbb117d55c848e4d2a30102825b Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Thu, 9 May 2024 11:24:11 -0600 Subject: [PATCH 6/6] removed w3emc changes, this is fixed with a different method in an upcoming PR --- physics/GWD/cires_tauamf_data.F90 | 1 - .../UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 | 1 - .../GFS_time_vary_pre.scm.meta | 1 - .../UFS_SCM_NEPTUNE/iccninterp.F90 | 1 - .../Interstitials/UFS_SCM_NEPTUNE/sfcsub.F | 2 - physics/MP/Morrison_Gettelman/aerinterp.F90 | 1 - physics/w3emc_wrapper.F90 | 93 ------------------- 7 files changed, 100 deletions(-) delete mode 100644 physics/w3emc_wrapper.F90 diff --git a/physics/GWD/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 index 4d0aca08f..009d94d5d 100644 --- a/physics/GWD/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -173,7 +173,6 @@ end subroutine tau_amf_interp subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) use machine, only: kind_phys - use w3emc, only: w3movdat implicit none ! input integer, intent(in) :: idate(4) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index 326b5cf63..3293e09e4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 @@ -70,7 +70,6 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec - use w3emc, only: w3difdat implicit none diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta index 51abbe8ef..6eb4d9c3a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta @@ -3,7 +3,6 @@ type = scheme relative_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F -ay to get rid of all the warnings.):physics/GFS_time_vary_pre.scm.meta ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 index 9c56be741..b90b6fca7 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @@ -134,7 +134,6 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & ! USE MACHINE, ONLY : kind_phys, kind_dbl_prec use iccn_def - use w3emc, only: w3movdat implicit none integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i real(kind=kind_phys) fhour,temj, tx1, tx2,temi diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F index f0b917ef1..2ff33498b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @@ -7069,7 +7069,6 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & &, tile_num_ch, i_index, j_index) ! use machine , only : kind_io8,kind_io4, kind_dbl_prec - use w3emc, only: w3movdat implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) @@ -8575,7 +8574,6 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & &, outlat, outlon, me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec use sfccyc_module, only : mdata - use w3emc, only: w3movdat implicit none integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & diff --git a/physics/MP/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index 9de1ea263..34dd6b93d 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -6,7 +6,6 @@ !! This module contain subroutines of reading and interpolating !! aerosol data for MG microphysics. module aerinterp - use w3emc, only: w3movdat implicit none private read_netfaer diff --git a/physics/w3emc_wrapper.F90 b/physics/w3emc_wrapper.F90 deleted file mode 100644 index e121cef6c..000000000 --- a/physics/w3emc_wrapper.F90 +++ /dev/null @@ -1,93 +0,0 @@ -!> \file w3emc_wrapper.f90 -!! Wrapper with generic interfaces for w3emc library to reduce warnings -! Modules wrap w3emc routines: -! - w3difdat: https://www.nco.ncep.noaa.gov/pmb/docs/libs/w3lib/w3difdat.html -! - w3movdat: https://www.nco.ncep.noaa.gov/pmb/docs/libs/w3lib/w3movdat.html -! -! Example of w3difdat: -! 1. w3emc module has w3difdat interface which calls w3difdat_wrapper -! 2. w3emc_wrapper has w3difdat_wrapper interface which calls true w3difdat -module w3emc_wrapper - use iso_fortran_env, only: real32, real64 - - interface w3difdat_wrapper - module procedure :: w3difdat32 - module procedure :: w3difdat64 - end interface w3difdat_wrapper - - interface w3movdat_wrapper - module procedure :: w3movdat32 - module procedure :: w3movdat64 - end interface w3movdat_wrapper - -contains - subroutine w3difdat32(jdat, idat, it, rinc) - integer, intent(in) :: jdat(8), idat(8), it - real(real32), intent(out) :: rinc(5) - call w3difdat(jdat, idat, it, rinc) - end subroutine w3difdat32 - - subroutine w3difdat64(jdat, idat, it, rinc) - integer, intent(in) :: jdat(8), idat(8), it - real(real64), intent(out) :: rinc(5) - call w3difdat(jdat, idat, it, rinc) - end subroutine w3difdat64 - - subroutine w3movdat32(rinc, idat, jdat) - real(real32), intent(in) :: rinc(5) - integer, intent(in) :: idat(8) - integer, intent(out) :: jdat(8) - call w3movdat(rinc, idat, jdat) - end subroutine w3movdat32 - - subroutine w3movdat64(rinc, idat, jdat) - real(real64), intent(in) :: rinc(5) - integer, intent(in) :: idat(8) - integer, intent(out) :: jdat(8) - call w3movdat(rinc, idat, jdat) - end subroutine w3movdat64 -end module w3emc_wrapper - -! Module to be loaded -module w3emc - use iso_fortran_env, only: real32, real64 - use w3emc_wrapper, only: w3difdat_wrapper, w3movdat_wrapper - implicit none - - interface w3difdat - module procedure :: w3difdat32 - module procedure :: w3difdat64 - end interface w3difdat - - interface w3movdat - module procedure :: w3movdat32 - module procedure :: w3movdat64 - end interface w3movdat - -contains - subroutine w3difdat32(jdat, idat, it, rinc) - integer, intent(in) :: jdat(8), idat(8), it - real(real32), intent(out) :: rinc(5) - call w3difdat_wrapper(jdat, idat, it, rinc) - end subroutine w3difdat32 - - subroutine w3difdat64(jdat, idat, it, rinc) - integer, intent(in) :: jdat(8), idat(8), it - real(real64), intent(out) :: rinc(5) - call w3difdat_wrapper(jdat, idat, it, rinc) - end subroutine w3difdat64 - - subroutine w3movdat32(rinc, idat, jdat) - real(real32), intent(in) :: rinc(5) - integer, intent(in) :: idat(8) - integer, intent(out) :: jdat(8) - call w3movdat_wrapper(rinc, idat, jdat) - end subroutine w3movdat32 - - subroutine w3movdat64(rinc, idat, jdat) - real(real64), intent(in) :: rinc(5) - integer, intent(in) :: idat(8) - integer, intent(out) :: jdat(8) - call w3movdat_wrapper(rinc, idat, jdat) - end subroutine w3movdat64 -end module w3emc