From ffdf4ca62c7206cfbb07f7c9312ff02b650a7094 Mon Sep 17 00:00:00 2001 From: Michael Staneker Date: Thu, 21 Mar 2024 12:53:27 +0000 Subject: [PATCH] CUDA C SCC-HOIST: Loki generated (slightly manually adapted and fixed) and copied to ecwam/src --- src/phys-scc-cuda/airsea.c_hoist.F90 | 193 ++++ src/phys-scc-cuda/airsea_c.c | 69 ++ src/phys-scc-cuda/airsea_c.h | 22 + src/phys-scc-cuda/airsea_fc.F90 | 167 +++ src/phys-scc-cuda/airsea_fc.intfb.h | 91 ++ src/phys-scc-cuda/aki_ice.c_hoist.F90 | 114 ++ src/phys-scc-cuda/aki_ice_c.c | 51 + src/phys-scc-cuda/aki_ice_c.h | 9 + src/phys-scc-cuda/aki_ice_fc.F90 | 31 + src/phys-scc-cuda/aki_ice_fc.intfb.h | 16 + src/phys-scc-cuda/chnkmin.c_hoist.F90 | 60 + src/phys-scc-cuda/chnkmin_c.c | 19 + src/phys-scc-cuda/chnkmin_c.h | 9 + src/phys-scc-cuda/chnkmin_fc.F90 | 29 + src/phys-scc-cuda/chnkmin_fc.intfb.h | 15 + src/phys-scc-cuda/cimsstrn.c_hoist.F90 | 132 +++ src/phys-scc-cuda/cimsstrn_c.c | 50 + src/phys-scc-cuda/cimsstrn_c.h | 12 + src/phys-scc-cuda/cimsstrn_fc.F90 | 69 ++ src/phys-scc-cuda/cimsstrn_fc.intfb.h | 40 + src/phys-scc-cuda/ciwabr.c_hoist.F90 | 114 ++ src/phys-scc-cuda/ciwabr_c.c | 54 + src/phys-scc-cuda/ciwabr_c.h | 12 + src/phys-scc-cuda/ciwabr_fc.F90 | 64 ++ src/phys-scc-cuda/ciwabr_fc.intfb.h | 34 + src/phys-scc-cuda/femeanws.c_hoist.F90 | 130 +++ src/phys-scc-cuda/femeanws_c.c | 51 + src/phys-scc-cuda/femeanws_c.h | 12 + src/phys-scc-cuda/femeanws_fc.F90 | 66 ++ src/phys-scc-cuda/femeanws_fc.intfb.h | 34 + src/phys-scc-cuda/fkmean.c_hoist.F90 | 166 +++ src/phys-scc-cuda/fkmean_c.c | 73 ++ src/phys-scc-cuda/fkmean_c.h | 13 + src/phys-scc-cuda/fkmean_fc.F90 | 81 ++ src/phys-scc-cuda/fkmean_fc.intfb.h | 41 + src/phys-scc-cuda/frcutindex.c_hoist.F90 | 122 ++ src/phys-scc-cuda/frcutindex_c.c | 53 + src/phys-scc-cuda/frcutindex_c.h | 13 + src/phys-scc-cuda/frcutindex_fc.F90 | 75 ++ src/phys-scc-cuda/frcutindex_fc.intfb.h | 39 + src/phys-scc-cuda/halphap.c_hoist.F90 | 150 +++ src/phys-scc-cuda/halphap_c.c | 101 ++ src/phys-scc-cuda/halphap_c.h | 13 + src/phys-scc-cuda/halphap_fc.F90 | 71 ++ src/phys-scc-cuda/halphap_fc.intfb.h | 39 + src/phys-scc-cuda/imphftail.c_hoist.F90 | 99 ++ src/phys-scc-cuda/imphftail_c.c | 41 + src/phys-scc-cuda/imphftail_c.h | 11 + src/phys-scc-cuda/imphftail_fc.F90 | 52 + src/phys-scc-cuda/imphftail_fc.intfb.h | 26 + src/phys-scc-cuda/implsch.c_hoist.F90 | 833 ++++++++++++++ src/phys-scc-cuda/implsch_c.c | 461 ++++++++ src/phys-scc-cuda/implsch_c_launch.h | 141 +++ src/phys-scc-cuda/implsch_fc.F90 | 810 +++++++++++++ src/phys-scc-cuda/implsch_fc.intfb.h | 484 ++++++++ src/phys-scc-cuda/ns_gc.c_hoist.F90 | 54 + src/phys-scc-cuda/ns_gc_c.c | 23 + src/phys-scc-cuda/ns_gc_c.h | 10 + src/phys-scc-cuda/ns_gc_fc.F90 | 35 + src/phys-scc-cuda/ns_gc_fc.intfb.h | 18 + src/phys-scc-cuda/omegagc_c.c | 24 + src/phys-scc-cuda/omegagc_c.h | 11 + src/phys-scc-cuda/omegagc_fc.F90 | 53 + src/phys-scc-cuda/peak_ang.c_hoist.F90 | 180 +++ src/phys-scc-cuda/peak_ang_c.c | 118 ++ src/phys-scc-cuda/peak_ang_c.h | 13 + src/phys-scc-cuda/peak_ang_fc.F90 | 72 ++ src/phys-scc-cuda/peak_ang_fc.intfb.h | 37 + src/phys-scc-cuda/sbottom.c_hoist.F90 | 106 ++ src/phys-scc-cuda/sbottom_c.c | 48 + src/phys-scc-cuda/sbottom_c.h | 11 + src/phys-scc-cuda/sbottom_fc.F90 | 56 + src/phys-scc-cuda/sbottom_fc.intfb.h | 29 + src/phys-scc-cuda/sdepthlim.c_hoist.F90 | 101 ++ src/phys-scc-cuda/sdepthlim_c.c | 52 + src/phys-scc-cuda/sdepthlim_c.h | 11 + src/phys-scc-cuda/sdepthlim_fc.F90 | 54 + src/phys-scc-cuda/sdepthlim_fc.intfb.h | 26 + src/phys-scc-cuda/sdissip.c_hoist.F90 | 137 +++ src/phys-scc-cuda/sdissip_ard.c_hoist.F90 | 231 ++++ src/phys-scc-cuda/sdissip_ard_c.c | 136 +++ src/phys-scc-cuda/sdissip_ard_c.h | 15 + src/phys-scc-cuda/sdissip_ard_fc.F90 | 103 ++ src/phys-scc-cuda/sdissip_ard_fc.intfb.h | 57 + src/phys-scc-cuda/sdissip_c.c | 43 + src/phys-scc-cuda/sdissip_c.h | 18 + src/phys-scc-cuda/sdissip_fc.F90 | 138 +++ src/phys-scc-cuda/sdissip_fc.intfb.h | 79 ++ src/phys-scc-cuda/sdissip_jan.c_hoist.F90 | 141 +++ src/phys-scc-cuda/sdissip_jan_c.c | 56 + src/phys-scc-cuda/sdissip_jan_c.h | 12 + src/phys-scc-cuda/sdissip_jan_fc.F90 | 69 ++ src/phys-scc-cuda/sdissip_jan_fc.intfb.h | 38 + src/phys-scc-cuda/sdiwbk.c_hoist.F90 | 134 +++ src/phys-scc-cuda/sdiwbk_c.c | 69 ++ src/phys-scc-cuda/sdiwbk_c.h | 12 + src/phys-scc-cuda/sdiwbk_fc.F90 | 59 + src/phys-scc-cuda/sdiwbk_fc.intfb.h | 31 + src/phys-scc-cuda/setice.c_hoist.F90 | 92 ++ src/phys-scc-cuda/setice_c.c | 45 + src/phys-scc-cuda/setice_c.h | 11 + src/phys-scc-cuda/setice_fc.F90 | 54 + src/phys-scc-cuda/setice_fc.intfb.h | 27 + src/phys-scc-cuda/sinflx.c_hoist.F90 | 349 ++++++ src/phys-scc-cuda/sinflx_c.c | 148 +++ src/phys-scc-cuda/sinflx_c.h | 44 + src/phys-scc-cuda/sinflx_fc.F90 | 412 +++++++ src/phys-scc-cuda/sinflx_fc.intfb.h | 238 ++++ src/phys-scc-cuda/sinput.c_hoist.F90 | 167 +++ src/phys-scc-cuda/sinput_ard.c_hoist.F90 | 1010 +++++++++++++++++ src/phys-scc-cuda/sinput_ard_c.c | 370 ++++++ src/phys-scc-cuda/sinput_ard_c.h | 22 + src/phys-scc-cuda/sinput_ard_fc.F90 | 170 +++ src/phys-scc-cuda/sinput_c.c | 53 + src/phys-scc-cuda/sinput_c.h | 23 + src/phys-scc-cuda/sinput_fc.F90 | 173 +++ src/phys-scc-cuda/sinput_fc.intfb.h | 87 ++ src/phys-scc-cuda/sinput_jan_c.c | 196 ++++ src/phys-scc-cuda/sinput_jan_c.h | 18 + src/phys-scc-cuda/sinput_jan_fc.F90 | 122 ++ src/phys-scc-cuda/snonlin.c_hoist.F90 | 480 ++++++++ src/phys-scc-cuda/snonlin_c.c | 419 +++++++ src/phys-scc-cuda/snonlin_c.h | 22 + src/phys-scc-cuda/snonlin_fc.F90 | 173 +++ src/phys-scc-cuda/snonlin_fc.intfb.h | 97 ++ src/phys-scc-cuda/stokesdrift.c_hoist.F90 | 155 +++ src/phys-scc-cuda/stokesdrift_c.c | 74 ++ src/phys-scc-cuda/stokesdrift_c.h | 14 + src/phys-scc-cuda/stokesdrift_fc.F90 | 79 ++ src/phys-scc-cuda/stokesdrift_fc.intfb.h | 42 + src/phys-scc-cuda/stokestrn.c_hoist.F90 | 142 +++ src/phys-scc-cuda/stokestrn_c.c | 53 + src/phys-scc-cuda/stokestrn_c.h | 19 + src/phys-scc-cuda/stokestrn_fc.F90 | 139 +++ src/phys-scc-cuda/stokestrn_fc.intfb.h | 80 ++ src/phys-scc-cuda/stress_gc.c_hoist.F90 | 144 +++ src/phys-scc-cuda/stress_gc_c.c | 74 ++ src/phys-scc-cuda/stress_gc_c.h | 15 + src/phys-scc-cuda/stress_gc_fc.F90 | 95 ++ src/phys-scc-cuda/stress_gc_fc.intfb.h | 55 + src/phys-scc-cuda/stresso.c_hoist.F90 | 262 +++++ src/phys-scc-cuda/stresso_c.c | 142 +++ src/phys-scc-cuda/stresso_c.h | 21 + src/phys-scc-cuda/stresso_fc.F90 | 157 +++ src/phys-scc-cuda/stresso_fc.intfb.h | 79 ++ src/phys-scc-cuda/tau_phi_hf.c_hoist.F90 | 461 ++++++++ src/phys-scc-cuda/tau_phi_hf_c.c | 215 ++++ src/phys-scc-cuda/tau_phi_hf_c.h | 17 + src/phys-scc-cuda/tau_phi_hf_fc.F90 | 119 ++ src/phys-scc-cuda/taut_z0.c_hoist.F90 | 409 +++++++ src/phys-scc-cuda/taut_z0_c.c | 313 +++++ src/phys-scc-cuda/taut_z0_c.h | 21 + src/phys-scc-cuda/taut_z0_fc.F90 | 172 +++ src/phys-scc-cuda/taut_z0_fc.intfb.h | 97 ++ src/phys-scc-cuda/transf.c_hoist.F90 | 71 ++ src/phys-scc-cuda/transf_c.c | 47 + src/phys-scc-cuda/transf_c.h | 9 + src/phys-scc-cuda/transf_fc.F90 | 29 + src/phys-scc-cuda/transf_fc.intfb.h | 15 + src/phys-scc-cuda/transf_snl.c_hoist.F90 | 90 ++ src/phys-scc-cuda/transf_snl_c.c | 64 ++ src/phys-scc-cuda/transf_snl_c.h | 10 + src/phys-scc-cuda/transf_snl_fc.F90 | 38 + src/phys-scc-cuda/transf_snl_fc.intfb.h | 20 + .../wamintgr_loki_gpu.c_hoist.F90 | 462 ++++++++ src/phys-scc-cuda/wnfluxes.c_hoist.F90 | 289 +++++ src/phys-scc-cuda/wnfluxes_c.c | 186 +++ src/phys-scc-cuda/wnfluxes_c.h | 21 + src/phys-scc-cuda/wnfluxes_fc.F90 | 160 +++ src/phys-scc-cuda/wnfluxes_fc.intfb.h | 84 ++ src/phys-scc-cuda/wsigstar_c.c | 65 ++ src/phys-scc-cuda/wsigstar_c.h | 11 + src/phys-scc-cuda/wsigstar_fc.F90 | 57 + src/phys-scc-cuda/yowaltas.c_hoist.F90 | 176 +++ src/phys-scc-cuda/yowcoup.c_hoist.F90 | 251 ++++ src/phys-scc-cuda/yowcout.c_hoist.F90 | 152 +++ src/phys-scc-cuda/yowfred.c_hoist.F90 | 219 ++++ src/phys-scc-cuda/yowice.c_hoist.F90 | 83 ++ src/phys-scc-cuda/yowindn.c_hoist.F90 | 130 +++ src/phys-scc-cuda/yowparam.c_hoist.F90 | 101 ++ src/phys-scc-cuda/yowpcons.c_hoist.F90 | 133 +++ src/phys-scc-cuda/yowphys.c_hoist.F90 | 195 ++++ src/phys-scc-cuda/yowshal.c_hoist.F90 | 69 ++ src/phys-scc-cuda/yowstat.c_hoist.F90 | 262 +++++ src/phys-scc-cuda/yowtabl.c_hoist.F90 | 142 +++ src/phys-scc-cuda/yowwind.c_hoist.F90 | 91 ++ src/phys-scc-cuda/yowwndg.c_hoist.F90 | 37 + src/phys-scc-cuda/z0wave.c_hoist.F90 | 107 ++ src/phys-scc-cuda/z0wave_c.c | 38 + src/phys-scc-cuda/z0wave_c.h | 12 + src/phys-scc-cuda/z0wave_fc.F90 | 71 ++ src/phys-scc-cuda/z0wave_fc.intfb.h | 39 + 192 files changed, 21220 insertions(+) create mode 100644 src/phys-scc-cuda/airsea.c_hoist.F90 create mode 100644 src/phys-scc-cuda/airsea_c.c create mode 100644 src/phys-scc-cuda/airsea_c.h create mode 100644 src/phys-scc-cuda/airsea_fc.F90 create mode 100644 src/phys-scc-cuda/airsea_fc.intfb.h create mode 100644 src/phys-scc-cuda/aki_ice.c_hoist.F90 create mode 100644 src/phys-scc-cuda/aki_ice_c.c create mode 100644 src/phys-scc-cuda/aki_ice_c.h create mode 100644 src/phys-scc-cuda/aki_ice_fc.F90 create mode 100644 src/phys-scc-cuda/aki_ice_fc.intfb.h create mode 100644 src/phys-scc-cuda/chnkmin.c_hoist.F90 create mode 100644 src/phys-scc-cuda/chnkmin_c.c create mode 100644 src/phys-scc-cuda/chnkmin_c.h create mode 100644 src/phys-scc-cuda/chnkmin_fc.F90 create mode 100644 src/phys-scc-cuda/chnkmin_fc.intfb.h create mode 100644 src/phys-scc-cuda/cimsstrn.c_hoist.F90 create mode 100644 src/phys-scc-cuda/cimsstrn_c.c create mode 100644 src/phys-scc-cuda/cimsstrn_c.h create mode 100644 src/phys-scc-cuda/cimsstrn_fc.F90 create mode 100644 src/phys-scc-cuda/cimsstrn_fc.intfb.h create mode 100644 src/phys-scc-cuda/ciwabr.c_hoist.F90 create mode 100644 src/phys-scc-cuda/ciwabr_c.c create mode 100644 src/phys-scc-cuda/ciwabr_c.h create mode 100644 src/phys-scc-cuda/ciwabr_fc.F90 create mode 100644 src/phys-scc-cuda/ciwabr_fc.intfb.h create mode 100644 src/phys-scc-cuda/femeanws.c_hoist.F90 create mode 100644 src/phys-scc-cuda/femeanws_c.c create mode 100644 src/phys-scc-cuda/femeanws_c.h create mode 100644 src/phys-scc-cuda/femeanws_fc.F90 create mode 100644 src/phys-scc-cuda/femeanws_fc.intfb.h create mode 100644 src/phys-scc-cuda/fkmean.c_hoist.F90 create mode 100644 src/phys-scc-cuda/fkmean_c.c create mode 100644 src/phys-scc-cuda/fkmean_c.h create mode 100644 src/phys-scc-cuda/fkmean_fc.F90 create mode 100644 src/phys-scc-cuda/fkmean_fc.intfb.h create mode 100644 src/phys-scc-cuda/frcutindex.c_hoist.F90 create mode 100644 src/phys-scc-cuda/frcutindex_c.c create mode 100644 src/phys-scc-cuda/frcutindex_c.h create mode 100644 src/phys-scc-cuda/frcutindex_fc.F90 create mode 100644 src/phys-scc-cuda/frcutindex_fc.intfb.h create mode 100644 src/phys-scc-cuda/halphap.c_hoist.F90 create mode 100644 src/phys-scc-cuda/halphap_c.c create mode 100644 src/phys-scc-cuda/halphap_c.h create mode 100644 src/phys-scc-cuda/halphap_fc.F90 create mode 100644 src/phys-scc-cuda/halphap_fc.intfb.h create mode 100644 src/phys-scc-cuda/imphftail.c_hoist.F90 create mode 100644 src/phys-scc-cuda/imphftail_c.c create mode 100644 src/phys-scc-cuda/imphftail_c.h create mode 100644 src/phys-scc-cuda/imphftail_fc.F90 create mode 100644 src/phys-scc-cuda/imphftail_fc.intfb.h create mode 100644 src/phys-scc-cuda/implsch.c_hoist.F90 create mode 100644 src/phys-scc-cuda/implsch_c.c create mode 100644 src/phys-scc-cuda/implsch_c_launch.h create mode 100644 src/phys-scc-cuda/implsch_fc.F90 create mode 100644 src/phys-scc-cuda/implsch_fc.intfb.h create mode 100644 src/phys-scc-cuda/ns_gc.c_hoist.F90 create mode 100644 src/phys-scc-cuda/ns_gc_c.c create mode 100644 src/phys-scc-cuda/ns_gc_c.h create mode 100644 src/phys-scc-cuda/ns_gc_fc.F90 create mode 100644 src/phys-scc-cuda/ns_gc_fc.intfb.h create mode 100644 src/phys-scc-cuda/omegagc_c.c create mode 100644 src/phys-scc-cuda/omegagc_c.h create mode 100644 src/phys-scc-cuda/omegagc_fc.F90 create mode 100644 src/phys-scc-cuda/peak_ang.c_hoist.F90 create mode 100644 src/phys-scc-cuda/peak_ang_c.c create mode 100644 src/phys-scc-cuda/peak_ang_c.h create mode 100644 src/phys-scc-cuda/peak_ang_fc.F90 create mode 100644 src/phys-scc-cuda/peak_ang_fc.intfb.h create mode 100644 src/phys-scc-cuda/sbottom.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sbottom_c.c create mode 100644 src/phys-scc-cuda/sbottom_c.h create mode 100644 src/phys-scc-cuda/sbottom_fc.F90 create mode 100644 src/phys-scc-cuda/sbottom_fc.intfb.h create mode 100644 src/phys-scc-cuda/sdepthlim.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sdepthlim_c.c create mode 100644 src/phys-scc-cuda/sdepthlim_c.h create mode 100644 src/phys-scc-cuda/sdepthlim_fc.F90 create mode 100644 src/phys-scc-cuda/sdepthlim_fc.intfb.h create mode 100644 src/phys-scc-cuda/sdissip.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sdissip_ard.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sdissip_ard_c.c create mode 100644 src/phys-scc-cuda/sdissip_ard_c.h create mode 100644 src/phys-scc-cuda/sdissip_ard_fc.F90 create mode 100644 src/phys-scc-cuda/sdissip_ard_fc.intfb.h create mode 100644 src/phys-scc-cuda/sdissip_c.c create mode 100644 src/phys-scc-cuda/sdissip_c.h create mode 100644 src/phys-scc-cuda/sdissip_fc.F90 create mode 100644 src/phys-scc-cuda/sdissip_fc.intfb.h create mode 100644 src/phys-scc-cuda/sdissip_jan.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sdissip_jan_c.c create mode 100644 src/phys-scc-cuda/sdissip_jan_c.h create mode 100644 src/phys-scc-cuda/sdissip_jan_fc.F90 create mode 100644 src/phys-scc-cuda/sdissip_jan_fc.intfb.h create mode 100644 src/phys-scc-cuda/sdiwbk.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sdiwbk_c.c create mode 100644 src/phys-scc-cuda/sdiwbk_c.h create mode 100644 src/phys-scc-cuda/sdiwbk_fc.F90 create mode 100644 src/phys-scc-cuda/sdiwbk_fc.intfb.h create mode 100644 src/phys-scc-cuda/setice.c_hoist.F90 create mode 100644 src/phys-scc-cuda/setice_c.c create mode 100644 src/phys-scc-cuda/setice_c.h create mode 100644 src/phys-scc-cuda/setice_fc.F90 create mode 100644 src/phys-scc-cuda/setice_fc.intfb.h create mode 100644 src/phys-scc-cuda/sinflx.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sinflx_c.c create mode 100644 src/phys-scc-cuda/sinflx_c.h create mode 100644 src/phys-scc-cuda/sinflx_fc.F90 create mode 100644 src/phys-scc-cuda/sinflx_fc.intfb.h create mode 100644 src/phys-scc-cuda/sinput.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sinput_ard.c_hoist.F90 create mode 100644 src/phys-scc-cuda/sinput_ard_c.c create mode 100644 src/phys-scc-cuda/sinput_ard_c.h create mode 100644 src/phys-scc-cuda/sinput_ard_fc.F90 create mode 100644 src/phys-scc-cuda/sinput_c.c create mode 100644 src/phys-scc-cuda/sinput_c.h create mode 100644 src/phys-scc-cuda/sinput_fc.F90 create mode 100644 src/phys-scc-cuda/sinput_fc.intfb.h create mode 100644 src/phys-scc-cuda/sinput_jan_c.c create mode 100644 src/phys-scc-cuda/sinput_jan_c.h create mode 100644 src/phys-scc-cuda/sinput_jan_fc.F90 create mode 100644 src/phys-scc-cuda/snonlin.c_hoist.F90 create mode 100644 src/phys-scc-cuda/snonlin_c.c create mode 100644 src/phys-scc-cuda/snonlin_c.h create mode 100644 src/phys-scc-cuda/snonlin_fc.F90 create mode 100644 src/phys-scc-cuda/snonlin_fc.intfb.h create mode 100644 src/phys-scc-cuda/stokesdrift.c_hoist.F90 create mode 100644 src/phys-scc-cuda/stokesdrift_c.c create mode 100644 src/phys-scc-cuda/stokesdrift_c.h create mode 100644 src/phys-scc-cuda/stokesdrift_fc.F90 create mode 100644 src/phys-scc-cuda/stokesdrift_fc.intfb.h create mode 100644 src/phys-scc-cuda/stokestrn.c_hoist.F90 create mode 100644 src/phys-scc-cuda/stokestrn_c.c create mode 100644 src/phys-scc-cuda/stokestrn_c.h create mode 100644 src/phys-scc-cuda/stokestrn_fc.F90 create mode 100644 src/phys-scc-cuda/stokestrn_fc.intfb.h create mode 100644 src/phys-scc-cuda/stress_gc.c_hoist.F90 create mode 100644 src/phys-scc-cuda/stress_gc_c.c create mode 100644 src/phys-scc-cuda/stress_gc_c.h create mode 100644 src/phys-scc-cuda/stress_gc_fc.F90 create mode 100644 src/phys-scc-cuda/stress_gc_fc.intfb.h create mode 100644 src/phys-scc-cuda/stresso.c_hoist.F90 create mode 100644 src/phys-scc-cuda/stresso_c.c create mode 100644 src/phys-scc-cuda/stresso_c.h create mode 100644 src/phys-scc-cuda/stresso_fc.F90 create mode 100644 src/phys-scc-cuda/stresso_fc.intfb.h create mode 100644 src/phys-scc-cuda/tau_phi_hf.c_hoist.F90 create mode 100644 src/phys-scc-cuda/tau_phi_hf_c.c create mode 100644 src/phys-scc-cuda/tau_phi_hf_c.h create mode 100644 src/phys-scc-cuda/tau_phi_hf_fc.F90 create mode 100644 src/phys-scc-cuda/taut_z0.c_hoist.F90 create mode 100644 src/phys-scc-cuda/taut_z0_c.c create mode 100644 src/phys-scc-cuda/taut_z0_c.h create mode 100644 src/phys-scc-cuda/taut_z0_fc.F90 create mode 100644 src/phys-scc-cuda/taut_z0_fc.intfb.h create mode 100644 src/phys-scc-cuda/transf.c_hoist.F90 create mode 100644 src/phys-scc-cuda/transf_c.c create mode 100644 src/phys-scc-cuda/transf_c.h create mode 100644 src/phys-scc-cuda/transf_fc.F90 create mode 100644 src/phys-scc-cuda/transf_fc.intfb.h create mode 100644 src/phys-scc-cuda/transf_snl.c_hoist.F90 create mode 100644 src/phys-scc-cuda/transf_snl_c.c create mode 100644 src/phys-scc-cuda/transf_snl_c.h create mode 100644 src/phys-scc-cuda/transf_snl_fc.F90 create mode 100644 src/phys-scc-cuda/transf_snl_fc.intfb.h create mode 100644 src/phys-scc-cuda/wamintgr_loki_gpu.c_hoist.F90 create mode 100644 src/phys-scc-cuda/wnfluxes.c_hoist.F90 create mode 100644 src/phys-scc-cuda/wnfluxes_c.c create mode 100644 src/phys-scc-cuda/wnfluxes_c.h create mode 100644 src/phys-scc-cuda/wnfluxes_fc.F90 create mode 100644 src/phys-scc-cuda/wnfluxes_fc.intfb.h create mode 100644 src/phys-scc-cuda/wsigstar_c.c create mode 100644 src/phys-scc-cuda/wsigstar_c.h create mode 100644 src/phys-scc-cuda/wsigstar_fc.F90 create mode 100644 src/phys-scc-cuda/yowaltas.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowcoup.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowcout.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowfred.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowice.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowindn.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowparam.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowpcons.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowphys.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowshal.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowstat.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowtabl.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowwind.c_hoist.F90 create mode 100644 src/phys-scc-cuda/yowwndg.c_hoist.F90 create mode 100644 src/phys-scc-cuda/z0wave.c_hoist.F90 create mode 100644 src/phys-scc-cuda/z0wave_c.c create mode 100644 src/phys-scc-cuda/z0wave_c.h create mode 100644 src/phys-scc-cuda/z0wave_fc.F90 create mode 100644 src/phys-scc-cuda/z0wave_fc.intfb.h diff --git a/src/phys-scc-cuda/airsea.c_hoist.F90 b/src/phys-scc-cuda/airsea.c_hoist.F90 new file mode 100644 index 00000000..8c118d5d --- /dev/null +++ b/src/phys-scc-cuda/airsea.c_hoist.F90 @@ -0,0 +1,193 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE AIRSEA_FC (KIJS, KIJL, HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, ICODE_WND, & +& IUSFG, ACD, ALPHA, ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, & +& CHNKMIN_U, CM_GC, DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, & +& OM3GMKM_GC, OMXKM3_GC, RN1_RN, RNU, RNUM, SQRTGOSURFT, WSPMIN, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, & +& ZALP, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *AIRSEA* - DETERMINE TOTAL STRESS IN SURFACE LAYER. + + ! P.A.E.M. JANSSEN KNMI AUGUST 1990 + ! JEAN BIDLOT ECMWF FEBRUARY 1999 : TAUT is already + ! SQRT(TAUT) + ! JEAN BIDLOT ECMWF OCTOBER 2004: QUADRATIC STEP FOR + ! TAUW + + !* PURPOSE. + ! -------- + + ! COMPUTE TOTAL STRESS. + + !** INTERFACE. + ! ---------- + + ! *CALL* *AIRSEA (KIJS, KIJL, FL1, WAVNUM, + ! HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, + ! US, Z0, Z0B, CHRNCK, ICODE_WND, IUSFG)* + + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *FL1* - SPECTRA + ! *WAVNUM* - WAVE NUMBER + ! *HALP* - 1/2 PHILLIPS PARAMETER + ! *U10* - WINDSPEED U10. + ! *U10DIR* - WINDSPEED DIRECTION. + ! *TAUW* - WAVE STRESS. + ! *TAUWDIR* - WAVE STRESS DIRECTION. + ! *RNFAC* - WIND DEPENDENT FACTOR USED IN THE GROWTH RENORMALISATION. + ! *US* - OUTPUT OR OUTPUT BLOCK OF FRICTION VELOCITY. + ! *Z0* - OUTPUT BLOCK OF ROUGHNESS LENGTH. + ! *Z0B* - BACKGROUND ROUGHNESS LENGTH. + ! *CHRNCK* - CHARNOCK COEFFICIENT + ! *ICODE_WND* SPECIFIES WHICH OF U10 OR US HAS BEEN FILED UPDATED: + ! U10: ICODE_WND=3 --> US will be updated + ! US: ICODE_WND=1 OR 2 --> U10 will be updated + ! *IUSFG* - IF = 1 THEN USE THE FRICTION VELOCITY (US) AS FIRST GUESS in TAUT_Z0 + ! 0 DO NOT USE THE FIELD US + + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE, NANG + USE YOWTEST, ONLY: IU06 + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + INTERFACE + SUBROUTINE TAUT_Z0_FC (KIJS, KIJL, IUSFG, HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, IUSFG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: USTAR + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE TAUT_Z0_FC + END INTERFACE + INTERFACE + SUBROUTINE Z0WAVE_FC (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: US, TAUW, UTOP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE Z0WAVE_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_WND + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IUSFG + REAL(KIND=JWRB), TARGET, INTENT(IN) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: U10DIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: U10(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: US(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: I + INTEGER(KIND=JWIM) :: J + + REAL(KIND=JWRB) :: XI + REAL(KIND=JWRB) :: XJ + REAL(KIND=JWRB) :: DELI1 + REAL(KIND=JWRB) :: DELI2 + REAL(KIND=JWRB) :: DELJ1 + REAL(KIND=JWRB) :: DELJ2 + REAL(KIND=JWRB) :: UST2 + REAL(KIND=JWRB) :: ARG + REAL(KIND=JWRB) :: SQRTCDM1 + REAL(KIND=JWRB) :: XKAPPAD + REAL(KIND=JWRB) :: XLOGLEV + REAL(KIND=JWRB) :: XLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + !* 2. DETERMINE TOTAL STRESS (if needed) + ! ---------------------------------- + + IF (ICODE_WND == 3) THEN + + CALL TAUT_Z0_FC(KIJS, KIJL, IUSFG, HALP(:), U10(:, :), U10DIR(:, :), TAUW(:, :), TAUWDIR(:, :), RNFAC(:), US(:, :), & + & Z0(:, :), Z0B(:, :), CHRNCK(:, :), ACD, ALPHA, ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, & + & BMAXOKAP, C2OSQRTVG_GC(:), CDMAX, CHNKMIN_U, CM_GC(:), DELKCC_GC_NS(:), DELKCC_OMXKM3_GC(:), EPS1, EPSMIN, EPSUS, G, GM1, & + & LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC(:), OMXKM3_GC(:), RN1_RN, RNU, RNUM, SQRTGOSURFT, XKAPPA, & + & XKMSQRTVGOC2_GC(:), XKM_GC(:), XK_GC(:), XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, IJ) + + ELSE IF (ICODE_WND == 1 .or. ICODE_WND == 2) THEN + + !* 3. DETERMINE ROUGHNESS LENGTH (if needed). + ! --------------------------- + + CALL Z0WAVE_FC(KIJS, KIJL, US(:, :), TAUW(:, :), U10(:, :), Z0(:, :), Z0B(:, :), CHRNCK(:, :), ALPHA, ALPHAMIN, CHNKMIN_U, & + & EPS1, G, GM1, LLCAPCHNK, ICHNK, NCHNK, IJ) + + !* 3. DETERMINE U10 (if needed). + ! --------------------------- + + XKAPPAD = 1.0_JWRB / XKAPPA + XLOGLEV = LOG(XNLEV) + + + U10(IJ, ICHNK) = XKAPPAD*US(IJ, ICHNK)*(XLOGLEV - LOG(Z0(IJ, ICHNK))) + U10(IJ, ICHNK) = MAX(U10(IJ, ICHNK), WSPMIN) + + + END IF + + +END SUBROUTINE AIRSEA_FC diff --git a/src/phys-scc-cuda/airsea_c.c b/src/phys-scc-cuda/airsea_c.c new file mode 100644 index 00000000..b7dfd1cf --- /dev/null +++ b/src/phys-scc-cuda/airsea_c.c @@ -0,0 +1,69 @@ +#include +#include +#include +#include +#include +#include +#include "airsea_c.h" +#include "z0wave_c.h" +#include "taut_z0_c.h" + +__device__ void airsea_c(int kijs, int kijl, const double * halp, double * u10, + const double * u10dir, const double * tauw, const double * tauwdir, + const double * rnfac, double * us, double * z0, double * z0b, double * chrnck, + int icode_wnd, int iusfg, double acd, double alpha, double alphamax, double alphamin, + double ang_gc_a, double ang_gc_b, double ang_gc_c, double bcd, double betamaxoxkappa2, + double bmaxokap, const double * c2osqrtvg_gc, double cdmax, double chnkmin_u, + const double * cm_gc, const double * delkcc_gc_ns, const double * delkcc_omxkm3_gc, + double eps1, double epsmin, double epsus, double g, double gm1, int llcapchnk, + int llgcbz0, int llnormagam, int nwav_gc, const double * om3gmkm_gc, + const double * omxkm3_gc, double rn1_rn, double rnu, double rnum, double sqrtgosurft, + double wspmin, double xkappa, const double * xkmsqrtvgoc2_gc, const double * xkm_gc, + const double * xk_gc, double xlogkratiom1_gc, double xnlev, double zalp, int ichnk, + int nchnk, int ij) { + + + + + + int i; + int j; + + double xi; + double xj; + double deli1; + double deli2; + double delj1; + double delj2; + double ust2; + double arg; + double sqrtcdm1; + double xkappad; + double xloglev; + double xlev; + if (icode_wnd == 3) { + + taut_z0_c(kijs, kijl, iusfg, halp, u10, u10dir, tauw, tauwdir, rnfac, us, z0, z0b, + chrnck, acd, alpha, alphamax, alphamin, ang_gc_a, ang_gc_b, ang_gc_c, bcd, + betamaxoxkappa2, bmaxokap, c2osqrtvg_gc, cdmax, chnkmin_u, cm_gc, delkcc_gc_ns, + delkcc_omxkm3_gc, eps1, epsmin, epsus, g, gm1, llcapchnk, llgcbz0, llnormagam, + nwav_gc, om3gmkm_gc, omxkm3_gc, rn1_rn, rnu, rnum, sqrtgosurft, xkappa, + xkmsqrtvgoc2_gc, xkm_gc, xk_gc, xlogkratiom1_gc, xnlev, zalp, ichnk, nchnk, ij); + + } else if (icode_wnd == 1 || icode_wnd == 2) { + z0wave_c(kijs, kijl, us, tauw, u10, z0, z0b, chrnck, alpha, alphamin, chnkmin_u, + eps1, g, gm1, llcapchnk, ichnk, nchnk, ij); + xkappad = (double) 1.0 / xkappa; + xloglev = log(xnlev); + + + u10[ij - 1 + kijl*(ichnk - 1)] = xkappad*us[ij - 1 + kijl*(ichnk - 1)]*(xloglev - + log(z0[ij - 1 + kijl*(ichnk - 1)])); + u10[ij - 1 + kijl*(ichnk - 1)] = + max((double) (u10[ij - 1 + kijl*(ichnk - 1)]), (double) (wspmin)); + + + } + + +} diff --git a/src/phys-scc-cuda/airsea_c.h b/src/phys-scc-cuda/airsea_c.h new file mode 100644 index 00000000..9942b26a --- /dev/null +++ b/src/phys-scc-cuda/airsea_c.h @@ -0,0 +1,22 @@ +#include +#include +#include +#include +#include +#include +#include "z0wave_c.h" +#include "taut_z0_c.h" + +__device__ void airsea_c(int kijs, int kijl, const double * halp, double * u10, + const double * u10dir, const double * tauw, const double * tauwdir, + const double * rnfac, double * us, double * z0, double * z0b, double * chrnck, + int icode_wnd, int iusfg, double acd, double alpha, double alphamax, double alphamin, + double ang_gc_a, double ang_gc_b, double ang_gc_c, double bcd, double betamaxoxkappa2, + double bmaxokap, const double * c2osqrtvg_gc, double cdmax, double chnkmin_u, + const double * cm_gc, const double * delkcc_gc_ns, const double * delkcc_omxkm3_gc, + double eps1, double epsmin, double epsus, double g, double gm1, int llcapchnk, + int llgcbz0, int llnormagam, int nwav_gc, const double * om3gmkm_gc, + const double * omxkm3_gc, double rn1_rn, double rnu, double rnum, double sqrtgosurft, + double wspmin, double xkappa, const double * xkmsqrtvgoc2_gc, const double * xkm_gc, + const double * xk_gc, double xlogkratiom1_gc, double xnlev, double zalp, int ichnk, + int nchnk, int ij); diff --git a/src/phys-scc-cuda/airsea_fc.F90 b/src/phys-scc-cuda/airsea_fc.F90 new file mode 100644 index 00000000..b73bf61f --- /dev/null +++ b/src/phys-scc-cuda/airsea_fc.F90 @@ -0,0 +1,167 @@ +MODULE AIRSEA_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE AIRSEA_fc (KIJS, KIJL, HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, ICODE_WND, IUSFG, ACD, ALPHA, & + & ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CM_GC, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, & + & RN1_RN, RNU, RNUM, SQRTGOSURFT, WSPMIN, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, & + & IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + INTERFACE + SUBROUTINE TAUT_Z0 (KIJS, KIJL, IUSFG, HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, IUSFG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: USTAR + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE TAUT_Z0 + END INTERFACE + INTERFACE + SUBROUTINE Z0WAVE (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: US, TAUW, UTOP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE Z0WAVE + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_WND + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IUSFG + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE AIRSEA_iso_c (KIJS, KIJL, HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, ICODE_WND, IUSFG, ACD, & + & ALPHA, ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, & + & CM_GC, DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, & + & OMXKM3_GC, RN1_RN, RNU, RNUM, SQRTGOSURFT, WSPMIN, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, ZALP, & + & ICHNK, NCHNK, IJ) BIND(c, name="airsea_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: HALP + TYPE(c_ptr), VALUE :: U10 + TYPE(c_ptr), VALUE :: U10DIR + TYPE(c_ptr), VALUE :: TAUW + TYPE(c_ptr), VALUE :: TAUWDIR + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: US + TYPE(c_ptr), VALUE :: Z0 + TYPE(c_ptr), VALUE :: Z0B + TYPE(c_ptr), VALUE :: CHRNCK + INTEGER(KIND=c_int), VALUE :: ICODE_WND + INTEGER(KIND=c_int), VALUE :: IUSFG + REAL, VALUE :: ACD + REAL, VALUE :: ALPHA + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: ANG_GC_A + REAL, VALUE :: ANG_GC_B + REAL, VALUE :: ANG_GC_C + REAL, VALUE :: BCD + REAL, VALUE :: BETAMAXOXKAPPA2 + REAL, VALUE :: BMAXOKAP + TYPE(c_ptr), VALUE :: C2OSQRTVG_GC + REAL, VALUE :: CDMAX + REAL, VALUE :: CHNKMIN_U + TYPE(c_ptr), VALUE :: CM_GC + TYPE(c_ptr), VALUE :: DELKCC_GC_NS + TYPE(c_ptr), VALUE :: DELKCC_OMXKM3_GC + REAL, VALUE :: EPS1 + REAL, VALUE :: EPSMIN + REAL, VALUE :: EPSUS + REAL, VALUE :: G + REAL, VALUE :: GM1 + LOGICAL, VALUE :: LLCAPCHNK + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OM3GMKM_GC + TYPE(c_ptr), VALUE :: OMXKM3_GC + REAL, VALUE :: RN1_RN + REAL, VALUE :: RNU + REAL, VALUE :: RNUM + REAL, VALUE :: SQRTGOSURFT + REAL, VALUE :: WSPMIN + REAL, VALUE :: XKAPPA + TYPE(c_ptr), VALUE :: XKMSQRTVGOC2_GC + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + REAL, VALUE :: XNLEV + REAL, VALUE :: ZALP + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE AIRSEA_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: U10(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: U10DIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: US(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) +!$acc host_data use_device( HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, C2OSQRTVG_GC, CM_GC, DELKCC_GC_NS, & +!$acc & DELKCC_OMXKM3_GC, OM3GMKM_GC, OMXKM3_GC, XKMSQRTVGOC2_GC, XKM_GC, XK_GC ) + CALL AIRSEA_iso_c(KIJS, KIJL, c_loc(HALP), c_loc(U10), c_loc(U10DIR), c_loc(TAUW), c_loc(TAUWDIR), c_loc(RNFAC), c_loc(US), & + & c_loc(Z0), c_loc(Z0B), c_loc(CHRNCK), ICODE_WND, IUSFG, ACD, ALPHA, ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, & + & BETAMAXOXKAPPA2, BMAXOKAP, c_loc(C2OSQRTVG_GC), CDMAX, CHNKMIN_U, c_loc(CM_GC), c_loc(DELKCC_GC_NS), & + & c_loc(DELKCC_OMXKM3_GC), EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, c_loc(OM3GMKM_GC), & + & c_loc(OMXKM3_GC), RN1_RN, RNU, RNUM, SQRTGOSURFT, WSPMIN, XKAPPA, c_loc(XKMSQRTVGOC2_GC), c_loc(XKM_GC), c_loc(XK_GC), & + & XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE AIRSEA_fc +END MODULE AIRSEA_FC_MOD diff --git a/src/phys-scc-cuda/airsea_fc.intfb.h b/src/phys-scc-cuda/airsea_fc.intfb.h new file mode 100644 index 00000000..d701054f --- /dev/null +++ b/src/phys-scc-cuda/airsea_fc.intfb.h @@ -0,0 +1,91 @@ +INTERFACE + SUBROUTINE AIRSEA_FC (KIJS, KIJL, HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, ICODE_WND, IUSFG, ACD, ALPHA, & + & ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CM_GC, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, & + & RN1_RN, RNU, RNUM, SQRTGOSURFT, WSPMIN, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, & + & IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE, NANG + USE YOWTEST, ONLY: IU06 + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + INTERFACE + SUBROUTINE TAUT_Z0_FC (KIJS, KIJL, IUSFG, HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, IUSFG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: USTAR + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE TAUT_Z0_FC + END INTERFACE + INTERFACE + SUBROUTINE Z0WAVE_FC (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: US, TAUW, UTOP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE Z0WAVE_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_WND + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IUSFG + REAL(KIND=JWRB), TARGET, INTENT(IN) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: U10DIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: U10(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: US(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE AIRSEA_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/aki_ice.c_hoist.F90 b/src/phys-scc-cuda/aki_ice.c_hoist.F90 new file mode 100644 index 00000000..29eab76b --- /dev/null +++ b/src/phys-scc-cuda/aki_ice.c_hoist.F90 @@ -0,0 +1,114 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) FUNCTION AKI_ICE_FC (G, XK, DEPTH, RHOW, CITH) + + ! ---------------------------------------------------------------------- + + !**** *AKI_ICE* - FUNCTION TO COMPUTE WAVE NUMBER UNDER THE ICE. + ! FOR A GIVEN OPEN WATER WAVE NUMBER. + + !* PURPOSE. + ! ------- + + ! *AKI_ICE* COMPUTES THE REAL WAVE NUMBER UNDER THE ICE AS FUNCTION OF + ! OPEN OCEAN WAVE NUMBER, THE WATER DEPTH AND THE ICE THICKNESS. + + !** INTERFACE. + ! ---------- + + ! *FUNCTION* *AKI_ICE (G,XK,DEPTH,RHOW,CITH))* + ! *G* - ACCELERATION OF GRAVITY (m/s**2). + ! *XK* - OPEN OCEAN WAVE NUMBER (1/m). + ! *DEPTH* - WATER DEPTH (m). + ! *RHOW* - WATER DENSITY (kg/m**3). + ! *CITH* - SEA ICE THICKNESS (m). + + ! METHOD. + ! ------- + + ! NEWTONS METHOD TO SOLVE THE LINEAR DISPERSION RELATION IN + ! SHALLOW WATER UNDER AN INFINITELY LONG ELASTIC FLOATING PLATE + ! REPRESENTING THE SEA ICE. THE MECHANICAL PROPERTIES OF THE SEA + ! ICE IS GIVEn BY ITS YOUNG MODULUS, THE POISSON'S RATIO AND ITS + ! DENSITY (these are fixed for now, see below). + + ! IF F(x)=0, then solve iteratively + ! x(n+1) = x(n) - F(x(n))/F'(x(n)) + + ! WHERE F'(x) IS THE FIRST DERIVATIVE OF F WITH RESPECT TO x. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! FOX AND SQUIRE, 1991, JGR 96, C3, 4531-4547. + + ! NONE. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + IMPLICIT NONE + + REAL(KIND=JWRB) :: AKI_ICE_FC + REAL(KIND=JWRB), INTENT(IN) :: G, XK, DEPTH, RHOW, CITH + + ! ICE PROPERTIES (assumed fixed for now) + REAL(KIND=JWRB), PARAMETER :: YMICE = 5.5E+9_JWRB ! typical value of Young modulus of sea ice + REAL(KIND=JWRB), PARAMETER :: RMUICE = 0.3_JWRB ! Poisson's ratio of sea ice + REAL(KIND=JWRB), PARAMETER :: RHOI = 922.5_JWRB ! typical value of the sea ice density + + ! RELATIVE ERROR LIMIT OF NEWTONS METHOD. + REAL(KIND=JWRB), PARAMETER :: EBS = 0.000001_JWRB + ! MAXIMUM WAVE NUMBER + REAL(KIND=JWRB), PARAMETER :: AKI_MAX = 20.0_JWRB + + REAL(KIND=JWRB) :: FICSTF, RDH + REAL(KIND=JWRB) :: OM2, AKI, AKIOLD, F, FPRIME, AKID +!$acc routine seq + + + IF (CITH <= 0.0_JWRB) THEN + AKI = XK + ELSE + ! BENDING STIFFNESS / WATER DENSITY + FICSTF = (YMICE*CITH**3 / (12*(1 - RMUICE**2))) / RHOW + + ! DENSITY RATIO * ICE THICKNESS + RDH = (RHOI / RHOW)*CITH + + ! SQUARE OF THE OPEN OCEAN ANGULAR FREQUENCY + OM2 = G*XK*TANH(XK*DEPTH) + + !* 2. ITERATION LOOP. + ! --------------- + + AKIOLD = 0.0_JWRB + AKI = MIN(XK, (OM2 / MAX(FICSTF, 1.0_JWRB))**0.2_JWRB) + + DO WHILE (ABS(AKI - AKIOLD) > EBS*AKIOLD .and. AKI < AKI_MAX) + AKIOLD = AKI + AKID = MIN(DEPTH*AKI, 50.0_JWRB) + F = FICSTF*AKI**5 + G*AKI - OM2*(RDH*AKI + 1. / TANH(AKID)) + FPRIME = 5._JWRB*FICSTF*AKI**4 + G - OM2*(RDH - DEPTH / (SINH(AKID)**2)) + AKI = AKI - F / FPRIME + ! in case of overshoot because it is trying to find a very large wave number + IF (AKI <= 0.0_JWRB) AKI = AKI_MAX + END DO + + END IF + + AKI_ICE_FC = AKI + +END FUNCTION AKI_ICE_FC diff --git a/src/phys-scc-cuda/aki_ice_c.c b/src/phys-scc-cuda/aki_ice_c.c new file mode 100644 index 00000000..8649f187 --- /dev/null +++ b/src/phys-scc-cuda/aki_ice_c.c @@ -0,0 +1,51 @@ +#include +#include +#include +#include +#include +#include +#include "aki_ice_c.h" + +__device__ double aki_ice_c(double g, double xk, double depth, double rhow, double cith) { + + + double aki_ice; + double ymice = (double) 5.5E+9; // typical value of Young modulus of sea ice + double rmuice = (double) 0.3; // Poisson's ratio of sea ice + double rhoi = (double) 922.5; // typical value of the sea ice density + double ebs = (double) 0.000001; + // MAXIMUM WAVE NUMBER + double aki_max = (double) 20.0; + + double ficstf, rdh; + double om2, aki, akiold, f, fprime, akid; + // + if (cith <= (double) 0.0) { + aki = xk; + } else { + // BENDING STIFFNESS / WATER DENSITY + ficstf = (ymice*(pow(cith, 3)) / (12*(1 - (pow(rmuice, 2))))) / rhow; + rdh = (rhoi / rhow)*cith; + om2 = g*xk*tanh(xk*depth); + akiold = (double) 0.0; + aki = min((double) (xk), (double) (pow((om2 / max((double) (ficstf), (double) + ((double) 1.0))), (double) 0.2))); + + while (abs((double) (aki - akiold)) > ebs*akiold && aki < aki_max) { + akiold = aki; + akid = min((double) (depth*aki), (double) ((double) 50.0)); + f = ficstf*(pow(aki, 5)) + g*aki - om2*(rdh*aki + 1. / tanh(akid)); + fprime = + (double) 5.*ficstf*(pow(aki, 4)) + g - om2*(rdh - depth / (pow(sinh(akid), 2))); + aki = aki - f / fprime; + // in case of overshoot because it is trying to find a very large wave number + if (aki <= (double) 0.0) { + aki = aki_max; + } + } + + } + + aki_ice = aki; + return aki_ice; +} diff --git a/src/phys-scc-cuda/aki_ice_c.h b/src/phys-scc-cuda/aki_ice_c.h new file mode 100644 index 00000000..bca69a3e --- /dev/null +++ b/src/phys-scc-cuda/aki_ice_c.h @@ -0,0 +1,9 @@ +#include +#include +#include +#include +#include +#include + + +__device__ double aki_ice_c(double g, double xk, double depth, double rhow, double cith); diff --git a/src/phys-scc-cuda/aki_ice_fc.F90 b/src/phys-scc-cuda/aki_ice_fc.F90 new file mode 100644 index 00000000..c5a7516f --- /dev/null +++ b/src/phys-scc-cuda/aki_ice_fc.F90 @@ -0,0 +1,31 @@ +MODULE AKI_ICE_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE AKI_ICE_fc (G, XK, DEPTH, RHOW, CITH) + USE PARKIND_WAVE, ONLY: JWRB + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: G, XK, DEPTH, RHOW, CITH + + ! ICE PROPERTIES (assumed fixed for now) + + ! RELATIVE ERROR LIMIT OF NEWTONS METHOD. + ! MAXIMUM WAVE NUMBER + +!$acc routine seq + INTERFACE + SUBROUTINE AKI_ICE_iso_c (G, XK, DEPTH, RHOW, CITH) BIND(c, name="aki_ice_c_launch") + implicit none + REAL, VALUE :: G + REAL, VALUE :: XK + REAL, VALUE :: DEPTH + REAL, VALUE :: RHOW + REAL, VALUE :: CITH + END SUBROUTINE AKI_ICE_iso_c + END INTERFACE +!$acc host_data use_device + CALL AKI_ICE_iso_c(G, XK, DEPTH, RHOW, CITH) +!$acc end host_data + END SUBROUTINE AKI_ICE_fc +END MODULE AKI_ICE_FC_MOD diff --git a/src/phys-scc-cuda/aki_ice_fc.intfb.h b/src/phys-scc-cuda/aki_ice_fc.intfb.h new file mode 100644 index 00000000..6f5f186e --- /dev/null +++ b/src/phys-scc-cuda/aki_ice_fc.intfb.h @@ -0,0 +1,16 @@ +INTERFACE + SUBROUTINE AKI_ICE_FC (G, XK, DEPTH, RHOW, CITH) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: G, XK, DEPTH, RHOW, CITH + + ! ICE PROPERTIES (assumed fixed for now) + + ! RELATIVE ERROR LIMIT OF NEWTONS METHOD. + ! MAXIMUM WAVE NUMBER + +!$acc routine seq + END SUBROUTINE AKI_ICE_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/chnkmin.c_hoist.F90 b/src/phys-scc-cuda/chnkmin.c_hoist.F90 new file mode 100644 index 00000000..0c128a98 --- /dev/null +++ b/src/phys-scc-cuda/chnkmin.c_hoist.F90 @@ -0,0 +1,60 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) FUNCTION CHNKMIN_FC (U10, ALPHA, ALPHAMIN, CHNKMIN_U) + + ! ---------------------------------------------------------------------- + + !**** *CHNKMIN* - FUNCTION TO COMPUTE THE MINMUM CHARNOCK + + !* PURPOSE. + ! ------- + + + !** INTERFACE. + ! ---------- + + ! *FUNCTION* *CHNKMIN (U10)* + + ! METHOD. + ! ------- + + ! CHNKMIN = ALPHAMIN + (ALPHA-ALPHAMIN)*0.5_JWRB*(1.0_JWRB-TANH(U10-A)) + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! NONE. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB) :: CHNKMIN_FC + REAL(KIND=JWRB), INTENT(IN) :: U10 + REAL(KIND=JWRB), INTENT(IN) :: ALPHA + REAL(KIND=JWRB), INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), INTENT(IN) :: CHNKMIN_U +!$acc routine seq + + ! ---------------------------------------------------------------------- + + + CHNKMIN_FC = ALPHAMIN + (ALPHA - ALPHAMIN)*0.5_JWRB*(1.0_JWRB - TANH(U10 - CHNKMIN_U)) + + +END FUNCTION CHNKMIN_FC diff --git a/src/phys-scc-cuda/chnkmin_c.c b/src/phys-scc-cuda/chnkmin_c.c new file mode 100644 index 00000000..e8f26368 --- /dev/null +++ b/src/phys-scc-cuda/chnkmin_c.c @@ -0,0 +1,19 @@ +#include +#include +#include +#include +#include +#include +#include "chnkmin_c.h" + +__device__ double chnkmin_c(double u10, double alpha, double alphamin, double chnkmin_u) { + + + double chnkmin; + // + + chnkmin = + alphamin + (alpha - alphamin)*(double) 0.5*((double) 1.0 - tanh(u10 - chnkmin_u)); + + return chnkmin; +} diff --git a/src/phys-scc-cuda/chnkmin_c.h b/src/phys-scc-cuda/chnkmin_c.h new file mode 100644 index 00000000..2e74799a --- /dev/null +++ b/src/phys-scc-cuda/chnkmin_c.h @@ -0,0 +1,9 @@ +#include +#include +#include +#include +#include +#include + + +__device__ double chnkmin_c(double u10, double alpha, double alphamin, double chnkmin_u); diff --git a/src/phys-scc-cuda/chnkmin_fc.F90 b/src/phys-scc-cuda/chnkmin_fc.F90 new file mode 100644 index 00000000..f74d3047 --- /dev/null +++ b/src/phys-scc-cuda/chnkmin_fc.F90 @@ -0,0 +1,29 @@ +MODULE CHNKMIN_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE CHNKMIN_fc (U10, ALPHA, ALPHAMIN, CHNKMIN_U) + USE PARKIND_WAVE, ONLY: JWRB + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: U10 + REAL(KIND=JWRB), INTENT(IN) :: ALPHA + REAL(KIND=JWRB), INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), INTENT(IN) :: CHNKMIN_U +!$acc routine seq + INTERFACE + SUBROUTINE CHNKMIN_iso_c (U10, ALPHA, ALPHAMIN, CHNKMIN_U) BIND(c, name="chnkmin_c_launch") + implicit none + REAL, VALUE :: U10 + REAL, VALUE :: ALPHA + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: CHNKMIN_U + END SUBROUTINE CHNKMIN_iso_c + END INTERFACE +!$acc host_data use_device + CALL CHNKMIN_iso_c(U10, ALPHA, ALPHAMIN, CHNKMIN_U) +!$acc end host_data + END SUBROUTINE CHNKMIN_fc +END MODULE CHNKMIN_FC_MOD diff --git a/src/phys-scc-cuda/chnkmin_fc.intfb.h b/src/phys-scc-cuda/chnkmin_fc.intfb.h new file mode 100644 index 00000000..72441622 --- /dev/null +++ b/src/phys-scc-cuda/chnkmin_fc.intfb.h @@ -0,0 +1,15 @@ +INTERFACE + SUBROUTINE CHNKMIN_FC (U10, ALPHA, ALPHAMIN, CHNKMIN_U) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: U10 + REAL(KIND=JWRB), INTENT(IN) :: ALPHA + REAL(KIND=JWRB), INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), INTENT(IN) :: CHNKMIN_U +!$acc routine seq + END SUBROUTINE CHNKMIN_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/cimsstrn.c_hoist.F90 b/src/phys-scc-cuda/cimsstrn.c_hoist.F90 new file mode 100644 index 00000000..cc094730 --- /dev/null +++ b/src/phys-scc-cuda/cimsstrn.c_hoist.F90 @@ -0,0 +1,132 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE CIMSSTRN_FC (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN, DELTH, DFIM, FLMIN, G, NANG, NFRE, & +& ROWATER, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *CIMSSTRN* - COMPUTATION OF THE MEAN SQUARE WAVE STRAIN IN SEA ICE. + + ! J. BIDLOT ECMWF JANUARY 2013. + + !* PURPOSE. + ! -------- + + ! COMPUTES MEAN SQUARE WAVE STRAIN AT EACH GRID POINT. + + !** INTERFACE. + ! ---------- + + ! *CALL* *CIMSSTRN (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN)* + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *WAVNUM* - OPEN WATER WAVE NUMBER + ! *DEPTH* - WATER DEPTH + ! *CITHICK* - SEA ICE THICKNESS + ! *STRN* - MEAN SQUARE WAVE STRAIN IN ICE (OUTPUT). + + ! METHOD. + ! ------- + + ! !!! IT ASSUMES SO DEFAULT SETTING FOR THE MECHANICAL PROPERTIES OF + ! THE SEA ICE (SEE AKI_ICE) !!!!!!! + + ! NONE. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! NONE. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR + USE YOWPCONS, ONLY: ZPI + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION AKI_ICE_FC (G, XK, DEPTH, RHOW, CITH) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: AKI_ICE + REAL(KIND=JWRB), INTENT(IN) :: G, XK, DEPTH, RHOW, CITH + END FUNCTION AKI_ICE_FC + END INTERFACE + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: STRN(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: K + REAL(KIND=JWRB) :: F1LIM + REAL(KIND=JWRB) :: XKI + REAL(KIND=JWRB) :: E + REAL(KIND=JWRB) :: SUME + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + !* 1. INITIALISE + ! ---------- + + F1LIM = FLMIN / DELTH + + + STRN(IJ, ICHNK) = 0.0_JWRB + + ! ---------------------------------------------------------------------- + + !* 2. INTEGRATE OVER FREQUENCIES AND DIRECTIONS. + ! ------------------------------------------ + + DO M=1,NFRE + XKI = AKI_ICE_FC(G, WAVNUM(IJ, M, ICHNK), DEPTH(IJ, ICHNK), ROWATER, CITHICK(IJ, ICHNK)) + E = 0.5_JWRB*CITHICK(IJ, ICHNK)*XKI**3 / WAVNUM(IJ, M, ICHNK) + + SUME = 0.0_JWRB + DO K=1,NANG + SUME = SUME + FL1(IJ, K, M, ICHNK) + END DO + + IF (SUME > F1LIM) THEN + STRN(IJ, ICHNK) = STRN(IJ, ICHNK) + E**2*SUME*DFIM(M) + END IF + + END DO + + + +END SUBROUTINE CIMSSTRN_FC diff --git a/src/phys-scc-cuda/cimsstrn_c.c b/src/phys-scc-cuda/cimsstrn_c.c new file mode 100644 index 00000000..66f8c5ec --- /dev/null +++ b/src/phys-scc-cuda/cimsstrn_c.c @@ -0,0 +1,50 @@ +#include +#include +#include +#include +#include +#include +#include "cimsstrn_c.h" +#include "aki_ice_c.h" + +__device__ void cimsstrn_c(int kijs, int kijl, const double * fl1, + const double * wavnum, const double * depth, const double * cithick, double * strn, + double delth, const double * dfim, double flmin, double g, int nang, int nfre, + double rowater, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int m; + int k; + double f1lim; + double xki; + double e; + double sume; + f1lim = flmin / delth; + + + strn[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + for (m = 1; m <= nfre; m += 1) { + xki = aki_ice_c(g, wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))], + depth[ij - 1 + kijl*(ichnk - 1)], rowater, cithick[ij - 1 + kijl*(ichnk - 1)]); + e = (double) 0.5*cithick[ij - 1 + kijl*(ichnk - 1)]*(pow(xki, 3)) / wavnum[ij - 1 + + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]; + + sume = (double) 0.0; + for (k = 1; k <= nang; k += 1) { + sume = sume + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + + if (sume > f1lim) { + strn[ij - 1 + kijl*(ichnk - 1)] = + strn[ij - 1 + kijl*(ichnk - 1)] + (pow(e, 2))*sume*dfim[m - 1]; + } + + } + + + +} diff --git a/src/phys-scc-cuda/cimsstrn_c.h b/src/phys-scc-cuda/cimsstrn_c.h new file mode 100644 index 00000000..a6c5bc64 --- /dev/null +++ b/src/phys-scc-cuda/cimsstrn_c.h @@ -0,0 +1,12 @@ +#include +#include +#include +#include +#include +#include +#include "aki_ice_c.h" + +__device__ void cimsstrn_c(int kijs, int kijl, const double * fl1, + const double * wavnum, const double * depth, const double * cithick, double * strn, + double delth, const double * dfim, double flmin, double g, int nang, int nfre, + double rowater, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/cimsstrn_fc.F90 b/src/phys-scc-cuda/cimsstrn_fc.F90 new file mode 100644 index 00000000..dcf07b21 --- /dev/null +++ b/src/phys-scc-cuda/cimsstrn_fc.F90 @@ -0,0 +1,69 @@ +MODULE CIMSSTRN_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE CIMSSTRN_fc (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN, DELTH, DFIM, FLMIN, G, NANG, NFRE, ROWATER, ICHNK, & + & NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION AKI_ICE (G, XK, DEPTH, RHOW, CITH) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: AKI_ICE + REAL(KIND=JWRB), INTENT(IN) :: G, XK, DEPTH, RHOW, CITH + END FUNCTION AKI_ICE + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE CIMSSTRN_iso_c (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN, DELTH, DFIM, FLMIN, G, NANG, NFRE, ROWATER, & + & ICHNK, NCHNK, IJ) BIND(c, name="cimsstrn_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: DEPTH + TYPE(c_ptr), VALUE :: CITHICK + TYPE(c_ptr), VALUE :: STRN + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + REAL, VALUE :: FLMIN + REAL, VALUE :: G + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: ROWATER + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE CIMSSTRN_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: STRN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) +!$acc host_data use_device( FL1, WAVNUM, DEPTH, CITHICK, STRN, DFIM ) + CALL CIMSSTRN_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(WAVNUM), c_loc(DEPTH), c_loc(CITHICK), c_loc(STRN), DELTH, c_loc(DFIM), & + & FLMIN, G, NANG, NFRE, ROWATER, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE CIMSSTRN_fc +END MODULE CIMSSTRN_FC_MOD diff --git a/src/phys-scc-cuda/cimsstrn_fc.intfb.h b/src/phys-scc-cuda/cimsstrn_fc.intfb.h new file mode 100644 index 00000000..50ec839e --- /dev/null +++ b/src/phys-scc-cuda/cimsstrn_fc.intfb.h @@ -0,0 +1,40 @@ +INTERFACE + SUBROUTINE CIMSSTRN_FC (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN, DELTH, DFIM, FLMIN, G, NANG, NFRE, ROWATER, ICHNK, & + & NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR + USE YOWPCONS, ONLY: ZPI + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION AKI_ICE_FC (G, XK, DEPTH, RHOW, CITH) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: AKI_ICE + REAL(KIND=JWRB), INTENT(IN) :: G, XK, DEPTH, RHOW, CITH + END FUNCTION AKI_ICE_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: STRN(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE CIMSSTRN_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/ciwabr.c_hoist.F90 b/src/phys-scc-cuda/ciwabr.c_hoist.F90 new file mode 100644 index 00000000..e51f1db6 --- /dev/null +++ b/src/phys-scc-cuda/ciwabr.c_hoist.F90 @@ -0,0 +1,114 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE CIWABR_FC (KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIWAB, CDICWA, DFIM, EPSMIN, IDELT, LICERUN, & +& LMASKICE, NANG, NFRE, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *CIWABR* - COMPUTE SEA ICE WAVE ATTENUATION FACTORS DUE TO ICE FLOES + ! BOTTOM FRICTION. + + !* PURPOSE. + ! -------- + + ! CIWABR COMPUTES SEA ICE WAVE ATTENUATION FACTORS DUE TO ICE FLOES + ! BOTTOM FRICTION. + + !** INTERFACE. + ! ---------- + + ! *CALL* *CIWABR (KIJS,KIJL,CICOVER,FL1,CIWAB) + + ! *KIJS* - INDEX OF FIRST POINT. + ! *KIJL* - INDEX OF LAST POINT. + ! *CICOVER* -SEA ICE COVER. + ! *FL1* -ENERGY SPECTRUM. + ! *CIWAB* -SEA ICE WAVE ATTENUATION FACTOR DUE TO ICE FLOE BOTTOM FRICTION + + ! METHOD. + ! ------- + + ! EXTERNALS. + ! ---------- + + ! REFERENCES. + ! ----------- + + ! KOHOUT A., M. MEYLAN, D PLEW, 2011: ANNALS OF GLACIOLOGY, 2011. + + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, DELTH + USE YOWPCONS, ONLY: ZPI4GM2, G, ZPI + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CGROUP(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CIWAB(:, :, :) + + + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB) :: EWH + REAL(KIND=JWRB) :: X + REAL(KIND=JWRB) :: ALP + REAL(KIND=JWRB) :: XK2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDICWA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDELT + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LMASKICE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + + IF (.not.LICERUN .or. LMASKICE) THEN + + DO M=1,NFRE + DO K=1,NANG + CIWAB(IJ, K, M) = 1.0_JWRB + END DO + END DO + + ELSE + + DO M=1,NFRE + DO K=1,NANG + EWH = 4.0_JWRB*SQRT(MAX(EPSMIN, FL1(IJ, K, M, ICHNK)*DFIM(M))) + XK2 = WAVNUM(IJ, M, ICHNK)**2 + ALP = CDICWA*XK2*EWH + X = ALP*CGROUP(IJ, M, ICHNK)*IDELT + CIWAB(IJ, K, M) = 1.0_JWRB - CICOVER(IJ, ICHNK)*(1.0_JWRB - EXP(-MIN(X, 50.0_JWRB))) + END DO + END DO + + END IF + + + +END SUBROUTINE CIWABR_FC diff --git a/src/phys-scc-cuda/ciwabr_c.c b/src/phys-scc-cuda/ciwabr_c.c new file mode 100644 index 00000000..a08c2277 --- /dev/null +++ b/src/phys-scc-cuda/ciwabr_c.c @@ -0,0 +1,54 @@ +#include +#include +#include +#include +#include +#include +#include "ciwabr_c.h" + +__device__ void ciwabr_c(int kijs, int kijl, const double * cicover, const double * fl1, + const double * wavnum, const double * cgroup, double * ciwab, double cdicwa, + const double * dfim, double epsmin, int idelt, int licerun, int lmaskice, int nang, + int nfre, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int k; + int m; + double ewh; + double x; + double alp; + double xk2; + + + if (!licerun || lmaskice) { + + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + ciwab[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = (double) 1.0; + } + } + + } else { + + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + ewh = (double) 4.0*sqrt((double) (max((double) (epsmin), (double) (fl1[ij - 1 + + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]*dfim[m - + 1])))); + xk2 = pow(wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))], 2); + alp = cdicwa*xk2*ewh; + x = alp*cgroup[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]*idelt; + ciwab[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = (double) 1.0 - + cicover[ij - 1 + kijl*(ichnk - 1)]*((double) 1.0 - exp((double) (-min((double) + (x), (double) ((double) 50.0))))); + } + } + + } + + + +} diff --git a/src/phys-scc-cuda/ciwabr_c.h b/src/phys-scc-cuda/ciwabr_c.h new file mode 100644 index 00000000..fc88ba51 --- /dev/null +++ b/src/phys-scc-cuda/ciwabr_c.h @@ -0,0 +1,12 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void ciwabr_c(int kijs, int kijl, const double * cicover, const double * fl1, + const double * wavnum, const double * cgroup, double * ciwab, double cdicwa, + const double * dfim, double epsmin, int idelt, int licerun, int lmaskice, int nang, + int nfre, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/ciwabr_fc.F90 b/src/phys-scc-cuda/ciwabr_fc.F90 new file mode 100644 index 00000000..28b4a0b7 --- /dev/null +++ b/src/phys-scc-cuda/ciwabr_fc.F90 @@ -0,0 +1,64 @@ +MODULE CIWABR_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE CIWABR_fc (KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIWAB, CDICWA, DFIM, EPSMIN, IDELT, LICERUN, LMASKICE, NANG, & + & NFRE, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDICWA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDELT + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LMASKICE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE CIWABR_iso_c (KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIWAB, CDICWA, DFIM, EPSMIN, IDELT, LICERUN, LMASKICE, & + & NANG, NFRE, ICHNK, NCHNK, IJ) BIND(c, name="ciwabr_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: CGROUP + TYPE(c_ptr), VALUE :: CIWAB + REAL, VALUE :: CDICWA + TYPE(c_ptr), VALUE :: DFIM + REAL, VALUE :: EPSMIN + INTEGER(KIND=c_int), VALUE :: IDELT + LOGICAL, VALUE :: LICERUN + LOGICAL, VALUE :: LMASKICE + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE CIWABR_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CGROUP(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CIWAB(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) +!$acc host_data use_device( CICOVER, FL1, WAVNUM, CGROUP, CIWAB, DFIM ) + CALL CIWABR_iso_c(KIJS, KIJL, c_loc(CICOVER), c_loc(FL1), c_loc(WAVNUM), c_loc(CGROUP), c_loc(CIWAB), CDICWA, c_loc(DFIM), & + & EPSMIN, IDELT, LICERUN, LMASKICE, NANG, NFRE, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE CIWABR_fc +END MODULE CIWABR_FC_MOD diff --git a/src/phys-scc-cuda/ciwabr_fc.intfb.h b/src/phys-scc-cuda/ciwabr_fc.intfb.h new file mode 100644 index 00000000..85db5f93 --- /dev/null +++ b/src/phys-scc-cuda/ciwabr_fc.intfb.h @@ -0,0 +1,34 @@ +INTERFACE + SUBROUTINE CIWABR_FC (KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIWAB, CDICWA, DFIM, EPSMIN, IDELT, LICERUN, LMASKICE, NANG, & + & NFRE, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, DELTH + USE YOWPCONS, ONLY: ZPI4GM2, G, ZPI + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CGROUP(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CIWAB(:, :, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDICWA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDELT + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LMASKICE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE CIWABR_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/femeanws.c_hoist.F90 b/src/phys-scc-cuda/femeanws.c_hoist.F90 new file mode 100644 index 00000000..b5ffffbc --- /dev/null +++ b/src/phys-scc-cuda/femeanws.c_hoist.F90 @@ -0,0 +1,130 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE FEMEANWS_FC (KIJS, KIJL, FL1, XLLWS, FM, EM, DELTH, DFIM, DFIMOFR, EPSMIN, FR, FRTAIL, NANG, NFRE, & +& WETAIL, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *FEMEANWS* - COMPUTATION OF MEAN ENERGY, MEAN FREQUENCY + ! FOR WINDSEA PART OF THE SPECTRUM AS DETERMINED + ! BY XLLWS + + !* PURPOSE. + ! -------- + + ! COMPUTE MEAN FREQUENCY AT EACH GRID POINT FOR PART OF THE + ! SPECTRUM WHERE XLLWS IS NON ZERO. + + !** INTERFACE. + ! ---------- + + ! *CALL* *FEMEANWS (KIJS, KIJL, FL1, XLLWS, EM, FM)* + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *XLLWS* - TOTAL WINDSEA MASK FROM INPUT SOURCE TERM + ! *EM* - MEAN WAVE ENERGY (OUTPUT) + ! *FM* - MEAN WAVE FREQUENCY (OUTPUT) + + ! METHOD. + ! ------- + + ! NONE. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! NONE. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FM(:) + REAL(KIND=JWRB), OPTIONAL, TARGET, INTENT(OUT) :: EM(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: K + + REAL(KIND=JWRB) :: DELT25 + REAL(KIND=JWRB) :: DELT2 + REAL(KIND=JWRB) :: TEMP2 + REAL(KIND=JWRB) :: EM_LOC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + !* 1. INITIALISE MEAN FREQUENCY ARRAY AND TAIL FACTOR. + ! ------------------------------------------------ + + + EM_LOC = EPSMIN + FM(IJ) = EPSMIN + + DELT25 = WETAIL*FR(NFRE)*DELTH + DELT2 = FRTAIL*DELTH + + + !* 2. INTEGRATE OVER FREQUENCIES AND DIRECTIONS. + ! ------------------------------------------ + + DO M=1,NFRE + TEMP2 = 0.0_JWRB + DO K=1,NANG + TEMP2 = TEMP2 + XLLWS(IJ, K, M, ICHNK)*FL1(IJ, K, M, ICHNK) + END DO + EM_LOC = EM_LOC + DFIM(M)*TEMP2 + FM(IJ) = FM(IJ) + DFIMOFR(M)*TEMP2 + END DO + + !* 3. ADD TAIL CORRECTION TO MEAN FREQUENCY AND + !* NORMALIZE WITH TOTAL ENERGY. + ! ------------------------------------------ + + EM_LOC = EM_LOC + DELT25*TEMP2 + FM(IJ) = FM(IJ) + DELT2*TEMP2 + FM(IJ) = EM_LOC / FM(IJ) + + IF (PRESENT(EM)) THEN + EM(IJ) = EM_LOC + END IF + + + +END SUBROUTINE FEMEANWS_FC diff --git a/src/phys-scc-cuda/femeanws_c.c b/src/phys-scc-cuda/femeanws_c.c new file mode 100644 index 00000000..9f71ba8e --- /dev/null +++ b/src/phys-scc-cuda/femeanws_c.c @@ -0,0 +1,51 @@ +#include +#include +#include +#include +#include +#include +#include "femeanws_c.h" + +__device__ void femeanws_c(int kijs, int kijl, const double * fl1, const double * xllws, + double * fm, double * em, double delth, const double * dfim, const double * dfimofr, + double epsmin, const double * fr, double frtail, int nang, int nfre, double wetail, + int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int m; + int k; + + double delt25; + double delt2; + double temp2; + double em_loc; + + em_loc = epsmin; + fm[ij - 1] = epsmin; + + delt25 = wetail*fr[nfre - 1]*delth; + delt2 = frtail*delth; + for (m = 1; m <= nfre; m += 1) { + temp2 = (double) 0.0; + for (k = 1; k <= nang; k += 1) { + temp2 = temp2 + xllws[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + em_loc = em_loc + dfim[m - 1]*temp2; + fm[ij - 1] = fm[ij - 1] + dfimofr[m - 1]*temp2; + } + em_loc = em_loc + delt25*temp2; + fm[ij - 1] = fm[ij - 1] + delt2*temp2; + fm[ij - 1] = em_loc / fm[ij - 1]; + + // if (present( (*em))) { + em[ij - 1] = em_loc; + // } + + + +} diff --git a/src/phys-scc-cuda/femeanws_c.h b/src/phys-scc-cuda/femeanws_c.h new file mode 100644 index 00000000..6e6ac3dc --- /dev/null +++ b/src/phys-scc-cuda/femeanws_c.h @@ -0,0 +1,12 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void femeanws_c(int kijs, int kijl, const double * fl1, const double * xllws, + double * fm, double * em, double delth, const double * dfim, const double * dfimofr, + double epsmin, const double * fr, double frtail, int nang, int nfre, double wetail, + int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/femeanws_fc.F90 b/src/phys-scc-cuda/femeanws_fc.F90 new file mode 100644 index 00000000..9707473a --- /dev/null +++ b/src/phys-scc-cuda/femeanws_fc.F90 @@ -0,0 +1,66 @@ +MODULE FEMEANWS_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE FEMEANWS_fc (KIJS, KIJL, FL1, XLLWS, FM, EM, DELTH, DFIM, DFIMOFR, EPSMIN, FR, FRTAIL, NANG, NFRE, WETAIL, ICHNK, & + & NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE FEMEANWS_iso_c (KIJS, KIJL, FL1, XLLWS, FM, EM, DELTH, DFIM, DFIMOFR, EPSMIN, FR, FRTAIL, NANG, NFRE, WETAIL, & + & ICHNK, NCHNK, IJ) BIND(c, name="femeanws_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: XLLWS + TYPE(c_ptr), VALUE :: FM + TYPE(c_ptr), VALUE :: EM + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIMOFR + REAL, VALUE :: EPSMIN + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: FRTAIL + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: WETAIL + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE FEMEANWS_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FM(:) + REAL(KIND=JWRB), OPTIONAL, TARGET, INTENT(OUT) :: EM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) +!$acc host_data use_device( FL1, XLLWS, FM, EM, DFIM, DFIMOFR, FR ) + CALL FEMEANWS_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(XLLWS), c_loc(FM), c_loc(EM), DELTH, c_loc(DFIM), c_loc(DFIMOFR), EPSMIN, & + & c_loc(FR), FRTAIL, NANG, NFRE, WETAIL, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE FEMEANWS_fc +END MODULE FEMEANWS_FC_MOD diff --git a/src/phys-scc-cuda/femeanws_fc.intfb.h b/src/phys-scc-cuda/femeanws_fc.intfb.h new file mode 100644 index 00000000..5182d63b --- /dev/null +++ b/src/phys-scc-cuda/femeanws_fc.intfb.h @@ -0,0 +1,34 @@ +INTERFACE + SUBROUTINE FEMEANWS_FC (KIJS, KIJL, FL1, XLLWS, FM, EM, DELTH, DFIM, DFIMOFR, EPSMIN, FR, FRTAIL, NANG, NFRE, WETAIL, ICHNK, & + & NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FM(:) + REAL(KIND=JWRB), OPTIONAL, TARGET, INTENT(OUT) :: EM(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE FEMEANWS_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/fkmean.c_hoist.F90 b/src/phys-scc-cuda/fkmean.c_hoist.F90 new file mode 100644 index 00000000..04a46bf8 --- /dev/null +++ b/src/phys-scc-cuda/fkmean.c_hoist.F90 @@ -0,0 +1,166 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE FKMEAN_FC (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK, DELTH, DFIM, DFIMFR, DFIMOFR, EPSMIN, FR, & +& FRTAIL, G, NANG, NFRE, WETAIL, WP1TAIL, ZPI, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *FKMEAN* - COMPUTATION OF MEAN FREQUENCIES AT EACH GRID POINT + ! AND MEAN WAVE NUMBER (based in sqrt(k)*F moment) . + ! COMPUTATION OF THE MEAN WAVE ENERGY WAS ALSO + ! ADDED SUCH THAT A CALL TO FKMEAN DOES NOT NEED + + + !* PURPOSE. + ! -------- + + ! COMPUTE MEAN FREQUENCIES AND WAVE NUMBER AT EACH GRID POINT. + + !** INTERFACE. + ! ---------- + + ! *CALL* *FKMEAN (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK)* + ! *KIJS* - LOCAL INDEX OF FIRST GRIDPOINT + ! *KIJL* - LOCAL INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *WAVNUM* - WAVE NUMBER. + ! *EM* - MEAN WAVE ENERGY + ! *FM1* - MEAN WAVE FREQUENCY BASED ON (1/f)*FL1 INTEGRATION + ! *F1* - MEAN WAVE FREQUENCY BASED ON f*FL1 INTEGRATION + ! *AK* - MEAN WAVE NUMBER BASED ON sqrt(1/k)*FL1 INTGRATION + ! ONLY FOR SHALLOW WATER RUNS. + !!! AK IS STILL NEEDED IN SNONLIN !!!! + !!! IF THE OLD FORMULATION IS USED. + ! *XK* - MEAN WAVE NUMBER BASED ON sqrt(k)*FL1 INTEGRATION + ! ONLY FOR SHALLOW WATER RUNS. + + ! METHOD. + ! ------- + + ! NONE. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! NONE. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: EM(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FM1(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: F1(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: AK(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XK(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: K + REAL(KIND=JWRB) :: DELT25 + REAL(KIND=JWRB) :: COEFM1 + REAL(KIND=JWRB) :: COEF1 + REAL(KIND=JWRB) :: COEFA + REAL(KIND=JWRB) :: COEFX + REAL(KIND=JWRB) :: SQRTK + REAL(KIND=JWRB) :: TEMPA + REAL(KIND=JWRB) :: TEMPX + REAL(KIND=JWRB) :: TEMP2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + + !* 1. INITIALISE MEAN FREQUENCY ARRAY AND TAIL FACTOR. + ! ------------------------------------------------ + + + EM(IJ) = EPSMIN + FM1(IJ) = EPSMIN + F1(IJ) = EPSMIN + AK(IJ) = EPSMIN + XK(IJ) = EPSMIN + + DELT25 = WETAIL*FR(NFRE)*DELTH + COEFM1 = FRTAIL*DELTH + COEF1 = WP1TAIL*DELTH*FR(NFRE)**2 + COEFA = COEFM1*SQRT(G) / ZPI + COEFX = COEF1*(ZPI / SQRT(G)) + + !* 2. INTEGRATE OVER FREQUENCIES AND DIRECTIONS. + ! ------------------------------------------ + + !* 2.2 SHALLOW WATER INTEGRATION. + ! -------------------------- + + DO M=1,NFRE + SQRTK = SQRT(WAVNUM(IJ, M, ICHNK)) + TEMPA = DFIM(M) / SQRTK + TEMPX = SQRTK*DFIM(M) + K = 1 + TEMP2 = FL1(IJ, K, M, ICHNK) + DO K=2,NANG + TEMP2 = TEMP2 + FL1(IJ, K, M, ICHNK) + END DO + EM(IJ) = EM(IJ) + DFIM(M)*TEMP2 + FM1(IJ) = FM1(IJ) + DFIMOFR(M)*TEMP2 + F1(IJ) = F1(IJ) + DFIMFR(M)*TEMP2 + AK(IJ) = AK(IJ) + TEMPA*TEMP2 + XK(IJ) = XK(IJ) + TEMPX*TEMP2 + END DO + + !* ADD TAIL CORRECTION TO MEAN FREQUENCY AND + !* NORMALIZE WITH TOTAL ENERGY. + EM(IJ) = EM(IJ) + DELT25*TEMP2 + FM1(IJ) = FM1(IJ) + COEFM1*TEMP2 + FM1(IJ) = EM(IJ) / FM1(IJ) + F1(IJ) = F1(IJ) + COEF1*TEMP2 + F1(IJ) = F1(IJ) / EM(IJ) + AK(IJ) = AK(IJ) + COEFA*TEMP2 + AK(IJ) = (EM(IJ) / AK(IJ))**2 + XK(IJ) = XK(IJ) + COEFX*TEMP2 + XK(IJ) = (XK(IJ) / EM(IJ))**2 + + + +END SUBROUTINE FKMEAN_FC diff --git a/src/phys-scc-cuda/fkmean_c.c b/src/phys-scc-cuda/fkmean_c.c new file mode 100644 index 00000000..01ada4c5 --- /dev/null +++ b/src/phys-scc-cuda/fkmean_c.c @@ -0,0 +1,73 @@ +#include +#include +#include +#include +#include +#include +#include "fkmean_c.h" + +__device__ void fkmean_c(int kijs, int kijl, const double * fl1, const double * wavnum, + double * em, double * fm1, double * f1, double * ak, double * xk, double delth, + const double * dfim, const double * dfimfr, const double * dfimofr, double epsmin, + const double * fr, double frtail, double g, int nang, int nfre, double wetail, + double wp1tail, double zpi, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + + int m; + int k; + double delt25; + double coefm1; + double coef1; + double coefa; + double coefx; + double sqrtk; + double tempa; + double tempx; + double temp2; + + em[ij - 1] = epsmin; + fm1[ij - 1] = epsmin; + f1[ij - 1] = epsmin; + ak[ij - 1] = epsmin; + xk[ij - 1] = epsmin; + + delt25 = wetail*fr[nfre - 1]*delth; + coefm1 = frtail*delth; + coef1 = wp1tail*delth*(pow(fr[nfre - 1], 2)); + coefa = coefm1*sqrt((double) (g)) / zpi; + coefx = coef1*(zpi / sqrt((double) (g))); + for (m = 1; m <= nfre; m += 1) { + sqrtk = sqrt((double) (wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))])); + tempa = dfim[m - 1] / sqrtk; + tempx = sqrtk*dfim[m - 1]; + k = 1; + temp2 = + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + for (k = 2; k <= nang; k += 1) { + temp2 = temp2 + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + em[ij - 1] = em[ij - 1] + dfim[m - 1]*temp2; + fm1[ij - 1] = fm1[ij - 1] + dfimofr[m - 1]*temp2; + f1[ij - 1] = f1[ij - 1] + dfimfr[m - 1]*temp2; + ak[ij - 1] = ak[ij - 1] + tempa*temp2; + xk[ij - 1] = xk[ij - 1] + tempx*temp2; + } + em[ij - 1] = em[ij - 1] + delt25*temp2; + fm1[ij - 1] = fm1[ij - 1] + coefm1*temp2; + fm1[ij - 1] = em[ij - 1] / fm1[ij - 1]; + f1[ij - 1] = f1[ij - 1] + coef1*temp2; + f1[ij - 1] = f1[ij - 1] / em[ij - 1]; + ak[ij - 1] = ak[ij - 1] + coefa*temp2; + ak[ij - 1] = pow((em[ij - 1] / ak[ij - 1]), 2); + xk[ij - 1] = xk[ij - 1] + coefx*temp2; + xk[ij - 1] = pow((xk[ij - 1] / em[ij - 1]), 2); + + + +} diff --git a/src/phys-scc-cuda/fkmean_c.h b/src/phys-scc-cuda/fkmean_c.h new file mode 100644 index 00000000..0db34183 --- /dev/null +++ b/src/phys-scc-cuda/fkmean_c.h @@ -0,0 +1,13 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void fkmean_c(int kijs, int kijl, const double * fl1, const double * wavnum, + double * em, double * fm1, double * f1, double * ak, double * xk, double delth, + const double * dfim, const double * dfimfr, const double * dfimofr, double epsmin, + const double * fr, double frtail, double g, int nang, int nfre, double wetail, + double wp1tail, double zpi, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/fkmean_fc.F90 b/src/phys-scc-cuda/fkmean_fc.F90 new file mode 100644 index 00000000..2f4dca2a --- /dev/null +++ b/src/phys-scc-cuda/fkmean_fc.F90 @@ -0,0 +1,81 @@ +MODULE FKMEAN_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE FKMEAN_fc (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK, DELTH, DFIM, DFIMFR, DFIMOFR, EPSMIN, FR, FRTAIL, G, NANG, & + & NFRE, WETAIL, WP1TAIL, ZPI, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE FKMEAN_iso_c (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK, DELTH, DFIM, DFIMFR, DFIMOFR, EPSMIN, FR, FRTAIL, & + & G, NANG, NFRE, WETAIL, WP1TAIL, ZPI, ICHNK, NCHNK, IJ) BIND(c, name="fkmean_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: EM + TYPE(c_ptr), VALUE :: FM1 + TYPE(c_ptr), VALUE :: F1 + TYPE(c_ptr), VALUE :: AK + TYPE(c_ptr), VALUE :: XK + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIMFR + TYPE(c_ptr), VALUE :: DFIMOFR + REAL, VALUE :: EPSMIN + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: FRTAIL + REAL, VALUE :: G + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: WETAIL + REAL, VALUE :: WP1TAIL + REAL, VALUE :: ZPI + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE FKMEAN_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: EM(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FM1(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: F1(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: AK(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XK(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) +!$acc host_data use_device( FL1, WAVNUM, EM, FM1, F1, AK, XK, DFIM, DFIMFR, DFIMOFR, FR ) + CALL FKMEAN_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(WAVNUM), c_loc(EM), c_loc(FM1), c_loc(F1), c_loc(AK), c_loc(XK), DELTH, & + & c_loc(DFIM), c_loc(DFIMFR), c_loc(DFIMOFR), EPSMIN, c_loc(FR), FRTAIL, G, NANG, NFRE, WETAIL, WP1TAIL, ZPI, ICHNK, NCHNK, & + & IJ) +!$acc end host_data + END SUBROUTINE FKMEAN_fc +END MODULE FKMEAN_FC_MOD diff --git a/src/phys-scc-cuda/fkmean_fc.intfb.h b/src/phys-scc-cuda/fkmean_fc.intfb.h new file mode 100644 index 00000000..9ca9136f --- /dev/null +++ b/src/phys-scc-cuda/fkmean_fc.intfb.h @@ -0,0 +1,41 @@ +INTERFACE + SUBROUTINE FKMEAN_FC (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK, DELTH, DFIM, DFIMFR, DFIMOFR, EPSMIN, FR, FRTAIL, G, NANG, & + & NFRE, WETAIL, WP1TAIL, ZPI, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: EM(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FM1(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: F1(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: AK(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XK(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE FKMEAN_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/frcutindex.c_hoist.F90 b/src/phys-scc-cuda/frcutindex.c_hoist.F90 new file mode 100644 index 00000000..379ac5f3 --- /dev/null +++ b/src/phys-scc-cuda/frcutindex.c_hoist.F90 @@ -0,0 +1,122 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE FRCUTINDEX_FC (KIJS, KIJL, FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH, CITHRSH_TAIL, EPSMIN, & +& FLOGSPRDM1, FR, FRIC, G, NFRE, RHOWG_DFIM, TAILFACTOR, TAILFACTOR_PM, ZPIFR, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *FRCUTINDEX* - RETURNS THE LAST FREQUENCY INDEX OF + ! PROGNOSTIC PART OF SPECTRUM. + + !** INTERFACE. + ! ---------- + + ! *CALL* *FRCUTINDEX (KIJS, KIJL, FM, FMWS, CICOVER, MIJ, RHOWGDFTH) + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FM* - MEAN FREQUENCY + ! *FMWS* - MEAN FREQUENCY OF WINDSEA + ! *UFRIC* - FRICTION VELOCITY IN M/S + ! *CICOVER*- CICOVER + ! *MIJ* - LAST FREQUENCY INDEX for imposing high frequency tail + ! *RHOWGDFTH - WATER DENSITY * G * DF * DTHETA + ! FOR TRAPEZOIDAL INTEGRATION BETWEEN FR(1) and FR(MIJ) + ! !!!!!!!! RHOWGDFTH=0 FOR FR > FR(MIJ) + + + ! METHOD. + ! ------- + + !* COMPUTES LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM. + !* FREQUENCIES LE 2.5*MAX(FMWS,FM). + + + !!! be aware that if this is NOT used, for iphys=1, the cumulative dissipation has to be + !!! re-activated (see module yowphys) !!! + + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: DELTH, DFIM, FRATIO + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FMWS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: RHOWGDFTH(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + + REAL(KIND=JWRB) :: FPMH + REAL(KIND=JWRB) :: FPPM + REAL(KIND=JWRB) :: FM2 + REAL(KIND=JWRB) :: FPM + REAL(KIND=JWRB) :: FPM4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + !* COMPUTE LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM. + !* FREQUENCIES LE MAX(TAILFACTOR*MAX(FMNWS,FM),TAILFACTOR_PM*FPM), + !* WHERE FPM IS THE PIERSON-MOSKOWITZ FREQUENCY BASED ON FRICTION + !* VELOCITY. (FPM=G/(FRIC*ZPI*USTAR)) + ! ------------------------------------------------------------ + + FPMH = TAILFACTOR / FR(1) + FPPM = TAILFACTOR_PM*G / (FRIC*ZPIFR(1)) + + + IF (CICOVER(IJ, ICHNK) <= CITHRSH_TAIL) THEN + FM2 = MAX(FMWS(IJ), FM(IJ))*FPMH + FPM = FPPM / MAX(UFRIC(IJ, ICHNK), EPSMIN) + FPM4 = MAX(FM2, FPM) + MIJ(IJ, ICHNK) = NINT(LOG10(FPM4)*FLOGSPRDM1) + 1 + MIJ(IJ, ICHNK) = MIN(MAX(1, MIJ(IJ, ICHNK)), NFRE) + ELSE + MIJ(IJ, ICHNK) = NFRE + END IF + + ! SET RHOWGDFTH + DO M=1,MIJ(IJ, ICHNK) + RHOWGDFTH(IJ, M) = RHOWG_DFIM(M) + END DO + IF (MIJ(IJ, ICHNK) /= NFRE) RHOWGDFTH(IJ, MIJ(IJ, ICHNK)) = 0.5_JWRB*RHOWGDFTH(IJ, MIJ(IJ, ICHNK)) + DO M=MIJ(IJ, ICHNK) + 1,NFRE + RHOWGDFTH(IJ, M) = 0.0_JWRB + END DO + + + +END SUBROUTINE FRCUTINDEX_FC diff --git a/src/phys-scc-cuda/frcutindex_c.c b/src/phys-scc-cuda/frcutindex_c.c new file mode 100644 index 00000000..cb89de94 --- /dev/null +++ b/src/phys-scc-cuda/frcutindex_c.c @@ -0,0 +1,53 @@ +#include +#include +#include +#include +#include +#include +#include "frcutindex_c.h" + +__device__ void frcutindex_c(int kijs, int kijl, const double * fm, const double * fmws, + const double * ufric, const double * cicover, int * mij, double * rhowgdfth, + double cithrsh_tail, double epsmin, double flogsprdm1, const double * fr, double fric, + double g, int nfre, const double * rhowg_dfim, double tailfactor, + double tailfactor_pm, const double * zpifr, int ichnk, int nchnk, int ij) { + + + + const int nfre_loki_param = 36; + int m; + + double fpmh; + double fppm; + double fm2; + double fpm; + double fpm4; + fpmh = tailfactor / fr[1 - 1]; + fppm = tailfactor_pm*g / (fric*zpifr[1 - 1]); + + + if (cicover[ij - 1 + kijl*(ichnk - 1)] <= cithrsh_tail) { + fm2 = max((double) (fmws[ij - 1]), (double) (fm[ij - 1]))*fpmh; + fpm = fppm / max((double) (ufric[ij - 1 + kijl*(ichnk - 1)]), (double) (epsmin)); + fpm4 = max((double) (fm2), (double) (fpm)); + // mij[ij - 1 + kijl*(ichnk - 1)] = nint(log10(fpm4)*flogsprdm1) + 1; + mij[ij - 1 + kijl*(ichnk - 1)] = rint(log10(fpm4)*flogsprdm1) + 1; + mij[ij - 1 + kijl*(ichnk - 1)] = min((double) (max((double) (1), (double) (mij[ij - 1 + + kijl*(ichnk - 1)]))), (double) (nfre)); + } else { + mij[ij - 1 + kijl*(ichnk - 1)] = nfre; + } + for (m = 1; m <= mij[ij - 1 + kijl*(ichnk - 1)]; m += 1) { + rhowgdfth[ij - 1 + kijl*(m - 1)] = rhowg_dfim[m - 1]; + } + if (mij[ij - 1 + kijl*(ichnk - 1)] != nfre) { + rhowgdfth[ij - 1 + kijl*(mij[ij - 1 + kijl*(ichnk - 1)] - 1)] = + (double) 0.5*rhowgdfth[ij - 1 + kijl*(mij[ij - 1 + kijl*(ichnk - 1)] - 1)]; + } + for (m = mij[ij - 1 + kijl*(ichnk - 1)] + 1; m <= nfre; m += 1) { + rhowgdfth[ij - 1 + kijl*(m - 1)] = (double) 0.0; + } + + + +} diff --git a/src/phys-scc-cuda/frcutindex_c.h b/src/phys-scc-cuda/frcutindex_c.h new file mode 100644 index 00000000..08bd2233 --- /dev/null +++ b/src/phys-scc-cuda/frcutindex_c.h @@ -0,0 +1,13 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void frcutindex_c(int kijs, int kijl, const double * fm, const double * fmws, + const double * ufric, const double * cicover, int * mij, double * rhowgdfth, + double cithrsh_tail, double epsmin, double flogsprdm1, const double * fr, double fric, + double g, int nfre, const double * rhowg_dfim, double tailfactor, + double tailfactor_pm, const double * zpifr, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/frcutindex_fc.F90 b/src/phys-scc-cuda/frcutindex_fc.F90 new file mode 100644 index 00000000..3a2ee808 --- /dev/null +++ b/src/phys-scc-cuda/frcutindex_fc.F90 @@ -0,0 +1,75 @@ +MODULE FRCUTINDEX_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE FRCUTINDEX_fc (KIJS, KIJL, FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH, CITHRSH_TAIL, EPSMIN, FLOGSPRDM1, FR, FRIC, G, & + & NFRE, RHOWG_DFIM, TAILFACTOR, TAILFACTOR_PM, ZPIFR, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE FRCUTINDEX_iso_c (KIJS, KIJL, FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH, CITHRSH_TAIL, EPSMIN, FLOGSPRDM1, FR, & + & FRIC, G, NFRE, RHOWG_DFIM, TAILFACTOR, TAILFACTOR_PM, ZPIFR, ICHNK, NCHNK, IJ) BIND(c, name="frcutindex_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FM + TYPE(c_ptr), VALUE :: FMWS + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: MIJ + TYPE(c_ptr), VALUE :: RHOWGDFTH + REAL, VALUE :: CITHRSH_TAIL + REAL, VALUE :: EPSMIN + REAL, VALUE :: FLOGSPRDM1 + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: FRIC + REAL, VALUE :: G + INTEGER(KIND=c_int), VALUE :: NFRE + TYPE(c_ptr), VALUE :: RHOWG_DFIM + REAL, VALUE :: TAILFACTOR + REAL, VALUE :: TAILFACTOR_PM + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE FRCUTINDEX_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FMWS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) +!$acc host_data use_device( FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH, FR, RHOWG_DFIM, ZPIFR ) + CALL FRCUTINDEX_iso_c(KIJS, KIJL, c_loc(FM), c_loc(FMWS), c_loc(UFRIC), c_loc(CICOVER), c_loc(MIJ), c_loc(RHOWGDFTH), & + & CITHRSH_TAIL, EPSMIN, FLOGSPRDM1, c_loc(FR), FRIC, G, NFRE, c_loc(RHOWG_DFIM), TAILFACTOR, TAILFACTOR_PM, c_loc(ZPIFR), & + & ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE FRCUTINDEX_fc +END MODULE FRCUTINDEX_FC_MOD diff --git a/src/phys-scc-cuda/frcutindex_fc.intfb.h b/src/phys-scc-cuda/frcutindex_fc.intfb.h new file mode 100644 index 00000000..71d5d41b --- /dev/null +++ b/src/phys-scc-cuda/frcutindex_fc.intfb.h @@ -0,0 +1,39 @@ +INTERFACE + SUBROUTINE FRCUTINDEX_FC (KIJS, KIJL, FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH, CITHRSH_TAIL, EPSMIN, FLOGSPRDM1, FR, FRIC, G, & + & NFRE, RHOWG_DFIM, TAILFACTOR, TAILFACTOR_PM, ZPIFR, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: DELTH, DFIM, FRATIO + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FMWS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: RHOWGDFTH(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE FRCUTINDEX_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/halphap.c_hoist.F90 b/src/phys-scc-cuda/halphap.c_hoist.F90 new file mode 100644 index 00000000..49699f33 --- /dev/null +++ b/src/phys-scc-cuda/halphap.c_hoist.F90 @@ -0,0 +1,150 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE HALPHAP_FC (KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP, ALPHAPMAX, DELTH, DFIM, DFIMOFR, EPSMIN, FR, & +& FR5, FRTAIL, NANG, NFRE, WETAIL, ZPI4GM2, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *HALPHAP* - COMPUTATION OF 1/2 PHILLIPS PARAMETER + + + !** INTERFACE. + ! ---------- + + ! *CALL* *HALPHAP(KIJS, KIJL, WAVNUM, UDIR, FL1, HALP) + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *WAVNUM* - WAVE NUMBER + ! *COSWDIF*- COSINE ( WIND SPEED DIRECTION - WAVE DIRECTIONS) + ! *FL1* - SPECTRA + ! *HALP* - 1/2 PHILLIPS PARAMETER + + ! METHOD. + ! ------- + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: TH + USE YOWPARAM, ONLY: NANG_PARAM + USE YOWPCONS, ONLY: G, ZPI + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: HALP(:) + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + + REAL(KIND=JWRB) :: ZLNFRNFRE + REAL(KIND=JWRB) :: DELT25 + REAL(KIND=JWRB) :: DELT2 + REAL(KIND=JWRB) :: DEL2 + REAL(KIND=JWRB) :: TEMP1 + REAL(KIND=JWRB) :: TEMP2 + REAL(KIND=JWRB) :: ALPHAP + REAL(KIND=JWRB) :: XMSS + REAL(KIND=JWRB) :: EM + REAL(KIND=JWRB) :: FM + REAL(KIND=JWRB) :: F1D + REAL(KIND=JWRB) :: FLWD(NANG_PARAM) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + ZLNFRNFRE = LOG(FR(NFRE)) + + DELT25 = WETAIL*FR(NFRE)*DELTH + DELT2 = FRTAIL*DELTH + + ! Find spectrum in wind direction + + DO M=1,NFRE + DO K=1,NANG + FLWD(K) = FL1(IJ, K, M, ICHNK)*0.5_JWRB + 0.5_JWRB*SIGN(1.0_JWRB, COSWDIF(IJ, K)) + END DO + + XMSS = 0._JWRB + TEMP1 = DFIM(M)*WAVNUM(IJ, M, ICHNK)**2 + TEMP2 = 0.0_JWRB + DO K=1,NANG + TEMP2 = TEMP2 + FLWD(K) + END DO + XMSS = XMSS + TEMP1*TEMP2 + + K = 1 + EM = 0._JWRB + FM = 0._JWRB + TEMP2 = MAX(FLWD(K), EPSMIN) + DO K=2,NANG + TEMP2 = TEMP2 + MAX(FLWD(K), EPSMIN) + END DO + EM = EM + TEMP2*DFIM(M) + FM = FM + DFIMOFR(M)*TEMP2 + END DO + + DO K=1,NANG + FLWD(K) = FL1(IJ, K, NFRE, ICHNK)*0.5_JWRB + 0.5_JWRB*SIGN(1.0_JWRB, COSWDIF(IJ, K)) + END DO + + EM = EM + DELT25*TEMP2 + FM = FM + DELT2*TEMP2 + FM = EM / FM + FM = MAX(FM, FR(1)) + + IF (EM > 0.0_JWRB .and. FM < FR(-2 + NFRE)) THEN + ALPHAP = XMSS / (ZLNFRNFRE - LOG(FM)) + IF (ALPHAP > ALPHAPMAX) THEN + ! some odd cases, revert to tail value + F1D = 0.0_JWRB + DO K=1,NANG + F1D = F1D + FLWD(K)*DELTH + END DO + ALPHAP = ZPI4GM2*FR5(NFRE)*F1D + END IF + ELSE + F1D = 0.0_JWRB + DO K=1,NANG + F1D = F1D + FLWD(K)*DELTH + END DO + ALPHAP = ZPI4GM2*FR5(NFRE)*F1D + END IF + + ! 1/2 ALPHAP: + HALP(IJ) = 0.5_JWRB*MIN(ALPHAP, ALPHAPMAX) + + + +END SUBROUTINE HALPHAP_FC diff --git a/src/phys-scc-cuda/halphap_c.c b/src/phys-scc-cuda/halphap_c.c new file mode 100644 index 00000000..e9daab1c --- /dev/null +++ b/src/phys-scc-cuda/halphap_c.c @@ -0,0 +1,101 @@ +#include +#include +#include +#include +#include +#include +#include "halphap_c.h" + +__device__ void halphap_c(int kijs, int kijl, const double * wavnum, + const double * coswdif, const double * fl1, double * halp, double alphapmax, + double delth, const double * dfim, const double * dfimofr, double epsmin, + const double * fr, const double * fr5, double frtail, int nang, int nfre, + double wetail, double zpi4gm2, int ichnk, int nchnk, int ij) { + + // Loki: parameters from YOWPARAM inlined + + + const int nfre_loki_param = 36; + const int nang_loki_param = 24; + + int k; + int m; + + double zlnfrnfre; + double delt25; + double delt2; + double del2; + double temp1; + double temp2; + double alphap; + double xmss; + double em; + double fm; + double f1d; + double flwd[36]; + + zlnfrnfre = log(fr[nfre - 1]); + + delt25 = wetail*fr[nfre - 1]*delth; + delt2 = frtail*delth; + + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + flwd[k - 1] = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]*(double) 0.5 + (double) 0.5*copysign((double) ((double + ) 1.0), (double) (coswdif[ij - 1 + kijl*(k - 1)])); + } + + xmss = (double) 0.; + temp1 = + dfim[m - 1]*(pow(wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))], 2)); + temp2 = (double) 0.0; + for (k = 1; k <= nang; k += 1) { + temp2 = temp2 + flwd[k - 1]; + } + xmss = xmss + temp1*temp2; + + k = 1; + em = (double) 0.; + fm = (double) 0.; + temp2 = max((double) (flwd[k - 1]), (double) (epsmin)); + for (k = 2; k <= nang; k += 1) { + temp2 = temp2 + max((double) (flwd[k - 1]), (double) (epsmin)); + } + em = em + temp2*dfim[m - 1]; + fm = fm + dfimofr[m - 1]*temp2; + } + + for (k = 1; k <= nang; k += 1) { + flwd[k - 1] = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(nfre - 1 + + nfre_loki_param*(ichnk - 1)))]*(double) 0.5 + (double) 0.5*copysign((double) ((double) + 1.0), (double) (coswdif[ij - 1 + kijl*(k - 1)])); + } + + em = em + delt25*temp2; + fm = fm + delt2*temp2; + fm = em / fm; + fm = max((double) (fm), (double) (fr[1 - 1])); + + if (em > (double) 0.0 && fm < fr[-2 + nfre - 1]) { + alphap = xmss / (zlnfrnfre - log(fm)); + if (alphap > alphapmax) { + // some odd cases, revert to tail value + f1d = (double) 0.0; + for (k = 1; k <= nang; k += 1) { + f1d = f1d + flwd[k - 1]*delth; + } + alphap = zpi4gm2*fr5[nfre - 1]*f1d; + } + } else { + f1d = (double) 0.0; + for (k = 1; k <= nang; k += 1) { + f1d = f1d + flwd[k - 1]*delth; + } + alphap = zpi4gm2*fr5[nfre - 1]*f1d; + } + halp[ij - 1] = (double) 0.5*min((double) (alphap), (double) (alphapmax)); + + + +} diff --git a/src/phys-scc-cuda/halphap_c.h b/src/phys-scc-cuda/halphap_c.h new file mode 100644 index 00000000..be7596e8 --- /dev/null +++ b/src/phys-scc-cuda/halphap_c.h @@ -0,0 +1,13 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void halphap_c(int kijs, int kijl, const double * wavnum, + const double * coswdif, const double * fl1, double * halp, double alphapmax, + double delth, const double * dfim, const double * dfimofr, double epsmin, + const double * fr, const double * fr5, double frtail, int nang, int nfre, + double wetail, double zpi4gm2, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/halphap_fc.F90 b/src/phys-scc-cuda/halphap_fc.F90 new file mode 100644 index 00000000..142b1e3a --- /dev/null +++ b/src/phys-scc-cuda/halphap_fc.F90 @@ -0,0 +1,71 @@ +MODULE HALPHAP_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE HALPHAP_fc (KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP, ALPHAPMAX, DELTH, DFIM, DFIMOFR, EPSMIN, FR, FR5, FRTAIL, NANG, & + & NFRE, WETAIL, ZPI4GM2, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE HALPHAP_iso_c (KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP, ALPHAPMAX, DELTH, DFIM, DFIMOFR, EPSMIN, FR, FR5, & + & FRTAIL, NANG, NFRE, WETAIL, ZPI4GM2, ICHNK, NCHNK, IJ) BIND(c, name="halphap_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: HALP + REAL, VALUE :: ALPHAPMAX + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIMOFR + REAL, VALUE :: EPSMIN + TYPE(c_ptr), VALUE :: FR + TYPE(c_ptr), VALUE :: FR5 + REAL, VALUE :: FRTAIL + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: WETAIL + REAL, VALUE :: ZPI4GM2 + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE HALPHAP_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) +!$acc host_data use_device( WAVNUM, COSWDIF, FL1, HALP, DFIM, DFIMOFR, FR, FR5 ) + CALL HALPHAP_iso_c(KIJS, KIJL, c_loc(WAVNUM), c_loc(COSWDIF), c_loc(FL1), c_loc(HALP), ALPHAPMAX, DELTH, c_loc(DFIM), & + & c_loc(DFIMOFR), EPSMIN, c_loc(FR), c_loc(FR5), FRTAIL, NANG, NFRE, WETAIL, ZPI4GM2, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE HALPHAP_fc +END MODULE HALPHAP_FC_MOD diff --git a/src/phys-scc-cuda/halphap_fc.intfb.h b/src/phys-scc-cuda/halphap_fc.intfb.h new file mode 100644 index 00000000..b7217d24 --- /dev/null +++ b/src/phys-scc-cuda/halphap_fc.intfb.h @@ -0,0 +1,39 @@ +INTERFACE + SUBROUTINE HALPHAP_FC (KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP, ALPHAPMAX, DELTH, DFIM, DFIMOFR, EPSMIN, FR, FR5, FRTAIL, NANG, & + & NFRE, WETAIL, ZPI4GM2, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: TH + USE YOWPARAM, ONLY: NANG_PARAM + USE YOWPCONS, ONLY: G, ZPI + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: HALP(:) + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE HALPHAP_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/imphftail.c_hoist.F90 b/src/phys-scc-cuda/imphftail.c_hoist.F90 new file mode 100644 index 00000000..ce2fc465 --- /dev/null +++ b/src/phys-scc-cuda/imphftail.c_hoist.F90 @@ -0,0 +1,99 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE IMPHFTAIL_FC (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1, NANG, NFRE, ICHNK, NCHNK, IJ) + ! ---------------------------------------------------------------------- + + !**** *IMPHFTAIL* - IMPOSE A HIGH FREQUENCY TAIL TO THE SPECTRUM + + + !* PURPOSE. + ! -------- + + ! IMPOSE A HIGH FREQUENCY TAIL TO THE SPECTRUM ABOVE FREQUENCY INDEX MIJ + + + !** INTERFACE. + ! ---------- + + ! *CALL* *IMPHFTAIL (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1) + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *MIJ* - LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE. + ! *FLM* - SPECTAL DENSITY MINIMUM VALUE + ! *WAVNUM* - WAVENUMBER + ! *XK2CG* - (WAVNUM)**2 * GROUP SPEED + ! *FL1* - SPECTRUM (INPUT AND OUTPUT). + + ! METHOD. + ! ------- + + ! EXTERNALS. + ! --------- + + ! REFERENCE. + ! ---------- + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + + REAL(KIND=JWRB) :: AKM1 + REAL(KIND=JWRB) :: TFAC + REAL(KIND=JWRB) :: TEMP1 + REAL(KIND=JWRB) :: TEMP2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + !* DIAGNOSTIC TAIL. + ! ---------------- + + + TEMP1 = 1.0_JWRB / XK2CG(IJ, MIJ(IJ, ICHNK), ICHNK) / WAVNUM(IJ, MIJ(IJ, ICHNK), ICHNK) + + DO M=MIJ(IJ, ICHNK) + 1,NFRE + TEMP2 = 1.0_JWRB / XK2CG(IJ, M, ICHNK) / WAVNUM(IJ, M, ICHNK) + TEMP2 = TEMP2 / TEMP1 + + !* MERGE TAIL INTO SPECTRA. + ! ------------------------ + DO K=1,NANG + TFAC = FL1(IJ, K, MIJ(IJ, ICHNK), ICHNK) + FL1(IJ, K, M, ICHNK) = MAX(TEMP2*TFAC, FLM(IJ, K)) + END DO + END DO + + + ! ---------------------------------------------------------------------- + + +END SUBROUTINE IMPHFTAIL_FC diff --git a/src/phys-scc-cuda/imphftail_c.c b/src/phys-scc-cuda/imphftail_c.c new file mode 100644 index 00000000..86296cfd --- /dev/null +++ b/src/phys-scc-cuda/imphftail_c.c @@ -0,0 +1,41 @@ +#include +#include +#include +#include +#include +#include +#include "imphftail_c.h" + +__device__ void imphftail_c(int kijs, int kijl, const int * mij, const double * flm, + const double * wavnum, const double * xk2cg, double * fl1, int nang, int nfre, + int ichnk, int nchnk, int ij) { + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int k; + int m; + + double akm1; + double tfac; + double temp1; + double temp2; + + temp1 = (double) 1.0 / xk2cg[ij - 1 + kijl*(mij[ij - 1 + kijl*(ichnk - 1)] - 1 + + nfre_loki_param*(ichnk - 1))] / wavnum[ij - 1 + kijl*(mij[ij - 1 + kijl*(ichnk - 1)] + - 1 + nfre_loki_param*(ichnk - 1))]; + + for (m = mij[ij - 1 + kijl*(ichnk - 1)] + 1; m <= nfre; m += 1) { + temp2 = (double) 1.0 / xk2cg[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))] / + wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]; + temp2 = temp2 / temp1; + for (k = 1; k <= nang; k += 1) { + tfac = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(mij[ij - 1 + kijl*(ichnk - 1)] - + 1 + nfre_loki_param*(ichnk - 1)))]; + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))] + = max((double) (temp2*tfac), (double) (flm[ij - 1 + kijl*(k - 1)])); + } + } + + +} diff --git a/src/phys-scc-cuda/imphftail_c.h b/src/phys-scc-cuda/imphftail_c.h new file mode 100644 index 00000000..0632e1ed --- /dev/null +++ b/src/phys-scc-cuda/imphftail_c.h @@ -0,0 +1,11 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void imphftail_c(int kijs, int kijl, const int * mij, const double * flm, + const double * wavnum, const double * xk2cg, double * fl1, int nang, int nfre, + int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/imphftail_fc.F90 b/src/phys-scc-cuda/imphftail_fc.F90 new file mode 100644 index 00000000..5d1d70bf --- /dev/null +++ b/src/phys-scc-cuda/imphftail_fc.F90 @@ -0,0 +1,52 @@ +MODULE IMPHFTAIL_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE IMPHFTAIL_fc (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1, NANG, NFRE, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE IMPHFTAIL_iso_c (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1, NANG, NFRE, ICHNK, NCHNK, IJ) & + & BIND(c, name="imphftail_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: MIJ + TYPE(c_ptr), VALUE :: FLM + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: FL1 + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE IMPHFTAIL_iso_c + END INTERFACE + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) +!$acc host_data use_device( MIJ, FLM, WAVNUM, XK2CG, FL1 ) + CALL IMPHFTAIL_iso_c(KIJS, KIJL, c_loc(MIJ), c_loc(FLM), c_loc(WAVNUM), c_loc(XK2CG), c_loc(FL1), NANG, NFRE, ICHNK, NCHNK, & + & IJ) +!$acc end host_data + END SUBROUTINE IMPHFTAIL_fc +END MODULE IMPHFTAIL_FC_MOD diff --git a/src/phys-scc-cuda/imphftail_fc.intfb.h b/src/phys-scc-cuda/imphftail_fc.intfb.h new file mode 100644 index 00000000..7231f92c --- /dev/null +++ b/src/phys-scc-cuda/imphftail_fc.intfb.h @@ -0,0 +1,26 @@ +INTERFACE + SUBROUTINE IMPHFTAIL_FC (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1, NANG, NFRE, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE IMPHFTAIL_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/implsch.c_hoist.F90 b/src/phys-scc-cuda/implsch.c_hoist.F90 new file mode 100644 index 00000000..990821ba --- /dev/null +++ b/src/phys-scc-cuda/implsch.c_hoist.F90 @@ -0,0 +1,833 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(GLOBAL) SUBROUTINE IMPLSCH_FC (KIJS, KIJL, FL1, WAVNUM, CGROUP, CIWA, CINV, XK2CG, STOKFAC, EMAXDPT, INDEP, DEPTH, & +& IOBND, IODP, AIRD, WDWAVE, CICOVER, WSWAVE, WSTAR, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, CITHICK, NEMOUSTOKES, NEMOVSTOKES, & +& NEMOSTRN, NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, WSEMEAN, WSFMEAN, USTOKES, VSTOKES, STRNMS, & +& TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, MIJ, XLLWS, ABMAX, ABMIN, ACD, ACDLIN, AF11, AFCRV, ALPHA, & +& ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BATHYMAX, BCD, BCDLIN, BETAMAXOXKAPPA2, BFCRV, BMAXOKAP, & +& C2OSQRTVG_GC, CDICWA, CDIS, CDISVIS, CDMAX, CHNKMIN_U, CIBLOCK, CITHRSH, CITHRSH_TAIL, CM_GC, COFRM4, COSTH, CUMULW, DAL1, & +& DAL2, DELKCC_GC_NS, DELKCC_OMXKM3_GC, DELTA_SDIS, DELTH, DFIM, DFIMFR, DFIMFR2, DFIMOFR, DFIM_SIM, DKMAX, DTHRN_A, DTHRN_U, & +& EGRCRV, EPS1, EPSMIN, EPSU10, EPSUS, FKLAM, FKLAM1, FKLAP, FKLAP1, FLMAX, FLMIN, FLOGSPRDM1, FR, FR5, FRATIO, FRIC, FRTAIL, G, & +& GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IDELT, IKM, IKM1, IKP, IKP1, INDICESSAT, INLCOEF, IPHYS, IPSAT, ISNONLIN, & +& JTOT_TAUHF, K11W, K1W, K21W, K2W, KFRH, LBIWBK, LCIWABR, LICERUN, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LLUNSTR, LMASKICE, & +& LWAMRSETCI, LWCOU, LWFLUX, LWFLUXOUT, LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, LWNEMOTAUOC, LWVFLX_SNL, MFRSTLW, & +& MICHE, MLSTHG, NANG, NDEPTH, NDIKCUMUL, NFRE, NFRE_ODD, NFRE_RED, NSDSNTH, NWAV_GC, OM3GMKM_GC, OMEGA_GC, OMXKM3_GC, & +& PHIEPSMAX, PHIEPSMIN, RHOWG_DFIM, RN1_RN, RNLCOEF, RNU, RNUM, ROWATER, ROWATERM1, SATWEIGHTS, SDSBR, SINTH, SQRTGOSURFT, & +& SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, & +& TAILFACTOR, TAILFACTOR_PM, TAUOCMAX, TAUOCMIN, TAUWSHELTER, TH, WETAIL, WP1TAIL, WP2TAIL, WSEMEAN_MIN, WSPMIN, WTAUHF, & +& X0TAUHF, XKAPPA, XKDMIN, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, & +& ZPIFR, ICHNK_start, ICHNK_end, ICHNK_step, NCHNK, NPROMA_WAM, RAORW, EMEAN, FMEAN, HALP, EMEANWS, FMEANWS, F1MEAN, AKMEAN, & +& XKMEAN, PHIWA, FLM, COSWDIF, SINWDIF2, RHOWGDFTH, FLD, SL, SPOS, CIREDUC, SSOURCE, SINFLX_RNFAC, SINFLX_TMP_EM, & +& STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST, SNONLIN_ENH, SNONLIN_XNU, & +& SNONLIN_SIG_TH) + + ! ---------------------------------------------------------------------- + + !**** *IMPLSCH* - IMPLICIT SCHEME FOR TIME INTEGRATION OF SOURCE + !**** FUNCTIONS. + + + !* PURPOSE. + ! -------- + + ! THE IMPLICIT SCHEME ENABLES THE USE OF A TIMESTEP WHICH IS + ! LARGE COMPARED WITH THE CHARACTERISTIC DYNAMIC TIME SCALE. + ! THE SCHEME IS REQUIRED FOR THE HIGH FREQUENCIES WHICH + ! RAPIDLY ADJUST TO A QUASI-EQUILIBRIUM. + + !** INTERFACE. + ! ---------- + + ! *CALL* *IMPLSCH (KIJS, KIJL, FL1, + ! & WVPRPT, + ! & WVENVI, FF_NOW, + ! & INTFLDS, WAM2NEMO, + ! & MIJ, XLLWS) + ! *KIJS* - LOCAL INDEX OF FIRST GRIDPOINT + ! *KIJL* - LOCAL INDEX OF LAST GRIDPOINT + ! *FL1* - FREQUENCY SPECTRUM(INPUT AND OUTPUT). + ! *WVPRPT* - WAVE PROPERTIES FIELDS + ! *WVENVI* - WAVE ENVIRONMENT + ! *FF_NOW* FORCING FIELDS + ! *INTFLDS* INTEGRATED/DERIVED PARAMETERS + ! *WAM2NEMO* WAVE FIELDS PASSED TO NEMO + ! *MIJ* LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE. + ! *XLLWS* TOTAL WINDSEA MASK FROM INPUT SOURCE TERM + + + ! METHOD. + ! ------- + + ! THE SPECTRUM AT TIME (TN+1) IS COMPUTED AS + ! FN+1=FN+DELT*(SN+SN+1)/2., WHERE SN IS THE TOTAL SOURCE + ! FUNCTION AT TIME TN, SN+1=SN+(DS/DF)*DF - ONLY THE DIAGONAL + ! TERMS OF THE FUNCTIONAL MATRIX DS/DF ARE YOWPUTED, THE + ! NONDIAGONAL TERMS ARE NEGLIGIBLE. + ! THE ROUTINE IS CALLED AFTER PROPAGATION FOR TIME PERIOD + ! BETWEEN TWO PROPAGATION CALLS - ARRAY FL1 CONTAINS THE + ! SPECTRUM AND FL IS USED AS AN INTERMEDIATE STORAGE FOR THE + ! DIAGONAL TERM OF THE FUNCTIONAL MATRIX. + + + ! REFERENCE. + ! ---------- + + ! S. HASSELMANN AND K. HASSELMANN, "A GLOBAL WAVE MODEL", + ! 30/6/85 (UNPUBLISHED NOTE) + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRO, JWRB + USE YOWDRVTYPE, ONLY: WAVE2OCEAN, ENVIRONMENT, FREQUENCY, FORCING_FIELDS, INTGT_PARAM_FIELDS + + + + IMPLICIT NONE + INTERFACE + SUBROUTINE CIWABR_FC (KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIWAB) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, CGROUP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: CIWAB + END SUBROUTINE CIWABR_FC + END INTERFACE + INTERFACE + SUBROUTINE FEMEANWS_FC (KIJS, KIJL, FL1, XLLWS, FM, EM) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, XLLWS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FM + REAL(KIND=JWRB), OPTIONAL, INTENT(OUT), DIMENSION(KIJL) :: EM + END SUBROUTINE FEMEANWS_FC + END INTERFACE + INTERFACE + SUBROUTINE FKMEAN_FC (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: EM, FM1, F1, AK, XK + END SUBROUTINE FKMEAN_FC + END INTERFACE + INTERFACE + SUBROUTINE SBOTTOM_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + END SUBROUTINE SBOTTOM_FC + END INTERFACE + INTERFACE + SUBROUTINE IMPHFTAIL_FC (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: MIJ + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: FLM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + END SUBROUTINE IMPHFTAIL_FC + END INTERFACE + INTERFACE + SUBROUTINE SDEPTHLIM_FC (KIJS, KIJL, EMAXDPT, FL1) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMAXDPT + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + END SUBROUTINE SDEPTHLIM_FC + END INTERFACE + INTERFACE + SUBROUTINE SDISSIP_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, RAORW) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: INDEP + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMEAN, F1MEAN, XKMEAN + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SDISSIP_FC + END INTERFACE + INTERFACE + SUBROUTINE SDIWBK_FC (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH, EMAXDPT, EMEAN, F1MEAN + END SUBROUTINE SDIWBK_FC + END INTERFACE + INTERFACE + SUBROUTINE SETICE_FC (KIJS, KIJL, FL1, CICOVER, COSWDIF) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SETICE_FC + END INTERFACE + INTERFACE + SUBROUTINE SINFLX_FC (ICALL, KIJS, KIJL, LUPDTUS, FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, WSTAR, CICOVER, & + & COSWDIF, SINWDIF2, FMEAN, HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, MIJ, & + & RHOWGDFTH, XLLWS) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: ICALL + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + LOGICAL, INTENT(IN) :: LUPDTUS + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: XK2CG + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: WSWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: AIRD + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSTAR + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: SINWDIF2 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: FMEAN + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: HALP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FMEANWS + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: FLM + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: UFRIC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUW + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUWDIR + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: Z0M + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: Z0B + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: CHRNCK + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: PHIWA + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: FLD + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: SL + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: SPOS + INTEGER(KIND=JWIM), INTENT(OUT) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: XLLWS + END SUBROUTINE SINFLX_FC + END INTERFACE + INTERFACE + SUBROUTINE SNONLIN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH, AKMEAN + END SUBROUTINE SNONLIN_FC + END INTERFACE + INTERFACE + SUBROUTINE STOKESTRN_FC (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, VSTOKES, & + & STRNMS, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN) + USE parkind_wave, ONLY: jwim, jwrb, jwro + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, STOKFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSWAVE, WDWAVE, CICOVER, CITHICK + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: USTOKES, VSTOKES, STRNMS + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN + END SUBROUTINE STOKESTRN_FC + END INTERFACE + INTERFACE + SUBROUTINE WNFLUXES_FC (KIJS, KIJL, MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, UFRIC, AIRD, & + & NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, & + & PHIEPS, PHIAW, LNUPD) + USE parkind_wave, ONLY: jwim, jwrb, jwro + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: MIJ + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: SSURF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: PHIWA + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EM, F1, WSWAVE, WDWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, AIRD + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: PHIOCD, PHIEPS, PHIAW + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOTAUY, NEMOWSWAVE, NEMOPHIF + LOGICAL, INTENT(IN) :: LNUPD + END SUBROUTINE WNFLUXES_FC + END INTERFACE + ! ---------------------------------------------------------------------- + + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), PARAMETER :: NRNL = 25 + INTEGER(KIND=JWIM), PARAMETER :: NINL = 5 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CGROUP(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CIWA(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IODP(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IOBND(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CHRNCK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSEMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSFMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: VSTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRNMS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIOCD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIEPS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIAW(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOUSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOVSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOSTRN(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NPHIEPS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NTAUOC(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NSWH(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NMWP(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUX(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUY(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOWSWAVE(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOPHIF(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + + + INTEGER(KIND=JWIM) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + + REAL(KIND=JWRB) :: DELT + REAL(KIND=JWRB) :: DELTM + REAL(KIND=JWRB) :: XIMP + REAL(KIND=JWRB) :: DELT5 + REAL(KIND=JWRB) :: GTEMP1 + REAL(KIND=JWRB) :: GTEMP2 + REAL(KIND=JWRB) :: FLHAB + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RAORW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: EMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: HALP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: EMEANWS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FMEANWS(:, :) + REAL(KIND=JWRB) :: USFM + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: F1MEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: AKMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XKMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIWA(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: COSWDIF(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINWDIF2(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RHOWGDFTH(:, :, :) + ! *FLD* DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* TOTAL SOURCE FUNCTION ARRAY. + ! *SPOS* : POSITIVE SINPUT ONLY + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SPOS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CIREDUC(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SSOURCE(:, :, :, :) + + LOGICAL :: LCFLX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AF11(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: AFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDICWA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CIBLOCK + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COFRM4(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DKMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EGRCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSU10 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLMAX(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_CPL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDELT + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INLCOEF(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ISNONLIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K11W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K1W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K21W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K2W(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KFRH + LOGICAL, VALUE, INTENT(IN) :: LBIWBK + LOGICAL, VALUE, INTENT(IN) :: LCIWABR + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + LOGICAL, VALUE, INTENT(IN) :: LLUNSTR + LOGICAL, VALUE, INTENT(IN) :: LMASKICE + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWCOU + LOGICAL, VALUE, INTENT(IN) :: LWFLUX + LOGICAL, VALUE, INTENT(IN) :: LWFLUXOUT + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSEND + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTK + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTRN + LOGICAL, VALUE, INTENT(IN) :: LWNEMOTAUOC + LOGICAL, VALUE, INTENT(IN) :: LWVFLX_SNL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MFRSTLW + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MLSTHG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNLCOEF(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATERM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSEMEAN_MIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKDMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM) :: ICHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_start + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_end + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_step + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER, VALUE, INTENT(IN) :: NPROMA_WAM + TYPE(dim3) :: BLOCKDIM + TYPE(dim3) :: GRIDDIM + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINFLX_RNFAC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINFLX_TMP_EM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_UST(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_ENH(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_XNU(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_SIG_TH(:, :) + IJ = threadIdx%x + ICHNK = blockIdx%x + + IF (ICHNK <= NCHNK .and. IJ <= KIJL) THEN + BLOCKDIM = dim3(NPROMA_WAM, 1, 1) + GRIDDIM = dim3(NCHNK, 1, 1) + + ! START of Loki inserted loop ICHNK + + + ! ---------------------------------------------------------------------- + + + + !* 1. INITIALISATION. + ! --------------- + + DELT = IDELT + DELTM = 1.0_JWRB / DELT + XIMP = 1.0_JWRB + DELT5 = XIMP*DELT + + LCFLX = LWFLUX .or. LWFLUXOUT .or. LWNEMOCOU + + + + RAORW(IJ, ICHNK) = MAX(AIRD(IJ, ICHNK), 1.0_JWRB)*ROWATERM1 + + DO K=1,NANG + COSWDIF(IJ, K, ICHNK) = COS(TH(K) - WDWAVE(IJ, ICHNK)) + SINWDIF2(IJ, K, ICHNK) = SIN(TH(K) - WDWAVE(IJ, ICHNK))**2 + END DO + + + ! ---------------------------------------------------------------------- + + !* 2. COMPUTATION OF IMPLICIT INTEGRATION. + ! ------------------------------------ + + ! INTEGRATION IS DONE FROM CDATE UNTIL CDTPRO FOR A BLOCK + ! OF LATITUDES BETWEEN PROPAGATION CALLS. + + + ! REDUCE WAVE ENERGY IF LARGER THAN DEPTH LIMITED WAVE HEIGHT + IF (LBIWBK) THEN + CALL SDEPTHLIM_FC(KIJS, KIJL, EMAXDPT(:, :), FL1(:, :, :, :), DELTH, DFIM(:), EPSMIN, FR(:), NANG, NFRE, WETAIL, ICHNK, & + & NCHNK, IJ) + END IF + + !* 2.2 COMPUTE MEAN PARAMETERS. + ! ------------------------ + + CALL FKMEAN_FC(KIJS, KIJL, FL1(:, :, :, :), WAVNUM(:, :, :), EMEAN(:, ICHNK), FMEAN(:, ICHNK), F1MEAN(:, ICHNK), & + & AKMEAN(:, ICHNK), XKMEAN(:, ICHNK), DELTH, DFIM(:), DFIMFR(:), DFIMOFR(:), EPSMIN, FR(:), FRTAIL, G, NANG, NFRE, WETAIL, & + & WP1TAIL, ZPI, ICHNK, NCHNK, IJ) + + + DO K=1,NANG + FLM(IJ, K, ICHNK) = FLMIN*MAX(0.0_JWRB, COSWDIF(IJ, K, ICHNK))**2 + END DO + + + ! COMPUTE DAMPING COEFFICIENT DUE TO FRICTION ON BOTTOM OF THE SEA ICE. + !!! testing sea ice attenuation (might need to restrict usage when needed) + IF (LCIWABR) THEN + CALL CIWABR_FC(KIJS, KIJL, CICOVER(:, :), FL1(:, :, :, :), WAVNUM(:, :, :), CGROUP(:, :, :), CIREDUC(:, :, :, ICHNK), & + & CDICWA, DFIM(:), EPSMIN, IDELT, LICERUN, LMASKICE, NANG, NFRE, ICHNK, NCHNK, IJ) + + DO M=1,NFRE + DO K=1,NANG + CIREDUC(IJ, K, M, ICHNK) = CIWA(IJ, M, ICHNK)*CIREDUC(IJ, K, M, ICHNK) + END DO + END DO + + ELSE + + DO M=1,NFRE + DO K=1,NANG + CIREDUC(IJ, K, M, ICHNK) = CIWA(IJ, M, ICHNK) + END DO + END DO + + END IF + + ! ---------------------------------------------------------------------- + + !* 2.3 COMPUTATION OF SOURCE FUNCTIONS. + ! -------------------------------- + + !* 2.3.1 ITERATIVELY UPDATE STRESS AND COMPUTE WIND INPUT TERMS. + ! ------------------------------------------------------- + + CALL SINFLX_FC(1, KIJS, KIJL, .true., FL1(:, :, :, :), WAVNUM(:, :, :), CINV(:, :, :), XK2CG(:, :, :), WSWAVE(:, :), & + & WDWAVE(:, :), AIRD(:, :), RAORW(:, ICHNK), WSTAR(:, :), CICOVER(:, :), COSWDIF(:, :, ICHNK), SINWDIF2(:, :, ICHNK), & + & FMEAN(:, ICHNK), HALP(:, ICHNK), FMEANWS(:, ICHNK), FLM(:, :, ICHNK), UFRIC(:, :), TAUW(:, :), TAUWDIR(:, :), Z0M(:, :), & + & Z0B(:, :), CHRNCK(:, :), PHIWA(:, ICHNK), FLD(:, :, :, ICHNK), SL(:, :, :, ICHNK), SPOS(:, :, :, ICHNK), MIJ(:, :), & + & RHOWGDFTH(:, :, ICHNK), XLLWS(:, :, :, :), ABMAX, ABMIN, ACD, ACDLIN, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, & + & ANG_GC_B, ANG_GC_C, BCD, BCDLIN, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC(:), CDMAX, CHNKMIN_U, CITHRSH_TAIL, CM_GC(:), & + & COSTH(:), DELKCC_GC_NS(:), DELKCC_OMXKM3_GC(:), DELTH, DFIM(:), DFIMOFR(:), DTHRN_A, DTHRN_U, EPS1, EPSMIN, EPSUS, & + & FLOGSPRDM1, FR(:), FR5(:), FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IPHYS, JTOT_TAUHF, LLCAPCHNK, & + & LLGCBZ0, LLNORMAGAM, LWCOU, NANG, NFRE, NWAV_GC, OM3GMKM_GC(:), OMEGA_GC(:), OMXKM3_GC(:), RHOWG_DFIM(:), RN1_RN, RNU, & + & RNUM, SINTH(:), SQRTGOSURFT, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT(:), & + & TAILFACTOR, TAILFACTOR_PM, TAUWSHELTER, TH(:), WETAIL, WSPMIN, WTAUHF(:), X0TAUHF, XKAPPA, XKMSQRTVGOC2_GC(:), XKM_GC(:), & + & XK_GC(:), XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, ZPIFR(:), ICHNK, NCHNK, IJ, SINFLX_RNFAC, & + & SINFLX_TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST) + CALL SINFLX_FC(2, KIJS, KIJL, .true., FL1(:, :, :, :), WAVNUM(:, :, :), CINV(:, :, :), XK2CG(:, :, :), WSWAVE(:, :), & + & WDWAVE(:, :), AIRD(:, :), RAORW(:, ICHNK), WSTAR(:, :), CICOVER(:, :), COSWDIF(:, :, ICHNK), SINWDIF2(:, :, ICHNK), & + & FMEAN(:, ICHNK), HALP(:, ICHNK), FMEANWS(:, ICHNK), FLM(:, :, ICHNK), UFRIC(:, :), TAUW(:, :), TAUWDIR(:, :), Z0M(:, :), & + & Z0B(:, :), CHRNCK(:, :), PHIWA(:, ICHNK), FLD(:, :, :, ICHNK), SL(:, :, :, ICHNK), SPOS(:, :, :, ICHNK), MIJ(:, :), & + & RHOWGDFTH(:, :, ICHNK), XLLWS(:, :, :, :), ABMAX, ABMIN, ACD, ACDLIN, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, & + & ANG_GC_B, ANG_GC_C, BCD, BCDLIN, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC(:), CDMAX, CHNKMIN_U, CITHRSH_TAIL, CM_GC(:), & + & COSTH(:), DELKCC_GC_NS(:), DELKCC_OMXKM3_GC(:), DELTH, DFIM(:), DFIMOFR(:), DTHRN_A, DTHRN_U, EPS1, EPSMIN, EPSUS, & + & FLOGSPRDM1, FR(:), FR5(:), FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IPHYS, JTOT_TAUHF, LLCAPCHNK, & + & LLGCBZ0, LLNORMAGAM, LWCOU, NANG, NFRE, NWAV_GC, OM3GMKM_GC(:), OMEGA_GC(:), OMXKM3_GC(:), RHOWG_DFIM(:), RN1_RN, RNU, & + & RNUM, SINTH(:), SQRTGOSURFT, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT(:), & + & TAILFACTOR, TAILFACTOR_PM, TAUWSHELTER, TH(:), WETAIL, WSPMIN, WTAUHF(:), X0TAUHF, XKAPPA, XKMSQRTVGOC2_GC(:), XKM_GC(:), & + & XK_GC(:), XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, ZPIFR(:), ICHNK, NCHNK, IJ, SINFLX_RNFAC, & + & SINFLX_TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST) + + ! 2.3.3 ADD THE OTHER SOURCE TERMS. + ! --------------------------- + + CALL SDISSIP_FC(KIJS, KIJL, FL1(:, :, :, :), FLD(:, :, :, ICHNK), SL(:, :, :, ICHNK), INDEP(:, :), WAVNUM(:, :, :), & + & XK2CG(:, :, :), EMEAN(:, ICHNK), F1MEAN(:, ICHNK), XKMEAN(:, ICHNK), UFRIC(:, :), COSWDIF(:, :, ICHNK), RAORW(:, ICHNK), & + & CDIS, CDISVIS, CUMULW(:, :, :, :), DELTA_SDIS, G, INDICESSAT(:, :), IPHYS, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, & + & NSDSNTH, RNU, SATWEIGHTS(:, :), SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR(:), ICHNK, NCHNK, IJ) + + ! Save source term contributions relevant for the calculation of ocean fluxes + + IF (LCFLX .and. .not.LWVFLX_SNL) THEN + DO M=1,NFRE + DO K=1,NANG + SSOURCE(IJ, K, M, ICHNK) = SL(IJ, K, M, ICHNK) + END DO + END DO + END IF + + + CALL SNONLIN_FC(KIJS, KIJL, FL1(:, :, :, :), FLD(:, :, :, ICHNK), SL(:, :, :, ICHNK), WAVNUM(:, :, :), DEPTH(:, :), & + & AKMEAN(:, ICHNK), AF11(:), BATHYMAX, COSTH(:), DAL1, DAL2, DELTH, DFIM(:), DFIMFR(:), DFIMFR2(:), DKMAX, FKLAM(:), & + & FKLAM1(:), FKLAP(:), FKLAP1(:), FR(:), FRATIO, G, GM1, IKM(:), IKM1(:), IKP(:), IKP1(:), INLCOEF(:, :), ISNONLIN, & + & K11W(:, :), K1W(:, :), K21W(:, :), K2W(:, :), KFRH, MFRSTLW, MLSTHG, NANG, NFRE, RNLCOEF(:, :), SINTH(:), TH(:), WETAIL, & + & WP1TAIL, WP2TAIL, XKDMIN, ZPIFR(:), ICHNK, NCHNK, IJ, SNONLIN_ENH, SNONLIN_XNU, SNONLIN_SIG_TH) + + + IF (LCFLX .and. LWVFLX_SNL) THEN + ! Save source term contributions relevant for the calculation of ocean fluxes + !!!!!! SL must only contain contributions contributed to fluxes into the oceans + ! MODULATE SL BY IMPLICIT FACTOR + DO M=1,NFRE + DO K=1,NANG + GTEMP1 = MAX((1.0_JWRB - DELT5*FLD(IJ, K, M, ICHNK)), 1.0_JWRB) + SSOURCE(IJ, K, M, ICHNK) = SL(IJ, K, M, ICHNK) / GTEMP1 + END DO + END DO + END IF + + + + CALL SDIWBK_FC(KIJS, KIJL, FL1(:, :, :, :), FLD(:, :, :, ICHNK), SL(:, :, :, ICHNK), DEPTH(:, :), EMAXDPT(:, :), & + & EMEAN(:, ICHNK), F1MEAN(:, ICHNK), LBIWBK, NANG, NFRE_RED, ICHNK, NCHNK, IJ) + + CALL SBOTTOM_FC(KIJS, KIJL, FL1(:, :, :, :), FLD(:, :, :, ICHNK), SL(:, :, :, ICHNK), WAVNUM(:, :, :), DEPTH(:, :), & + & BATHYMAX, GM1, NANG, NFRE_RED, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !* 2.4 COMPUTATION OF NEW SPECTRA. + ! --------------------------- + + ! INCREASE OF SPECTRUM IN A TIME STEP IS LIMITED TO A FINITE + ! FRACTION OF A TYPICAL F**(-4) EQUILIBRIUM SPECTRUM. + + + USFM = UFRIC(IJ, ICHNK)*MAX(FMEANWS(IJ, ICHNK), FMEAN(IJ, ICHNK)) + + IF (LLUNSTR) THEN + DO K=1,NANG + DO M=1,NFRE + GTEMP1 = MAX((1.0_JWRB - DELT5*FLD(IJ, K, M, ICHNK)), 1.0_JWRB) + GTEMP2 = DELT*SL(IJ, K, M, ICHNK) / GTEMP1 + FLHAB = ABS(GTEMP2) + FLHAB = MIN(FLHAB, USFM*COFRM4(M)*DELT) + FL1(IJ, K, M, ICHNK) = FL1(IJ, K, M, ICHNK) + IOBND(IJ, ICHNK)*SIGN(FLHAB, GTEMP2) + FL1(IJ, K, M, ICHNK) = MAX(IODP(IJ, ICHNK)*CIREDUC(IJ, K, M, ICHNK)*FL1(IJ, K, M, ICHNK), FLM(IJ, K, ICHNK)) + SSOURCE(IJ, K, M, ICHNK) = SSOURCE(IJ, K, M, ICHNK) + DELTM*MIN(FLMAX(M) - FL1(IJ, K, M, ICHNK), 0.0_JWRB) + FL1(IJ, K, M, ICHNK) = MIN(FL1(IJ, K, M, ICHNK), FLMAX(M)) + END DO + END DO + ELSE + DO K=1,NANG + DO M=1,NFRE + GTEMP1 = MAX((1.0_JWRB - DELT5*FLD(IJ, K, M, ICHNK)), 1.0_JWRB) + GTEMP2 = DELT*SL(IJ, K, M, ICHNK) / GTEMP1 + FLHAB = ABS(GTEMP2) + FLHAB = MIN(FLHAB, USFM*COFRM4(M)*DELT) + FL1(IJ, K, M, ICHNK) = FL1(IJ, K, M, ICHNK) + SIGN(FLHAB, GTEMP2) + FL1(IJ, K, M, ICHNK) = MAX(CIREDUC(IJ, K, M, ICHNK)*FL1(IJ, K, M, ICHNK), FLM(IJ, K, ICHNK)) + SSOURCE(IJ, K, M, ICHNK) = SSOURCE(IJ, K, M, ICHNK) + DELTM*MIN(FLMAX(M) - FL1(IJ, K, M, ICHNK), 0.0_JWRB) + FL1(IJ, K, M, ICHNK) = MIN(FL1(IJ, K, M, ICHNK), FLMAX(M)) + END DO + END DO + END IF + + + IF (LCFLX) THEN + CALL WNFLUXES_FC(KIJS, KIJL, MIJ(:, :), RHOWGDFTH(:, :, ICHNK), CINV(:, :, :), SSOURCE(:, :, :, ICHNK), CICOVER(:, :), & + & PHIWA(:, ICHNK), EMEAN(:, ICHNK), F1MEAN(:, ICHNK), WSWAVE(:, :), WDWAVE(:, :), UFRIC(:, :), AIRD(:, :), NPHIEPS(:, :), & + & NTAUOC(:, :), NSWH(:, :), NMWP(:, :), NEMOTAUX(:, :), NEMOTAUY(:, :), NEMOWSWAVE(:, :), NEMOPHIF(:, :), TAUXD(:, :), & + & TAUYD(:, :), TAUOCXD(:, :), TAUOCYD(:, :), TAUOC(:, :), PHIOCD(:, :), PHIEPS(:, :), PHIAW(:, :), .true., AFCRV, BFCRV, & + & CIBLOCK, CITHRSH, COSTH(:), EGRCRV, EPSU10, EPSUS, FR(:), G, LICERUN, LWAMRSETCI, LWNEMOCOU, LWNEMOTAUOC, NANG, NFRE, & + & PHIEPSMAX, PHIEPSMIN, SINTH(:), TAUOCMAX, TAUOCMIN, ICHNK, NCHNK, IJ) + END IF + ! ---------------------------------------------------------------------- + + !* 2.5 REPLACE DIAGNOSTIC PART OF SPECTRA BY A F**(-5) TAIL. + ! ----------------------------------------------------- + + CALL FKMEAN_FC(KIJS, KIJL, FL1(:, :, :, :), WAVNUM(:, :, :), EMEAN(:, ICHNK), FMEAN(:, ICHNK), F1MEAN(:, ICHNK), & + & AKMEAN(:, ICHNK), XKMEAN(:, ICHNK), DELTH, DFIM(:), DFIMFR(:), DFIMOFR(:), EPSMIN, FR(:), FRTAIL, G, NANG, NFRE, WETAIL, & + & WP1TAIL, ZPI, ICHNK, NCHNK, IJ) + + ! MEAN FREQUENCY CHARACTERISTIC FOR WIND SEA + CALL FEMEANWS_FC(KIJS, KIJL, FL1(:, :, :, :), XLLWS(:, :, :, :), FMEANWS(:, ICHNK), EMEANWS(:, ICHNK), DELTH, DFIM(:), & + & DFIMOFR(:), EPSMIN, FR(:), FRTAIL, NANG, NFRE, WETAIL, ICHNK, NCHNK, IJ) + + CALL IMPHFTAIL_FC(KIJS, KIJL, MIJ(:, :), FLM(:, :, ICHNK), WAVNUM(:, :, :), XK2CG(:, :, :), FL1(:, :, :, :), NANG, NFRE, & + & ICHNK, NCHNK, IJ) + + + ! UPDATE WINDSEA VARIANCE AND MEAN FREQUENCY IF PASSED TO ATMOSPHERE + ! ------------------------------------------------------------------ + + IF (LWFLUX) THEN + IF (EMEANWS(IJ, ICHNK) < WSEMEAN_MIN) THEN + WSEMEAN(IJ, ICHNK) = WSEMEAN_MIN + WSFMEAN(IJ, ICHNK) = 2._JWRB*FR(NFRE) + ELSE + WSEMEAN(IJ, ICHNK) = EMEANWS(IJ, ICHNK) + WSFMEAN(IJ, ICHNK) = FMEANWS(IJ, ICHNK) + END IF + END IF + + + + !* 2.6 SET FL1 ON ICE POINTS TO ZERO + ! ----------------------------- + + IF (LICERUN .and. LMASKICE) THEN + CALL SETICE_FC(KIJS, KIJL, FL1(:, :, :, :), CICOVER(:, :), COSWDIF(:, :, ICHNK), CITHRSH, EPSMIN, FLMIN, NANG, NFRE, & + & ICHNK, NCHNK, IJ) + END IF + + + !* 2.7 SURFACE STOKES DRIFT AND STRAIN IN SEA ICE + ! ------------------------------------------ + + CALL STOKESTRN_FC(KIJS, KIJL, FL1(:, :, :, :), WAVNUM(:, :, :), STOKFAC(:, :, :), DEPTH(:, :), WSWAVE(:, :), WDWAVE(:, :), & + & CICOVER(:, :), CITHICK(:, :), USTOKES(:, :), VSTOKES(:, :), STRNMS(:, :), NEMOUSTOKES(:, :), NEMOVSTOKES(:, :), & + & NEMOSTRN(:, :), CITHRSH, COSTH(:), DELTH, DFIM(:), DFIM_SIM(:), FLMIN, FR(:), G, LICERUN, LWAMRSETCI, LWCOU, LWNEMOCOU, & + & LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, NANG, NFRE, NFRE_ODD, ROWATER, SINTH(:), ZPI, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + + ! END of Loki inserted loop ICHNK + END IF +END SUBROUTINE IMPLSCH_FC diff --git a/src/phys-scc-cuda/implsch_c.c b/src/phys-scc-cuda/implsch_c.c new file mode 100644 index 00000000..c24892e8 --- /dev/null +++ b/src/phys-scc-cuda/implsch_c.c @@ -0,0 +1,461 @@ +#include +#include +#include +#include +#include +#include +#include "stokestrn_c.h" +#include "setice_c.h" +#include "imphftail_c.h" +#include "femeanws_c.h" +#include "wnfluxes_c.h" +#include "sbottom_c.h" +#include "sdiwbk_c.h" +#include "snonlin_c.h" +#include "sdissip_c.h" +#include "sinflx_c.h" +#include "ciwabr_c.h" +#include "fkmean_c.h" +#include "sdepthlim_c.h" +__global__ void __launch_bounds__(128, 1) implsch_c(int kijs, int kijl, double * fl1, + const double * wavnum, const double * cgroup, const double * ciwa, + const double * cinv, const double * xk2cg, const double * stokfac, + const double * emaxdpt, const int * indep, const double * depth, const int * iobnd, + const int * iodp, const double * aird, const double * wdwave, const double * cicover, + double * wswave, const double * wstar, double * ufric, double * tauw, + double * tauwdir, double * z0m, double * z0b, double * chrnck, const double * cithick, + double * nemoustokes, double * nemovstokes, double * nemostrn, double * nphieps, + double * ntauoc, double * nswh, double * nmwp, double * nemotaux, double * nemotauy, + double * nemowswave, double * nemophif, double * wsemean, double * wsfmean, + double * ustokes, double * vstokes, double * strnms, double * tauxd, double * tauyd, + double * tauocxd, double * tauocyd, double * tauoc, double * phiocd, double * phieps, + double * phiaw, int * mij, double * xllws, double abmax, double abmin, double acd, + double acdlin, const double * af11, double afcrv, double alpha, double alphamax, + double alphamin, double alphapmax, double ang_gc_a, double ang_gc_b, double ang_gc_c, + double bathymax, double bcd, double bcdlin, double betamaxoxkappa2, double bfcrv, + double bmaxokap, const double * c2osqrtvg_gc, double cdicwa, double cdis, + double cdisvis, double cdmax, double chnkmin_u, double ciblock, double cithrsh, + double cithrsh_tail, const double * cm_gc, const double * cofrm4, + const double * costh, const double * cumulw, double dal1, double dal2, + const double * delkcc_gc_ns, const double * delkcc_omxkm3_gc, double delta_sdis, + double delth, const double * dfim, const double * dfimfr, const double * dfimfr2, + const double * dfimofr, const double * dfim_sim, double dkmax, double dthrn_a, + double dthrn_u, double egrcrv, double eps1, double epsmin, double epsu10, + double epsus, const double * fklam, const double * fklam1, const double * fklap, + const double * fklap1, const double * flmax, double flmin, double flogsprdm1, + const double * fr, const double * fr5, double fratio, double fric, double frtail, + double g, double gamnconst, double gm1, int iab, int icode, int icode_cpl, + int idamping, int idelt, const int * ikm, const int * ikm1, const int * ikp, + const int * ikp1, const int * indicessat, const int * inlcoef, int iphys, int ipsat, + int isnonlin, int jtot_tauhf, const int * k11w, const int * k1w, const int * k21w, + const int * k2w, int kfrh, int lbiwbk, int lciwabr, int licerun, int llcapchnk, + int llgcbz0, int llnormagam, int llunstr, int lmaskice, int lwamrsetci, int lwcou, + int lwflux, int lwfluxout, int lwnemocou, int lwnemocousend, int lwnemocoustk, + int lwnemocoustrn, int lwnemotauoc, int lwvflx_snl, int mfrstlw, double miche, + int mlsthg, int nang, int ndepth, int ndikcumul, int nfre, int nfre_odd, int nfre_red, + int nsdsnth, int nwav_gc, const double * om3gmkm_gc, const double * omega_gc, + const double * omxkm3_gc, double phiepsmax, double phiepsmin, + const double * rhowg_dfim, double rn1_rn, const double * rnlcoef, double rnu, + double rnum, double rowater, double rowaterm1, const double * satweights, + double sdsbr, const double * sinth, double sqrtgosurft, double ssdsc2, double ssdsc3, + double ssdsc4, double ssdsc5, double ssdsc6, double swellf, double swellf2, + double swellf3, double swellf4, double swellf5, double swellf6, double swellf7, + double swellf7m1, const double * swellft, double tailfactor, double tailfactor_pm, + double tauocmax, double tauocmin, double tauwshelter, const double * th, + double wetail, double wp1tail, double wp2tail, double wsemean_min, double wspmin, + const double * wtauhf, double x0tauhf, double xkappa, double xkdmin, + const double * xkmsqrtvgoc2_gc, const double * xkm_gc, const double * xk_gc, + double xlogkratiom1_gc, double xnlev, double z0rat, double z0tubmax, double zalp, + double zpi, double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk_start, + int ichnk_end, int ichnk_step, int nchnk, int nproma_wam, double * raorw, + double * emean, double * fmean, double * halp, double * emeanws, double * fmeanws, + double * f1mean, double * akmean, double * xkmean, double * phiwa, double * flm, + double * coswdif, double * sinwdif2, double * rhowgdfth, double * fld, double * sl, + double * spos, double * cireduc, double * ssource, double * sinflx_rnfac, + double * sinflx_tmp_em, double * stresso_xstress, double * stresso_ystress, + double * stresso_tauhf, double * stresso_phihf, double * stresso_usdirp, + double * stresso_ust, double * snonlin_enh, double * snonlin_xnu, + double * snonlin_sig_th); +#include "implsch_c_launch.h" + +__global__ void implsch_c(int kijs, int kijl, double * fl1, const double * wavnum, + const double * cgroup, const double * ciwa, const double * cinv, const double * xk2cg, + const double * stokfac, const double * emaxdpt, const int * indep, + const double * depth, const int * iobnd, const int * iodp, const double * aird, + const double * wdwave, const double * cicover, double * wswave, const double * wstar, + double * ufric, double * tauw, double * tauwdir, double * z0m, double * z0b, + double * chrnck, const double * cithick, double * nemoustokes, double * nemovstokes, + double * nemostrn, double * nphieps, double * ntauoc, double * nswh, double * nmwp, + double * nemotaux, double * nemotauy, double * nemowswave, double * nemophif, + double * wsemean, double * wsfmean, double * ustokes, double * vstokes, + double * strnms, double * tauxd, double * tauyd, double * tauocxd, double * tauocyd, + double * tauoc, double * phiocd, double * phieps, double * phiaw, int * mij, + double * xllws, double abmax, double abmin, double acd, double acdlin, + const double * af11, double afcrv, double alpha, double alphamax, double alphamin, + double alphapmax, double ang_gc_a, double ang_gc_b, double ang_gc_c, double bathymax, + double bcd, double bcdlin, double betamaxoxkappa2, double bfcrv, double bmaxokap, + const double * c2osqrtvg_gc, double cdicwa, double cdis, double cdisvis, double cdmax, + double chnkmin_u, double ciblock, double cithrsh, double cithrsh_tail, + const double * cm_gc, const double * cofrm4, const double * costh, + const double * cumulw, double dal1, double dal2, const double * delkcc_gc_ns, + const double * delkcc_omxkm3_gc, double delta_sdis, double delth, const double * dfim, + const double * dfimfr, const double * dfimfr2, const double * dfimofr, + const double * dfim_sim, double dkmax, double dthrn_a, double dthrn_u, double egrcrv, + double eps1, double epsmin, double epsu10, double epsus, const double * fklam, + const double * fklam1, const double * fklap, const double * fklap1, + const double * flmax, double flmin, double flogsprdm1, const double * fr, + const double * fr5, double fratio, double fric, double frtail, double g, + double gamnconst, double gm1, int iab, int icode, int icode_cpl, int idamping, + int idelt, const int * ikm, const int * ikm1, const int * ikp, const int * ikp1, + const int * indicessat, const int * inlcoef, int iphys, int ipsat, int isnonlin, + int jtot_tauhf, const int * k11w, const int * k1w, const int * k21w, const int * k2w, + int kfrh, int lbiwbk, int lciwabr, int licerun, int llcapchnk, int llgcbz0, + int llnormagam, int llunstr, int lmaskice, int lwamrsetci, int lwcou, int lwflux, + int lwfluxout, int lwnemocou, int lwnemocousend, int lwnemocoustk, int lwnemocoustrn, + int lwnemotauoc, int lwvflx_snl, int mfrstlw, double miche, int mlsthg, int nang, + int ndepth, int ndikcumul, int nfre, int nfre_odd, int nfre_red, int nsdsnth, + int nwav_gc, const double * om3gmkm_gc, const double * omega_gc, + const double * omxkm3_gc, double phiepsmax, double phiepsmin, + const double * rhowg_dfim, double rn1_rn, const double * rnlcoef, double rnu, + double rnum, double rowater, double rowaterm1, const double * satweights, + double sdsbr, const double * sinth, double sqrtgosurft, double ssdsc2, double ssdsc3, + double ssdsc4, double ssdsc5, double ssdsc6, double swellf, double swellf2, + double swellf3, double swellf4, double swellf5, double swellf6, double swellf7, + double swellf7m1, const double * swellft, double tailfactor, double tailfactor_pm, + double tauocmax, double tauocmin, double tauwshelter, const double * th, + double wetail, double wp1tail, double wp2tail, double wsemean_min, double wspmin, + const double * wtauhf, double x0tauhf, double xkappa, double xkdmin, + const double * xkmsqrtvgoc2_gc, const double * xkm_gc, const double * xk_gc, + double xlogkratiom1_gc, double xnlev, double z0rat, double z0tubmax, double zalp, + double zpi, double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk_start, + int ichnk_end, int ichnk_step, int nchnk, int nproma_wam, double * raorw, + double * emean, double * fmean, double * halp, double * emeanws, double * fmeanws, + double * f1mean, double * akmean, double * xkmean, double * phiwa, double * flm, + double * coswdif, double * sinwdif2, double * rhowgdfth, double * fld, double * sl, + double * spos, double * cireduc, double * ssource, double * sinflx_rnfac, + double * sinflx_tmp_em, double * stresso_xstress, double * stresso_ystress, + double * stresso_tauhf, double * stresso_phihf, double * stresso_usdirp, + double * stresso_ust, double * snonlin_enh, double * snonlin_xnu, + double * snonlin_sig_th) { + + + + + + + + + + + + + + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + const int nrnl = 25; + const int ninl = 5; + + + int ij; + int k; + int m; + + double delt; + double deltm; + double ximp; + double delt5; + double gtemp1; + double gtemp2; + double flhab; + double usfm; + + + int lcflx; + int ichnk; + dim3 blockdim; + dim3 griddim; + ij = threadIdx.x; + ichnk = blockIdx.x; + + if (ichnk <= nchnk && ij <= kijl) { + // blockdim = dim3(nproma_wam, 1, 1); + // griddim = dim3(nchnk, 1, 1); + + ichnk++; + ij++; + // START of Loki inserted loop ICHNK + + delt = idelt; + deltm = (double) 1.0 / delt; + ximp = (double) 1.0; + delt5 = ximp*delt; + + lcflx = lwflux || lwfluxout || lwnemocou; + + raorw[ij - 1 + kijl*(ichnk - 1)] = + max((double) (aird[ij - 1 + kijl*(ichnk - 1)]), (double) ((double) 1.0))*rowaterm1; + + for (k = 1; k <= nang; k += 1) { + coswdif[ij - 1 + kijl*(k - 1 + nang_loki_param*(ichnk - 1))] = + cos(th[k - 1] - wdwave[ij - 1 + kijl*(ichnk - 1)]); + sinwdif2[ij - 1 + kijl*(k - 1 + nang_loki_param*(ichnk - 1))] = + pow(sin(th[k - 1] - wdwave[ij - 1 + kijl*(ichnk - 1)]), 2); + } + + if (lbiwbk) { + sdepthlim_c(kijs, kijl, emaxdpt, fl1, delth, dfim, epsmin, fr, nang, nfre, wetail, + ichnk, nchnk, ij); + } + fkmean_c(kijs, kijl, fl1, wavnum, (&emean[ + kijl*(ichnk - 1)]), + (&fmean[ + kijl*(ichnk - 1)]), (&f1mean[ + kijl*(ichnk - 1)]), + (&akmean[ + kijl*(ichnk - 1)]), (&xkmean[ + kijl*(ichnk - 1)]), delth, dfim, + dfimfr, dfimofr, epsmin, fr, frtail, g, nang, nfre, wetail, wp1tail, zpi, ichnk, + nchnk, ij); + + + for (k = 1; k <= nang; k += 1) { + flm[ij - 1 + kijl*(k - 1 + nang_loki_param*(ichnk - 1))] = flmin*(pow(max((double) + ((double) 0.0), (double) (coswdif[ij - 1 + kijl*(k - 1 + nang_loki_param*(ichnk - + 1))])), 2)); + } + + if (lciwabr) { + ciwabr_c(kijs, kijl, cicover, fl1, wavnum, cgroup, + (&cireduc[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + cdicwa, dfim, epsmin, idelt, licerun, lmaskice, nang, nfre, ichnk, nchnk, ij); + + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + cireduc[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = ciwa[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1)) + ]*cireduc[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + } + + } else { + + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + cireduc[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = ciwa[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]; + } + } + + } + sinflx_c(1, kijs, kijl, true, fl1, wavnum, cinv, xk2cg, wswave, wdwave, aird, + (&raorw[ + kijl*(ichnk - 1)]), wstar, cicover, + (&coswdif[ + kijl*( + nang_loki_param*(ichnk - 1))]), + (&sinwdif2[ + kijl*( + nang_loki_param*(ichnk - 1))]), + (&fmean[ + kijl*(ichnk - 1)]), (&halp[ + kijl*(ichnk - 1)]), + (&fmeanws[ + kijl*(ichnk - 1)]), + (&flm[ + kijl*( + nang_loki_param*(ichnk - 1))]), ufric, tauw, tauwdir, z0m, z0b, + chrnck, (&phiwa[ + kijl*(ichnk - 1)]), + (&fld[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&sl[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&spos[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), mij, + (&rhowgdfth[ + kijl*( + nfre_loki_param*(ichnk - 1))]), xllws, abmax, abmin, acd, + acdlin, alpha, alphamax, alphamin, alphapmax, ang_gc_a, ang_gc_b, ang_gc_c, bcd, + bcdlin, betamaxoxkappa2, bmaxokap, c2osqrtvg_gc, cdmax, chnkmin_u, cithrsh_tail, + cm_gc, costh, delkcc_gc_ns, delkcc_omxkm3_gc, delth, dfim, dfimofr, dthrn_a, + dthrn_u, eps1, epsmin, epsus, flogsprdm1, fr, fr5, fric, frtail, g, gamnconst, + gm1, iab, icode, icode_cpl, idamping, iphys, jtot_tauhf, llcapchnk, llgcbz0, + llnormagam, lwcou, nang, nfre, nwav_gc, om3gmkm_gc, omega_gc, omxkm3_gc, + rhowg_dfim, rn1_rn, rnu, rnum, sinth, sqrtgosurft, swellf, swellf2, swellf3, + swellf4, swellf5, swellf6, swellf7, swellf7m1, swellft, tailfactor, tailfactor_pm, + tauwshelter, th, wetail, wspmin, wtauhf, x0tauhf, xkappa, xkmsqrtvgoc2_gc, xkm_gc, + xk_gc, xlogkratiom1_gc, xnlev, z0rat, z0tubmax, zalp, zpi, zpi4gm1, zpi4gm2, + zpifr, ichnk, nchnk, ij, sinflx_rnfac, sinflx_tmp_em, stresso_xstress, + stresso_ystress, stresso_tauhf, stresso_phihf, stresso_usdirp, stresso_ust); + sinflx_c(2, kijs, kijl, true, fl1, wavnum, cinv, xk2cg, wswave, wdwave, aird, + (&raorw[ + kijl*(ichnk - 1)]), wstar, cicover, + (&coswdif[ + kijl*( + nang_loki_param*(ichnk - 1))]), + (&sinwdif2[ + kijl*( + nang_loki_param*(ichnk - 1))]), + (&fmean[ + kijl*(ichnk - 1)]), (&halp[ + kijl*(ichnk - 1)]), + (&fmeanws[ + kijl*(ichnk - 1)]), + (&flm[ + kijl*( + nang_loki_param*(ichnk - 1))]), ufric, tauw, tauwdir, z0m, z0b, + chrnck, (&phiwa[ + kijl*(ichnk - 1)]), + (&fld[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&sl[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&spos[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), mij, + (&rhowgdfth[ + kijl*( + nfre_loki_param*(ichnk - 1))]), xllws, abmax, abmin, acd, + acdlin, alpha, alphamax, alphamin, alphapmax, ang_gc_a, ang_gc_b, ang_gc_c, bcd, + bcdlin, betamaxoxkappa2, bmaxokap, c2osqrtvg_gc, cdmax, chnkmin_u, cithrsh_tail, + cm_gc, costh, delkcc_gc_ns, delkcc_omxkm3_gc, delth, dfim, dfimofr, dthrn_a, + dthrn_u, eps1, epsmin, epsus, flogsprdm1, fr, fr5, fric, frtail, g, gamnconst, + gm1, iab, icode, icode_cpl, idamping, iphys, jtot_tauhf, llcapchnk, llgcbz0, + llnormagam, lwcou, nang, nfre, nwav_gc, om3gmkm_gc, omega_gc, omxkm3_gc, + rhowg_dfim, rn1_rn, rnu, rnum, sinth, sqrtgosurft, swellf, swellf2, swellf3, + swellf4, swellf5, swellf6, swellf7, swellf7m1, swellft, tailfactor, tailfactor_pm, + tauwshelter, th, wetail, wspmin, wtauhf, x0tauhf, xkappa, xkmsqrtvgoc2_gc, xkm_gc, + xk_gc, xlogkratiom1_gc, xnlev, z0rat, z0tubmax, zalp, zpi, zpi4gm1, zpi4gm2, + zpifr, ichnk, nchnk, ij, sinflx_rnfac, sinflx_tmp_em, stresso_xstress, + stresso_ystress, stresso_tauhf, stresso_phihf, stresso_usdirp, stresso_ust); + sdissip_c(kijs, kijl, fl1, + (&fld[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&sl[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), indep, + wavnum, xk2cg, (&emean[ + kijl*(ichnk - 1)]), (&f1mean[ + kijl*(ichnk - 1)]), + (&xkmean[ + kijl*(ichnk - 1)]), ufric, + (&coswdif[ + kijl*( + nang_loki_param*(ichnk - 1))]), + (&raorw[ + kijl*(ichnk - 1)]), cdis, cdisvis, cumulw, delta_sdis, g, indicessat, + iphys, ipsat, miche, nang, ndepth, ndikcumul, nfre, nsdsnth, rnu, satweights, + sdsbr, ssdsc2, ssdsc3, ssdsc4, ssdsc5, ssdsc6, zpi, zpifr, ichnk, nchnk, ij); + + if (lcflx && !lwvflx_snl) { + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + ssource[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + } + } + + + snonlin_c(kijs, kijl, fl1, + (&fld[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&sl[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), wavnum, + depth, (&akmean[ + kijl*(ichnk - 1)]), af11, bathymax, costh, dal1, dal2, delth, + dfim, dfimfr, dfimfr2, dkmax, fklam, fklam1, fklap, fklap1, fr, fratio, g, gm1, + ikm, ikm1, ikp, ikp1, inlcoef, isnonlin, k11w, k1w, k21w, k2w, kfrh, mfrstlw, + mlsthg, nang, nfre, rnlcoef, sinth, th, wetail, wp1tail, wp2tail, xkdmin, zpifr, + ichnk, nchnk, ij, snonlin_enh, snonlin_xnu, snonlin_sig_th); + + + if (lcflx && lwvflx_snl) { + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + gtemp1 = max((double) (((double) 1.0 - delt5*fld[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))])), (double) ((double) + 1.0)); + ssource[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))] / gtemp1; + } + } + } + + sdiwbk_c(kijs, kijl, fl1, + (&fld[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&sl[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), depth, + emaxdpt, (&emean[ + kijl*(ichnk - 1)]), (&f1mean[ + kijl*(ichnk - 1)]), lbiwbk, + nang, nfre_red, ichnk, nchnk, ij); + + sbottom_c(kijs, kijl, fl1, + (&fld[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + (&sl[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), wavnum, + depth, bathymax, gm1, nang, nfre_red, ichnk, nchnk, ij); + + usfm = ufric[ij - 1 + kijl*(ichnk - 1)]*max((double) (fmeanws[ij - 1 + kijl*(ichnk - + 1)]), (double) (fmean[ij - 1 + kijl*(ichnk - 1)])); + + if (llunstr) { + for (k = 1; k <= nang; k += 1) { + for (m = 1; m <= nfre; m += 1) { + gtemp1 = max((double) (((double) 1.0 - delt5*fld[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))])), (double) ((double) + 1.0)); + gtemp2 = delt*sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))] / gtemp1; + flhab = abs((double) (gtemp2)); + flhab = min((double) (flhab), (double) (usfm*cofrm4[m - 1]*delt)); + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1) + ))] = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))] + iobnd[ij - 1 + kijl*(ichnk - 1) + ]*copysign((double) (flhab), (double) (gtemp2)); + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1) + ))] = max((double) (iodp[ij - 1 + kijl*(ichnk - 1)]*cireduc[ij - 1 + kijl*(k + - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]*fl1[ij - 1 + + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]), + (double) (flm[ij - 1 + kijl*(k - 1 + nang_loki_param*(ichnk - 1))])); + ssource[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = ssource[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))] + deltm*min((double) (flmax[m - 1] - fl1[ij - + 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]), + (double) ((double) 0.0)); + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1) + ))] = min((double) (fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]), (double) (flmax[m - 1])); + } + } + } else { + for (k = 1; k <= nang; k += 1) { + for (m = 1; m <= nfre; m += 1) { + gtemp1 = max((double) (((double) 1.0 - delt5*fld[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))])), (double) ((double) + 1.0)); + gtemp2 = delt*sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))] / gtemp1; + flhab = abs((double) (gtemp2)); + flhab = min((double) (flhab), (double) (usfm*cofrm4[m - 1]*delt)); + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1) + ))] = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))] + copysign((double) (flhab), (double) (gtemp2)); + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1) + ))] = max((double) (cireduc[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m + - 1 + nfre_loki_param*(ichnk - 1)))]), (double) (flm[ij - 1 + kijl*(k - 1 + + nang_loki_param*(ichnk - 1))])); + ssource[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = ssource[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))] + deltm*min((double) (flmax[m - 1] - fl1[ij - + 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]), + (double) ((double) 0.0)); + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1) + ))] = min((double) (fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]), (double) (flmax[m - 1])); + } + } + } + + + if (lcflx) { + wnfluxes_c(kijs, kijl, mij, + (&rhowgdfth[ + kijl*( + nfre_loki_param*(ichnk - 1))]), cinv, + (&ssource[ + kijl*( + nang_loki_param*( + nfre_loki_param*(ichnk - 1)))]), + cicover, (&phiwa[ + kijl*(ichnk - 1)]), (&emean[ + kijl*(ichnk - 1)]), + (&f1mean[ + kijl*(ichnk - 1)]), wswave, wdwave, ufric, aird, nphieps, ntauoc, + nswh, nmwp, nemotaux, nemotauy, nemowswave, nemophif, tauxd, tauyd, tauocxd, + tauocyd, tauoc, phiocd, phieps, phiaw, true, afcrv, bfcrv, ciblock, cithrsh, + costh, egrcrv, epsu10, epsus, fr, g, licerun, lwamrsetci, lwnemocou, + lwnemotauoc, nang, nfre, phiepsmax, phiepsmin, sinth, tauocmax, tauocmin, ichnk, + nchnk, ij); + } + fkmean_c(kijs, kijl, fl1, wavnum, (&emean[ + kijl*(ichnk - 1)]), + (&fmean[ + kijl*(ichnk - 1)]), (&f1mean[ + kijl*(ichnk - 1)]), + (&akmean[ + kijl*(ichnk - 1)]), (&xkmean[ + kijl*(ichnk - 1)]), delth, dfim, + dfimfr, dfimofr, epsmin, fr, frtail, g, nang, nfre, wetail, wp1tail, zpi, ichnk, + nchnk, ij); + femeanws_c(kijs, kijl, fl1, xllws, (&fmeanws[ + kijl*(ichnk - 1)]), + (&emeanws[ + kijl*(ichnk - 1)]), delth, dfim, dfimofr, epsmin, fr, frtail, nang, + nfre, wetail, ichnk, nchnk, ij); + + imphftail_c(kijs, kijl, mij, (&flm[ + kijl*( + nang_loki_param*(ichnk - 1))]), + wavnum, xk2cg, fl1, nang, nfre, ichnk, nchnk, ij); + + if (lwflux) { + if (emeanws[ij - 1 + kijl*(ichnk - 1)] < wsemean_min) { + wsemean[ij - 1 + kijl*(ichnk - 1)] = wsemean_min; + wsfmean[ij - 1 + kijl*(ichnk - 1)] = (double) 2.*fr[nfre - 1]; + } else { + wsemean[ij - 1 + kijl*(ichnk - 1)] = emeanws[ij - 1 + kijl*(ichnk - 1)]; + wsfmean[ij - 1 + kijl*(ichnk - 1)] = fmeanws[ij - 1 + kijl*(ichnk - 1)]; + } + } + + if (licerun && lmaskice) { + setice_c(kijs, kijl, fl1, cicover, + (&coswdif[ + kijl*( + nang_loki_param*(ichnk - 1))]), cithrsh, epsmin, flmin, + nang, nfre, ichnk, nchnk, ij); + } + stokestrn_c(kijs, kijl, fl1, wavnum, stokfac, depth, wswave, wdwave, cicover, + cithick, ustokes, vstokes, strnms, nemoustokes, nemovstokes, nemostrn, cithrsh, + costh, delth, dfim, dfim_sim, flmin, fr, g, licerun, lwamrsetci, lwcou, lwnemocou, + lwnemocousend, lwnemocoustk, lwnemocoustrn, nang, nfre, nfre_odd, rowater, sinth, + zpi, ichnk, nchnk, ij); + // END of Loki inserted loop ICHNK + } +} diff --git a/src/phys-scc-cuda/implsch_c_launch.h b/src/phys-scc-cuda/implsch_c_launch.h new file mode 100644 index 00000000..391d2bb2 --- /dev/null +++ b/src/phys-scc-cuda/implsch_c_launch.h @@ -0,0 +1,141 @@ +#include +#include +#include +#include +#include +#include +extern "C" { +void implsch_c_launch(int kijs, int kijl, double * fl1, const double * wavnum, + const double * cgroup, const double * ciwa, const double * cinv, const double * xk2cg, + const double * stokfac, const double * emaxdpt, const int * indep, + const double * depth, const int * iobnd, const int * iodp, const double * aird, + const double * wdwave, const double * cicover, double * wswave, const double * wstar, + double * ufric, double * tauw, double * tauwdir, double * z0m, double * z0b, + double * chrnck, const double * cithick, double * nemoustokes, double * nemovstokes, + double * nemostrn, double * nphieps, double * ntauoc, double * nswh, double * nmwp, + double * nemotaux, double * nemotauy, double * nemowswave, double * nemophif, + double * wsemean, double * wsfmean, double * ustokes, double * vstokes, + double * strnms, double * tauxd, double * tauyd, double * tauocxd, double * tauocyd, + double * tauoc, double * phiocd, double * phieps, double * phiaw, int * mij, + double * xllws, double abmax, double abmin, double acd, double acdlin, + const double * af11, double afcrv, double alpha, double alphamax, double alphamin, + double alphapmax, double ang_gc_a, double ang_gc_b, double ang_gc_c, double bathymax, + double bcd, double bcdlin, double betamaxoxkappa2, double bfcrv, double bmaxokap, + const double * c2osqrtvg_gc, double cdicwa, double cdis, double cdisvis, double cdmax, + double chnkmin_u, double ciblock, double cithrsh, double cithrsh_tail, + const double * cm_gc, const double * cofrm4, const double * costh, + const double * cumulw, double dal1, double dal2, const double * delkcc_gc_ns, + const double * delkcc_omxkm3_gc, double delta_sdis, double delth, const double * dfim, + const double * dfimfr, const double * dfimfr2, const double * dfimofr, + const double * dfim_sim, double dkmax, double dthrn_a, double dthrn_u, double egrcrv, + double eps1, double epsmin, double epsu10, double epsus, const double * fklam, + const double * fklam1, const double * fklap, const double * fklap1, + const double * flmax, double flmin, double flogsprdm1, const double * fr, + const double * fr5, double fratio, double fric, double frtail, double g, + double gamnconst, double gm1, int iab, int icode, int icode_cpl, int idamping, + int idelt, const int * ikm, const int * ikm1, const int * ikp, const int * ikp1, + const int * indicessat, const int * inlcoef, int iphys, int ipsat, int isnonlin, + int jtot_tauhf, const int * k11w, const int * k1w, const int * k21w, const int * k2w, + int kfrh, int lbiwbk, int lciwabr, int licerun, int llcapchnk, int llgcbz0, + int llnormagam, int llunstr, int lmaskice, int lwamrsetci, int lwcou, int lwflux, + int lwfluxout, int lwnemocou, int lwnemocousend, int lwnemocoustk, int lwnemocoustrn, + int lwnemotauoc, int lwvflx_snl, int mfrstlw, double miche, int mlsthg, int nang, + int ndepth, int ndikcumul, int nfre, int nfre_odd, int nfre_red, int nsdsnth, + int nwav_gc, const double * om3gmkm_gc, const double * omega_gc, + const double * omxkm3_gc, double phiepsmax, double phiepsmin, + const double * rhowg_dfim, double rn1_rn, const double * rnlcoef, double rnu, + double rnum, double rowater, double rowaterm1, const double * satweights, + double sdsbr, const double * sinth, double sqrtgosurft, double ssdsc2, double ssdsc3, + double ssdsc4, double ssdsc5, double ssdsc6, double swellf, double swellf2, + double swellf3, double swellf4, double swellf5, double swellf6, double swellf7, + double swellf7m1, const double * swellft, double tailfactor, double tailfactor_pm, + double tauocmax, double tauocmin, double tauwshelter, const double * th, + double wetail, double wp1tail, double wp2tail, double wsemean_min, double wspmin, + const double * wtauhf, double x0tauhf, double xkappa, double xkdmin, + const double * xkmsqrtvgoc2_gc, const double * xkm_gc, const double * xk_gc, + double xlogkratiom1_gc, double xnlev, double z0rat, double z0tubmax, double zalp, + double zpi, double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk_start, + int ichnk_end, int ichnk_step, int nchnk, int nproma_wam, double * raorw, + double * emean, double * fmean, double * halp, double * emeanws, double * fmeanws, + double * f1mean, double * akmean, double * xkmean, double * phiwa, double * flm, + double * coswdif, double * sinwdif2, double * rhowgdfth, double * fld, double * sl, + double * spos, double * cireduc, double * ssource, double * sinflx_rnfac, + double * sinflx_tmp_em, double * stresso_xstress, double * stresso_ystress, + double * stresso_tauhf, double * stresso_phihf, double * stresso_usdirp, + double * stresso_ust, double * snonlin_enh, double * snonlin_xnu, + double * snonlin_sig_th) { + + + + + + + + + + + + + + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + const int nrnl = 25; + const int ninl = 5; + + + int ij; + int k; + int m; + + double delt; + double deltm; + double ximp; + double delt5; + double gtemp1; + double gtemp2; + double flhab; + double usfm; + + + int lcflx; + int ichnk; + dim3 blockdim; + dim3 griddim; + // here should be the launcher .... + griddim = dim3(nchnk, 1, 1); + blockdim = dim3(nproma_wam, 1, 1); + implsch_c<<>>(kijs, kijl, fl1, wavnum, cgroup, ciwa, cinv, xk2cg, + stokfac, emaxdpt, indep, depth, iobnd, iodp, aird, wdwave, cicover, wswave, wstar, + ufric, tauw, tauwdir, z0m, z0b, chrnck, cithick, nemoustokes, nemovstokes, nemostrn, + nphieps, ntauoc, nswh, nmwp, nemotaux, nemotauy, nemowswave, nemophif, wsemean, + wsfmean, ustokes, vstokes, strnms, tauxd, tauyd, tauocxd, tauocyd, tauoc, phiocd, + phieps, phiaw, mij, xllws, abmax, abmin, acd, acdlin, af11, afcrv, alpha, alphamax, + alphamin, alphapmax, ang_gc_a, ang_gc_b, ang_gc_c, bathymax, bcd, bcdlin, + betamaxoxkappa2, bfcrv, bmaxokap, c2osqrtvg_gc, cdicwa, cdis, cdisvis, cdmax, + chnkmin_u, ciblock, cithrsh, cithrsh_tail, cm_gc, cofrm4, costh, cumulw, dal1, dal2, + delkcc_gc_ns, delkcc_omxkm3_gc, delta_sdis, delth, dfim, dfimfr, dfimfr2, dfimofr, + dfim_sim, dkmax, dthrn_a, dthrn_u, egrcrv, eps1, epsmin, epsu10, epsus, fklam, + fklam1, fklap, fklap1, flmax, flmin, flogsprdm1, fr, fr5, fratio, fric, frtail, g, + gamnconst, gm1, iab, icode, icode_cpl, idamping, idelt, ikm, ikm1, ikp, ikp1, + indicessat, inlcoef, iphys, ipsat, isnonlin, jtot_tauhf, k11w, k1w, k21w, k2w, kfrh, + lbiwbk, lciwabr, licerun, llcapchnk, llgcbz0, llnormagam, llunstr, lmaskice, + lwamrsetci, lwcou, lwflux, lwfluxout, lwnemocou, lwnemocousend, lwnemocoustk, + lwnemocoustrn, lwnemotauoc, lwvflx_snl, mfrstlw, miche, mlsthg, nang, ndepth, + ndikcumul, nfre, nfre_odd, nfre_red, nsdsnth, nwav_gc, om3gmkm_gc, omega_gc, + omxkm3_gc, phiepsmax, phiepsmin, rhowg_dfim, rn1_rn, rnlcoef, rnu, rnum, rowater, + rowaterm1, satweights, sdsbr, sinth, sqrtgosurft, ssdsc2, ssdsc3, ssdsc4, ssdsc5, + ssdsc6, swellf, swellf2, swellf3, swellf4, swellf5, swellf6, swellf7, swellf7m1, + swellft, tailfactor, tailfactor_pm, tauocmax, tauocmin, tauwshelter, th, wetail, + wp1tail, wp2tail, wsemean_min, wspmin, wtauhf, x0tauhf, xkappa, xkdmin, + xkmsqrtvgoc2_gc, xkm_gc, xk_gc, xlogkratiom1_gc, xnlev, z0rat, z0tubmax, zalp, zpi, + zpi4gm1, zpi4gm2, zpifr, ichnk_start, ichnk_end, ichnk_step, nchnk, nproma_wam, + raorw, emean, fmean, halp, emeanws, fmeanws, f1mean, akmean, xkmean, phiwa, flm, + coswdif, sinwdif2, rhowgdfth, fld, sl, spos, cireduc, ssource, sinflx_rnfac, + sinflx_tmp_em, stresso_xstress, stresso_ystress, stresso_tauhf, stresso_phihf, + stresso_usdirp, stresso_ust, snonlin_enh, snonlin_xnu, snonlin_sig_th); + cudaDeviceSynchronize(); +} +} diff --git a/src/phys-scc-cuda/implsch_fc.F90 b/src/phys-scc-cuda/implsch_fc.F90 new file mode 100644 index 00000000..f75fa393 --- /dev/null +++ b/src/phys-scc-cuda/implsch_fc.F90 @@ -0,0 +1,810 @@ +MODULE IMPLSCH_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE IMPLSCH_fc (KIJS, KIJL, FL1, WAVNUM, CGROUP, CIWA, CINV, XK2CG, STOKFAC, EMAXDPT, INDEP, DEPTH, IOBND, IODP, AIRD, & + & WDWAVE, CICOVER, WSWAVE, WSTAR, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, CITHICK, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, & + & NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, WSEMEAN, WSFMEAN, USTOKES, VSTOKES, STRNMS, TAUXD, & + & TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, MIJ, XLLWS, ABMAX, ABMIN, ACD, ACDLIN, AF11, AFCRV, ALPHA, ALPHAMAX, & + & ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BATHYMAX, BCD, BCDLIN, BETAMAXOXKAPPA2, BFCRV, BMAXOKAP, C2OSQRTVG_GC, & + & CDICWA, CDIS, CDISVIS, CDMAX, CHNKMIN_U, CIBLOCK, CITHRSH, CITHRSH_TAIL, CM_GC, COFRM4, COSTH, CUMULW, DAL1, DAL2, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, DELTA_SDIS, DELTH, DFIM, DFIMFR, DFIMFR2, DFIMOFR, DFIM_SIM, DKMAX, DTHRN_A, DTHRN_U, & + & EGRCRV, EPS1, EPSMIN, EPSU10, EPSUS, FKLAM, FKLAM1, FKLAP, FKLAP1, FLMAX, FLMIN, FLOGSPRDM1, FR, FR5, FRATIO, FRIC, FRTAIL, & + & G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IDELT, IKM, IKM1, IKP, IKP1, INDICESSAT, INLCOEF, IPHYS, IPSAT, & + & ISNONLIN, JTOT_TAUHF, K11W, K1W, K21W, K2W, KFRH, LBIWBK, LCIWABR, LICERUN, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LLUNSTR, & + & LMASKICE, LWAMRSETCI, LWCOU, LWFLUX, LWFLUXOUT, LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, LWNEMOTAUOC, & + & LWVFLX_SNL, MFRSTLW, MICHE, MLSTHG, NANG, NDEPTH, NDIKCUMUL, NFRE, NFRE_ODD, NFRE_RED, NSDSNTH, NWAV_GC, OM3GMKM_GC, & + & OMEGA_GC, OMXKM3_GC, PHIEPSMAX, PHIEPSMIN, RHOWG_DFIM, RN1_RN, RNLCOEF, RNU, RNUM, ROWATER, ROWATERM1, SATWEIGHTS, SDSBR, & + & SINTH, SQRTGOSURFT, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, & + & SWELLF7M1, SWELLFT, TAILFACTOR, TAILFACTOR_PM, TAUOCMAX, TAUOCMIN, TAUWSHELTER, TH, WETAIL, WP1TAIL, WP2TAIL, WSEMEAN_MIN, & + & WSPMIN, WTAUHF, X0TAUHF, XKAPPA, XKDMIN, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, & + & ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK_start, ICHNK_end, ICHNK_step, NCHNK, NPROMA_WAM, RAORW, EMEAN, FMEAN, HALP, EMEANWS, FMEANWS, & + & F1MEAN, AKMEAN, XKMEAN, PHIWA, FLM, COSWDIF, SINWDIF2, RHOWGDFTH, FLD, SL, SPOS, CIREDUC, SSOURCE, SINFLX_RNFAC, & + & SINFLX_TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST, SNONLIN_ENH, & + & SNONLIN_XNU, SNONLIN_SIG_TH) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRO, JWRB + + + + IMPLICIT NONE + INTERFACE + SUBROUTINE CIWABR (KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIWAB) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, CGROUP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: CIWAB + END SUBROUTINE CIWABR + END INTERFACE + INTERFACE + SUBROUTINE FEMEANWS (KIJS, KIJL, FL1, XLLWS, FM, EM) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, XLLWS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FM + REAL(KIND=JWRB), OPTIONAL, INTENT(OUT), DIMENSION(KIJL) :: EM + END SUBROUTINE FEMEANWS + END INTERFACE + INTERFACE + SUBROUTINE FKMEAN (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: EM, FM1, F1, AK, XK + END SUBROUTINE FKMEAN + END INTERFACE + INTERFACE + SUBROUTINE SBOTTOM (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + END SUBROUTINE SBOTTOM + END INTERFACE + INTERFACE + SUBROUTINE IMPHFTAIL (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: MIJ + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: FLM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + END SUBROUTINE IMPHFTAIL + END INTERFACE + INTERFACE + SUBROUTINE SDEPTHLIM (KIJS, KIJL, EMAXDPT, FL1) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMAXDPT + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + END SUBROUTINE SDEPTHLIM + END INTERFACE + INTERFACE + SUBROUTINE SDISSIP (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, RAORW) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: INDEP + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMEAN, F1MEAN, XKMEAN + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SDISSIP + END INTERFACE + INTERFACE + SUBROUTINE SDIWBK (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH, EMAXDPT, EMEAN, F1MEAN + END SUBROUTINE SDIWBK + END INTERFACE + INTERFACE + SUBROUTINE SETICE (KIJS, KIJL, FL1, CICOVER, COSWDIF) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SETICE + END INTERFACE + INTERFACE + SUBROUTINE SINFLX (ICALL, KIJS, KIJL, LUPDTUS, FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, WSTAR, CICOVER, & + & COSWDIF, SINWDIF2, FMEAN, HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, MIJ, & + & RHOWGDFTH, XLLWS) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: ICALL + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + LOGICAL, INTENT(IN) :: LUPDTUS + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: XK2CG + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: WSWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: AIRD + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSTAR + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: SINWDIF2 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: FMEAN + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: HALP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FMEANWS + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: FLM + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: UFRIC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUW + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUWDIR + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: Z0M + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: Z0B + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: CHRNCK + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: PHIWA + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: FLD + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: SL + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: SPOS + INTEGER(KIND=JWIM), INTENT(OUT) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: XLLWS + END SUBROUTINE SINFLX + END INTERFACE + INTERFACE + SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH, AKMEAN + END SUBROUTINE SNONLIN + END INTERFACE + INTERFACE + SUBROUTINE STOKESTRN (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, VSTOKES, STRNMS, & + & NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN) + USE parkind_wave, ONLY: jwim, jwrb, jwro + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, STOKFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSWAVE, WDWAVE, CICOVER, CITHICK + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: USTOKES, VSTOKES, STRNMS + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN + END SUBROUTINE STOKESTRN + END INTERFACE + INTERFACE + SUBROUTINE WNFLUXES (KIJS, KIJL, MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, UFRIC, AIRD, & + & NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, & + & PHIEPS, PHIAW, LNUPD) + USE parkind_wave, ONLY: jwim, jwrb, jwro + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: MIJ + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: SSURF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: PHIWA + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EM, F1, WSWAVE, WDWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, AIRD + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: PHIOCD, PHIEPS, PHIAW + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOTAUY, NEMOWSWAVE, NEMOPHIF + LOGICAL, INTENT(IN) :: LNUPD + END SUBROUTINE WNFLUXES + END INTERFACE + ! ---------------------------------------------------------------------- + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + + + + + ! *FLD* DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* TOTAL SOURCE FUNCTION ARRAY. + ! *SPOS* : POSITIVE SINPUT ONLY + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: AFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDICWA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CIBLOCK + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DKMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EGRCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSU10 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_CPL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDELT + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ISNONLIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KFRH + LOGICAL, VALUE, INTENT(IN) :: LBIWBK + LOGICAL, VALUE, INTENT(IN) :: LCIWABR + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + LOGICAL, VALUE, INTENT(IN) :: LLUNSTR + LOGICAL, VALUE, INTENT(IN) :: LMASKICE + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWCOU + LOGICAL, VALUE, INTENT(IN) :: LWFLUX + LOGICAL, VALUE, INTENT(IN) :: LWFLUXOUT + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSEND + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTK + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTRN + LOGICAL, VALUE, INTENT(IN) :: LWNEMOTAUOC + LOGICAL, VALUE, INTENT(IN) :: LWVFLX_SNL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MFRSTLW + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MLSTHG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATERM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSEMEAN_MIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKDMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_start + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_end + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_step + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER, VALUE, INTENT(IN) :: NPROMA_WAM + INTERFACE + SUBROUTINE IMPLSCH_iso_c (KIJS, KIJL, FL1, WAVNUM, CGROUP, CIWA, CINV, XK2CG, STOKFAC, EMAXDPT, INDEP, DEPTH, IOBND, IODP, & + & AIRD, WDWAVE, CICOVER, WSWAVE, WSTAR, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, CITHICK, NEMOUSTOKES, NEMOVSTOKES, & + & NEMOSTRN, NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, WSEMEAN, WSFMEAN, USTOKES, VSTOKES, & + & STRNMS, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, MIJ, XLLWS, ABMAX, ABMIN, ACD, ACDLIN, AF11, & + & AFCRV, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BATHYMAX, BCD, BCDLIN, BETAMAXOXKAPPA2, & + & BFCRV, BMAXOKAP, C2OSQRTVG_GC, CDICWA, CDIS, CDISVIS, CDMAX, CHNKMIN_U, CIBLOCK, CITHRSH, CITHRSH_TAIL, CM_GC, COFRM4, & + & COSTH, CUMULW, DAL1, DAL2, DELKCC_GC_NS, DELKCC_OMXKM3_GC, DELTA_SDIS, DELTH, DFIM, DFIMFR, DFIMFR2, DFIMOFR, DFIM_SIM, & + & DKMAX, DTHRN_A, DTHRN_U, EGRCRV, EPS1, EPSMIN, EPSU10, EPSUS, FKLAM, FKLAM1, FKLAP, FKLAP1, FLMAX, FLMIN, FLOGSPRDM1, & + & FR, FR5, FRATIO, FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IDELT, IKM, IKM1, IKP, IKP1, & + & INDICESSAT, INLCOEF, IPHYS, IPSAT, ISNONLIN, JTOT_TAUHF, K11W, K1W, K21W, K2W, KFRH, LBIWBK, LCIWABR, LICERUN, & + & LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LLUNSTR, LMASKICE, LWAMRSETCI, LWCOU, LWFLUX, LWFLUXOUT, LWNEMOCOU, LWNEMOCOUSEND, & + & LWNEMOCOUSTK, LWNEMOCOUSTRN, LWNEMOTAUOC, LWVFLX_SNL, MFRSTLW, MICHE, MLSTHG, NANG, NDEPTH, NDIKCUMUL, NFRE, NFRE_ODD, & + & NFRE_RED, NSDSNTH, NWAV_GC, OM3GMKM_GC, OMEGA_GC, OMXKM3_GC, PHIEPSMAX, PHIEPSMIN, RHOWG_DFIM, RN1_RN, RNLCOEF, RNU, & + & RNUM, ROWATER, ROWATERM1, SATWEIGHTS, SDSBR, SINTH, SQRTGOSURFT, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, SWELLF, & + & SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAILFACTOR, TAILFACTOR_PM, TAUOCMAX, TAUOCMIN, & + & TAUWSHELTER, TH, WETAIL, WP1TAIL, WP2TAIL, WSEMEAN_MIN, WSPMIN, WTAUHF, X0TAUHF, XKAPPA, XKDMIN, XKMSQRTVGOC2_GC, & + & XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK_start, ICHNK_end, & + & ICHNK_step, NCHNK, NPROMA_WAM, RAORW, EMEAN, FMEAN, HALP, EMEANWS, FMEANWS, F1MEAN, AKMEAN, XKMEAN, PHIWA, FLM, COSWDIF, & + & SINWDIF2, RHOWGDFTH, FLD, SL, SPOS, CIREDUC, SSOURCE, SINFLX_RNFAC, SINFLX_TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, & + & STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST, SNONLIN_ENH, SNONLIN_XNU, SNONLIN_SIG_TH) & + & BIND(c, name="implsch_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: CGROUP + TYPE(c_ptr), VALUE :: CIWA + TYPE(c_ptr), VALUE :: CINV + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: STOKFAC + TYPE(c_ptr), VALUE :: EMAXDPT + TYPE(c_ptr), VALUE :: INDEP + TYPE(c_ptr), VALUE :: DEPTH + TYPE(c_ptr), VALUE :: IOBND + TYPE(c_ptr), VALUE :: IODP + TYPE(c_ptr), VALUE :: AIRD + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: WSTAR + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: TAUW + TYPE(c_ptr), VALUE :: TAUWDIR + TYPE(c_ptr), VALUE :: Z0M + TYPE(c_ptr), VALUE :: Z0B + TYPE(c_ptr), VALUE :: CHRNCK + TYPE(c_ptr), VALUE :: CITHICK + TYPE(c_ptr), VALUE :: NEMOUSTOKES + TYPE(c_ptr), VALUE :: NEMOVSTOKES + TYPE(c_ptr), VALUE :: NEMOSTRN + TYPE(c_ptr), VALUE :: NPHIEPS + TYPE(c_ptr), VALUE :: NTAUOC + TYPE(c_ptr), VALUE :: NSWH + TYPE(c_ptr), VALUE :: NMWP + TYPE(c_ptr), VALUE :: NEMOTAUX + TYPE(c_ptr), VALUE :: NEMOTAUY + TYPE(c_ptr), VALUE :: NEMOWSWAVE + TYPE(c_ptr), VALUE :: NEMOPHIF + TYPE(c_ptr), VALUE :: WSEMEAN + TYPE(c_ptr), VALUE :: WSFMEAN + TYPE(c_ptr), VALUE :: USTOKES + TYPE(c_ptr), VALUE :: VSTOKES + TYPE(c_ptr), VALUE :: STRNMS + TYPE(c_ptr), VALUE :: TAUXD + TYPE(c_ptr), VALUE :: TAUYD + TYPE(c_ptr), VALUE :: TAUOCXD + TYPE(c_ptr), VALUE :: TAUOCYD + TYPE(c_ptr), VALUE :: TAUOC + TYPE(c_ptr), VALUE :: PHIOCD + TYPE(c_ptr), VALUE :: PHIEPS + TYPE(c_ptr), VALUE :: PHIAW + TYPE(c_ptr), VALUE :: MIJ + TYPE(c_ptr), VALUE :: XLLWS + REAL, VALUE :: ABMAX + REAL, VALUE :: ABMIN + REAL, VALUE :: ACD + REAL, VALUE :: ACDLIN + TYPE(c_ptr), VALUE :: AF11 + REAL, VALUE :: AFCRV + REAL, VALUE :: ALPHA + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: ALPHAPMAX + REAL, VALUE :: ANG_GC_A + REAL, VALUE :: ANG_GC_B + REAL, VALUE :: ANG_GC_C + REAL, VALUE :: BATHYMAX + REAL, VALUE :: BCD + REAL, VALUE :: BCDLIN + REAL, VALUE :: BETAMAXOXKAPPA2 + REAL, VALUE :: BFCRV + REAL, VALUE :: BMAXOKAP + TYPE(c_ptr), VALUE :: C2OSQRTVG_GC + REAL, VALUE :: CDICWA + REAL, VALUE :: CDIS + REAL, VALUE :: CDISVIS + REAL, VALUE :: CDMAX + REAL, VALUE :: CHNKMIN_U + REAL, VALUE :: CIBLOCK + REAL, VALUE :: CITHRSH + REAL, VALUE :: CITHRSH_TAIL + TYPE(c_ptr), VALUE :: CM_GC + TYPE(c_ptr), VALUE :: COFRM4 + TYPE(c_ptr), VALUE :: COSTH + TYPE(c_ptr), VALUE :: CUMULW + REAL, VALUE :: DAL1 + REAL, VALUE :: DAL2 + TYPE(c_ptr), VALUE :: DELKCC_GC_NS + TYPE(c_ptr), VALUE :: DELKCC_OMXKM3_GC + REAL, VALUE :: DELTA_SDIS + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIMFR + TYPE(c_ptr), VALUE :: DFIMFR2 + TYPE(c_ptr), VALUE :: DFIMOFR + TYPE(c_ptr), VALUE :: DFIM_SIM + REAL, VALUE :: DKMAX + REAL, VALUE :: DTHRN_A + REAL, VALUE :: DTHRN_U + REAL, VALUE :: EGRCRV + REAL, VALUE :: EPS1 + REAL, VALUE :: EPSMIN + REAL, VALUE :: EPSU10 + REAL, VALUE :: EPSUS + TYPE(c_ptr), VALUE :: FKLAM + TYPE(c_ptr), VALUE :: FKLAM1 + TYPE(c_ptr), VALUE :: FKLAP + TYPE(c_ptr), VALUE :: FKLAP1 + TYPE(c_ptr), VALUE :: FLMAX + REAL, VALUE :: FLMIN + REAL, VALUE :: FLOGSPRDM1 + TYPE(c_ptr), VALUE :: FR + TYPE(c_ptr), VALUE :: FR5 + REAL, VALUE :: FRATIO + REAL, VALUE :: FRIC + REAL, VALUE :: FRTAIL + REAL, VALUE :: G + REAL, VALUE :: GAMNCONST + REAL, VALUE :: GM1 + INTEGER(KIND=c_int), VALUE :: IAB + INTEGER(KIND=c_int), VALUE :: ICODE + INTEGER(KIND=c_int), VALUE :: ICODE_CPL + INTEGER(KIND=c_int), VALUE :: IDAMPING + INTEGER(KIND=c_int), VALUE :: IDELT + TYPE(c_ptr), VALUE :: IKM + TYPE(c_ptr), VALUE :: IKM1 + TYPE(c_ptr), VALUE :: IKP + TYPE(c_ptr), VALUE :: IKP1 + TYPE(c_ptr), VALUE :: INDICESSAT + TYPE(c_ptr), VALUE :: INLCOEF + INTEGER(KIND=c_int), VALUE :: IPHYS + INTEGER(KIND=c_int), VALUE :: IPSAT + INTEGER(KIND=c_int), VALUE :: ISNONLIN + INTEGER(KIND=c_int), VALUE :: JTOT_TAUHF + TYPE(c_ptr), VALUE :: K11W + TYPE(c_ptr), VALUE :: K1W + TYPE(c_ptr), VALUE :: K21W + TYPE(c_ptr), VALUE :: K2W + INTEGER(KIND=c_int), VALUE :: KFRH + LOGICAL, VALUE :: LBIWBK + LOGICAL, VALUE :: LCIWABR + LOGICAL, VALUE :: LICERUN + LOGICAL, VALUE :: LLCAPCHNK + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + LOGICAL, VALUE :: LLUNSTR + LOGICAL, VALUE :: LMASKICE + LOGICAL, VALUE :: LWAMRSETCI + LOGICAL, VALUE :: LWCOU + LOGICAL, VALUE :: LWFLUX + LOGICAL, VALUE :: LWFLUXOUT + LOGICAL, VALUE :: LWNEMOCOU + LOGICAL, VALUE :: LWNEMOCOUSEND + LOGICAL, VALUE :: LWNEMOCOUSTK + LOGICAL, VALUE :: LWNEMOCOUSTRN + LOGICAL, VALUE :: LWNEMOTAUOC + LOGICAL, VALUE :: LWVFLX_SNL + INTEGER(KIND=c_int), VALUE :: MFRSTLW + REAL, VALUE :: MICHE + INTEGER(KIND=c_int), VALUE :: MLSTHG + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NDEPTH + INTEGER(KIND=c_int), VALUE :: NDIKCUMUL + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: NFRE_ODD + INTEGER(KIND=c_int), VALUE :: NFRE_RED + INTEGER(KIND=c_int), VALUE :: NSDSNTH + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OM3GMKM_GC + TYPE(c_ptr), VALUE :: OMEGA_GC + TYPE(c_ptr), VALUE :: OMXKM3_GC + REAL, VALUE :: PHIEPSMAX + REAL, VALUE :: PHIEPSMIN + TYPE(c_ptr), VALUE :: RHOWG_DFIM + REAL, VALUE :: RN1_RN + TYPE(c_ptr), VALUE :: RNLCOEF + REAL, VALUE :: RNU + REAL, VALUE :: RNUM + REAL, VALUE :: ROWATER + REAL, VALUE :: ROWATERM1 + TYPE(c_ptr), VALUE :: SATWEIGHTS + REAL, VALUE :: SDSBR + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: SQRTGOSURFT + REAL, VALUE :: SSDSC2 + REAL, VALUE :: SSDSC3 + REAL, VALUE :: SSDSC4 + REAL, VALUE :: SSDSC5 + REAL, VALUE :: SSDSC6 + REAL, VALUE :: SWELLF + REAL, VALUE :: SWELLF2 + REAL, VALUE :: SWELLF3 + REAL, VALUE :: SWELLF4 + REAL, VALUE :: SWELLF5 + REAL, VALUE :: SWELLF6 + REAL, VALUE :: SWELLF7 + REAL, VALUE :: SWELLF7M1 + TYPE(c_ptr), VALUE :: SWELLFT + REAL, VALUE :: TAILFACTOR + REAL, VALUE :: TAILFACTOR_PM + REAL, VALUE :: TAUOCMAX + REAL, VALUE :: TAUOCMIN + REAL, VALUE :: TAUWSHELTER + TYPE(c_ptr), VALUE :: TH + REAL, VALUE :: WETAIL + REAL, VALUE :: WP1TAIL + REAL, VALUE :: WP2TAIL + REAL, VALUE :: WSEMEAN_MIN + REAL, VALUE :: WSPMIN + TYPE(c_ptr), VALUE :: WTAUHF + REAL, VALUE :: X0TAUHF + REAL, VALUE :: XKAPPA + REAL, VALUE :: XKDMIN + TYPE(c_ptr), VALUE :: XKMSQRTVGOC2_GC + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + REAL, VALUE :: XNLEV + REAL, VALUE :: Z0RAT + REAL, VALUE :: Z0TUBMAX + REAL, VALUE :: ZALP + REAL, VALUE :: ZPI + REAL, VALUE :: ZPI4GM1 + REAL, VALUE :: ZPI4GM2 + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK_start + INTEGER(KIND=c_int), VALUE :: ICHNK_end + INTEGER(KIND=c_int), VALUE :: ICHNK_step + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: NPROMA_WAM + TYPE(c_ptr), VALUE :: RAORW + TYPE(c_ptr), VALUE :: EMEAN + TYPE(c_ptr), VALUE :: FMEAN + TYPE(c_ptr), VALUE :: HALP + TYPE(c_ptr), VALUE :: EMEANWS + TYPE(c_ptr), VALUE :: FMEANWS + TYPE(c_ptr), VALUE :: F1MEAN + TYPE(c_ptr), VALUE :: AKMEAN + TYPE(c_ptr), VALUE :: XKMEAN + TYPE(c_ptr), VALUE :: PHIWA + TYPE(c_ptr), VALUE :: FLM + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: SINWDIF2 + TYPE(c_ptr), VALUE :: RHOWGDFTH + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: SPOS + TYPE(c_ptr), VALUE :: CIREDUC + TYPE(c_ptr), VALUE :: SSOURCE + TYPE(c_ptr), VALUE :: SINFLX_RNFAC + TYPE(c_ptr), VALUE :: SINFLX_TMP_EM + TYPE(c_ptr), VALUE :: STRESSO_XSTRESS + TYPE(c_ptr), VALUE :: STRESSO_YSTRESS + TYPE(c_ptr), VALUE :: STRESSO_TAUHF + TYPE(c_ptr), VALUE :: STRESSO_PHIHF + TYPE(c_ptr), VALUE :: STRESSO_USDIRP + TYPE(c_ptr), VALUE :: STRESSO_UST + TYPE(c_ptr), VALUE :: SNONLIN_ENH + TYPE(c_ptr), VALUE :: SNONLIN_XNU + TYPE(c_ptr), VALUE :: SNONLIN_SIG_TH + END SUBROUTINE IMPLSCH_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CGROUP(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CIWA(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IOBND(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IODP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CHRNCK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOUSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOVSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOSTRN(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NPHIEPS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NTAUOC(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NSWH(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NMWP(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUX(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUY(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOWSWAVE(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOPHIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSEMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSFMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: VSTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRNMS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIOCD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIEPS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIAW(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AF11(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COFRM4(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLMAX(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INLCOEF(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K11W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K1W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K21W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K2W(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNLCOEF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RAORW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: EMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: HALP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: EMEANWS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FMEANWS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: F1MEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: AKMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XKMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIWA(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: COSWDIF(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINWDIF2(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RHOWGDFTH(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SPOS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CIREDUC(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SSOURCE(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINFLX_RNFAC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINFLX_TMP_EM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_UST(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_ENH(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_XNU(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_SIG_TH(:, :) +!$acc host_data use_device( FL1, WAVNUM, CGROUP, CIWA, CINV, XK2CG, STOKFAC, EMAXDPT, INDEP, DEPTH, IOBND, IODP, AIRD, WDWAVE, & +!$acc & CICOVER, WSWAVE, WSTAR, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, CITHICK, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, NPHIEPS, & +!$acc & NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, WSEMEAN, WSFMEAN, USTOKES, VSTOKES, STRNMS, TAUXD, TAUYD, & +!$acc & TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, MIJ, XLLWS, AF11, C2OSQRTVG_GC, CM_GC, COFRM4, COSTH, CUMULW, & +!$acc & DELKCC_GC_NS, DELKCC_OMXKM3_GC, DFIM, DFIMFR, DFIMFR2, DFIMOFR, DFIM_SIM, FKLAM, FKLAM1, FKLAP, FKLAP1, FLMAX, FR, FR5, & +!$acc & IKM, IKM1, IKP, IKP1, INDICESSAT, INLCOEF, K11W, K1W, K21W, K2W, OM3GMKM_GC, OMEGA_GC, OMXKM3_GC, RHOWG_DFIM, RNLCOEF, & +!$acc & SATWEIGHTS, SINTH, SWELLFT, TH, WTAUHF, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, ZPIFR, RAORW, EMEAN, FMEAN, HALP, EMEANWS, & +!$acc & FMEANWS, F1MEAN, AKMEAN, XKMEAN, PHIWA, FLM, COSWDIF, SINWDIF2, RHOWGDFTH, FLD, SL, SPOS, CIREDUC, SSOURCE, & +!$acc & SINFLX_RNFAC, SINFLX_TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, & +!$acc & STRESSO_UST, SNONLIN_ENH, SNONLIN_XNU, SNONLIN_SIG_TH ) + CALL IMPLSCH_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(WAVNUM), c_loc(CGROUP), c_loc(CIWA), c_loc(CINV), c_loc(XK2CG), & + & c_loc(STOKFAC), c_loc(EMAXDPT), c_loc(INDEP), c_loc(DEPTH), c_loc(IOBND), c_loc(IODP), c_loc(AIRD), c_loc(WDWAVE), & + & c_loc(CICOVER), c_loc(WSWAVE), c_loc(WSTAR), c_loc(UFRIC), c_loc(TAUW), c_loc(TAUWDIR), c_loc(Z0M), c_loc(Z0B), & + & c_loc(CHRNCK), c_loc(CITHICK), c_loc(NEMOUSTOKES), c_loc(NEMOVSTOKES), c_loc(NEMOSTRN), c_loc(NPHIEPS), c_loc(NTAUOC), & + & c_loc(NSWH), c_loc(NMWP), c_loc(NEMOTAUX), c_loc(NEMOTAUY), c_loc(NEMOWSWAVE), c_loc(NEMOPHIF), c_loc(WSEMEAN), & + & c_loc(WSFMEAN), c_loc(USTOKES), c_loc(VSTOKES), c_loc(STRNMS), c_loc(TAUXD), c_loc(TAUYD), c_loc(TAUOCXD), c_loc(TAUOCYD), & + & c_loc(TAUOC), c_loc(PHIOCD), c_loc(PHIEPS), c_loc(PHIAW), c_loc(MIJ), c_loc(XLLWS), ABMAX, ABMIN, ACD, ACDLIN, & + & c_loc(AF11), AFCRV, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BATHYMAX, BCD, BCDLIN, & + & BETAMAXOXKAPPA2, BFCRV, BMAXOKAP, c_loc(C2OSQRTVG_GC), CDICWA, CDIS, CDISVIS, CDMAX, CHNKMIN_U, CIBLOCK, CITHRSH, & + & CITHRSH_TAIL, c_loc(CM_GC), c_loc(COFRM4), c_loc(COSTH), c_loc(CUMULW), DAL1, DAL2, c_loc(DELKCC_GC_NS), & + & c_loc(DELKCC_OMXKM3_GC), DELTA_SDIS, DELTH, c_loc(DFIM), c_loc(DFIMFR), c_loc(DFIMFR2), c_loc(DFIMOFR), c_loc(DFIM_SIM), & + & DKMAX, DTHRN_A, DTHRN_U, EGRCRV, EPS1, EPSMIN, EPSU10, EPSUS, c_loc(FKLAM), c_loc(FKLAM1), c_loc(FKLAP), c_loc(FKLAP1), & + & c_loc(FLMAX), FLMIN, FLOGSPRDM1, c_loc(FR), c_loc(FR5), FRATIO, FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, & + & IDAMPING, IDELT, c_loc(IKM), c_loc(IKM1), c_loc(IKP), c_loc(IKP1), c_loc(INDICESSAT), c_loc(INLCOEF), IPHYS, IPSAT, & + & ISNONLIN, JTOT_TAUHF, c_loc(K11W), c_loc(K1W), c_loc(K21W), c_loc(K2W), KFRH, LBIWBK, LCIWABR, LICERUN, LLCAPCHNK, & + & LLGCBZ0, LLNORMAGAM, LLUNSTR, LMASKICE, LWAMRSETCI, LWCOU, LWFLUX, LWFLUXOUT, LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, & + & LWNEMOCOUSTRN, LWNEMOTAUOC, LWVFLX_SNL, MFRSTLW, MICHE, MLSTHG, NANG, NDEPTH, NDIKCUMUL, NFRE, NFRE_ODD, NFRE_RED, & + & NSDSNTH, NWAV_GC, c_loc(OM3GMKM_GC), c_loc(OMEGA_GC), c_loc(OMXKM3_GC), PHIEPSMAX, PHIEPSMIN, c_loc(RHOWG_DFIM), RN1_RN, & + & c_loc(RNLCOEF), RNU, RNUM, ROWATER, ROWATERM1, c_loc(SATWEIGHTS), SDSBR, c_loc(SINTH), SQRTGOSURFT, SSDSC2, SSDSC3, & + & SSDSC4, SSDSC5, SSDSC6, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, c_loc(SWELLFT), & + & TAILFACTOR, TAILFACTOR_PM, TAUOCMAX, TAUOCMIN, TAUWSHELTER, c_loc(TH), WETAIL, WP1TAIL, WP2TAIL, WSEMEAN_MIN, WSPMIN, & + & c_loc(WTAUHF), X0TAUHF, XKAPPA, XKDMIN, c_loc(XKMSQRTVGOC2_GC), c_loc(XKM_GC), c_loc(XK_GC), XLOGKRATIOM1_GC, XNLEV, & + & Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, c_loc(ZPIFR), ICHNK_start, ICHNK_end, ICHNK_step, NCHNK, NPROMA_WAM, & + & c_loc(RAORW), c_loc(EMEAN), c_loc(FMEAN), c_loc(HALP), c_loc(EMEANWS), c_loc(FMEANWS), c_loc(F1MEAN), c_loc(AKMEAN), & + & c_loc(XKMEAN), c_loc(PHIWA), c_loc(FLM), c_loc(COSWDIF), c_loc(SINWDIF2), c_loc(RHOWGDFTH), c_loc(FLD), c_loc(SL), & + & c_loc(SPOS), c_loc(CIREDUC), c_loc(SSOURCE), c_loc(SINFLX_RNFAC), c_loc(SINFLX_TMP_EM), c_loc(STRESSO_XSTRESS), & + & c_loc(STRESSO_YSTRESS), c_loc(STRESSO_TAUHF), c_loc(STRESSO_PHIHF), c_loc(STRESSO_USDIRP), c_loc(STRESSO_UST), & + & c_loc(SNONLIN_ENH), c_loc(SNONLIN_XNU), c_loc(SNONLIN_SIG_TH)) +!$acc end host_data + END SUBROUTINE IMPLSCH_fc +END MODULE IMPLSCH_FC_MOD diff --git a/src/phys-scc-cuda/implsch_fc.intfb.h b/src/phys-scc-cuda/implsch_fc.intfb.h new file mode 100644 index 00000000..72f55301 --- /dev/null +++ b/src/phys-scc-cuda/implsch_fc.intfb.h @@ -0,0 +1,484 @@ +INTERFACE + SUBROUTINE IMPLSCH_FC (KIJS, KIJL, FL1, WAVNUM, CGROUP, CIWA, CINV, XK2CG, STOKFAC, EMAXDPT, INDEP, DEPTH, IOBND, IODP, AIRD, & + & WDWAVE, CICOVER, WSWAVE, WSTAR, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, CITHICK, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, & + & NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, WSEMEAN, WSFMEAN, USTOKES, VSTOKES, STRNMS, TAUXD, & + & TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, MIJ, XLLWS, ABMAX, ABMIN, ACD, ACDLIN, AF11, AFCRV, ALPHA, ALPHAMAX, & + & ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BATHYMAX, BCD, BCDLIN, BETAMAXOXKAPPA2, BFCRV, BMAXOKAP, C2OSQRTVG_GC, & + & CDICWA, CDIS, CDISVIS, CDMAX, CHNKMIN_U, CIBLOCK, CITHRSH, CITHRSH_TAIL, CM_GC, COFRM4, COSTH, CUMULW, DAL1, DAL2, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, DELTA_SDIS, DELTH, DFIM, DFIMFR, DFIMFR2, DFIMOFR, DFIM_SIM, DKMAX, DTHRN_A, DTHRN_U, & + & EGRCRV, EPS1, EPSMIN, EPSU10, EPSUS, FKLAM, FKLAM1, FKLAP, FKLAP1, FLMAX, FLMIN, FLOGSPRDM1, FR, FR5, FRATIO, FRIC, FRTAIL, & + & G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IDELT, IKM, IKM1, IKP, IKP1, INDICESSAT, INLCOEF, IPHYS, IPSAT, & + & ISNONLIN, JTOT_TAUHF, K11W, K1W, K21W, K2W, KFRH, LBIWBK, LCIWABR, LICERUN, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LLUNSTR, & + & LMASKICE, LWAMRSETCI, LWCOU, LWFLUX, LWFLUXOUT, LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, LWNEMOTAUOC, & + & LWVFLX_SNL, MFRSTLW, MICHE, MLSTHG, NANG, NDEPTH, NDIKCUMUL, NFRE, NFRE_ODD, NFRE_RED, NSDSNTH, NWAV_GC, OM3GMKM_GC, & + & OMEGA_GC, OMXKM3_GC, PHIEPSMAX, PHIEPSMIN, RHOWG_DFIM, RN1_RN, RNLCOEF, RNU, RNUM, ROWATER, ROWATERM1, SATWEIGHTS, SDSBR, & + & SINTH, SQRTGOSURFT, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, & + & SWELLF7M1, SWELLFT, TAILFACTOR, TAILFACTOR_PM, TAUOCMAX, TAUOCMIN, TAUWSHELTER, TH, WETAIL, WP1TAIL, WP2TAIL, WSEMEAN_MIN, & + & WSPMIN, WTAUHF, X0TAUHF, XKAPPA, XKDMIN, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, & + & ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK_start, ICHNK_end, ICHNK_step, NCHNK, NPROMA_WAM, RAORW, EMEAN, FMEAN, HALP, EMEANWS, FMEANWS, & + & F1MEAN, AKMEAN, XKMEAN, PHIWA, FLM, COSWDIF, SINWDIF2, RHOWGDFTH, FLD, SL, SPOS, CIREDUC, SSOURCE, SINFLX_RNFAC, & + & SINFLX_TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST, SNONLIN_ENH, & + & SNONLIN_XNU, SNONLIN_SIG_TH) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRO, JWRB + USE YOWDRVTYPE, ONLY: WAVE2OCEAN, ENVIRONMENT, FREQUENCY, FORCING_FIELDS, INTGT_PARAM_FIELDS + + + + IMPLICIT NONE + INTERFACE + SUBROUTINE CIWABR_FC (KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIWAB) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, CGROUP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: CIWAB + END SUBROUTINE CIWABR_FC + END INTERFACE + INTERFACE + SUBROUTINE FEMEANWS_FC (KIJS, KIJL, FL1, XLLWS, FM, EM) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, XLLWS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FM + REAL(KIND=JWRB), OPTIONAL, INTENT(OUT), DIMENSION(KIJL) :: EM + END SUBROUTINE FEMEANWS_FC + END INTERFACE + INTERFACE + SUBROUTINE FKMEAN_FC (KIJS, KIJL, FL1, WAVNUM, EM, FM1, F1, AK, XK) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: EM, FM1, F1, AK, XK + END SUBROUTINE FKMEAN_FC + END INTERFACE + INTERFACE + SUBROUTINE SBOTTOM_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + END SUBROUTINE SBOTTOM_FC + END INTERFACE + INTERFACE + SUBROUTINE IMPHFTAIL_FC (KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: MIJ + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: FLM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + END SUBROUTINE IMPHFTAIL_FC + END INTERFACE + INTERFACE + SUBROUTINE SDEPTHLIM_FC (KIJS, KIJL, EMAXDPT, FL1) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMAXDPT + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + END SUBROUTINE SDEPTHLIM_FC + END INTERFACE + INTERFACE + SUBROUTINE SDISSIP_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, RAORW) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: INDEP + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMEAN, F1MEAN, XKMEAN + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SDISSIP_FC + END INTERFACE + INTERFACE + SUBROUTINE SDIWBK_FC (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH, EMAXDPT, EMEAN, F1MEAN + END SUBROUTINE SDIWBK_FC + END INTERFACE + INTERFACE + SUBROUTINE SETICE_FC (KIJS, KIJL, FL1, CICOVER, COSWDIF) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SETICE_FC + END INTERFACE + INTERFACE + SUBROUTINE SINFLX_FC (ICALL, KIJS, KIJL, LUPDTUS, FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, WSTAR, CICOVER, & + & COSWDIF, SINWDIF2, FMEAN, HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, MIJ, & + & RHOWGDFTH, XLLWS) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: ICALL + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + LOGICAL, INTENT(IN) :: LUPDTUS + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: XK2CG + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: WSWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: AIRD + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSTAR + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: SINWDIF2 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: FMEAN + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: HALP + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FMEANWS + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: FLM + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: UFRIC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUW + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUWDIR + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: Z0M + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: Z0B + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: CHRNCK + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: PHIWA + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: FLD + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: SL + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: SPOS + INTEGER(KIND=JWIM), INTENT(OUT) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: XLLWS + END SUBROUTINE SINFLX_FC + END INTERFACE + INTERFACE + SUBROUTINE SNONLIN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH, AKMEAN + END SUBROUTINE SNONLIN_FC + END INTERFACE + INTERFACE + SUBROUTINE STOKESTRN_FC (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, VSTOKES, & + & STRNMS, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN) + USE parkind_wave, ONLY: jwim, jwrb, jwro + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, STOKFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSWAVE, WDWAVE, CICOVER, CITHICK + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: USTOKES, VSTOKES, STRNMS + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN + END SUBROUTINE STOKESTRN_FC + END INTERFACE + INTERFACE + SUBROUTINE WNFLUXES_FC (KIJS, KIJL, MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, UFRIC, AIRD, & + & NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, & + & PHIEPS, PHIAW, LNUPD) + USE parkind_wave, ONLY: jwim, jwrb, jwro + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: MIJ + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: SSURF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CICOVER + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: PHIWA + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EM, F1, WSWAVE, WDWAVE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, AIRD + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: PHIOCD, PHIEPS, PHIAW + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX + REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOTAUY, NEMOWSWAVE, NEMOPHIF + LOGICAL, INTENT(IN) :: LNUPD + END SUBROUTINE WNFLUXES_FC + END INTERFACE + ! ---------------------------------------------------------------------- + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CGROUP(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CIWA(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IODP(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IOBND(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CHRNCK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSEMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSFMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: VSTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRNMS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIOCD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIEPS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIAW(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOUSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOVSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOSTRN(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NPHIEPS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NTAUOC(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NSWH(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NMWP(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUX(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUY(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOWSWAVE(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOPHIF(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + + + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RAORW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: EMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: HALP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: EMEANWS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FMEANWS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: F1MEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: AKMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XKMEAN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIWA(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: COSWDIF(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINWDIF2(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RHOWGDFTH(:, :, :) + ! *FLD* DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* TOTAL SOURCE FUNCTION ARRAY. + ! *SPOS* : POSITIVE SINPUT ONLY + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SPOS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CIREDUC(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SSOURCE(:, :, :, :) + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AF11(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: AFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDICWA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CIBLOCK + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COFRM4(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DKMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EGRCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSU10 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLMAX(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_CPL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDELT + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INLCOEF(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ISNONLIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K11W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K1W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K21W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K2W(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KFRH + LOGICAL, VALUE, INTENT(IN) :: LBIWBK + LOGICAL, VALUE, INTENT(IN) :: LCIWABR + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + LOGICAL, VALUE, INTENT(IN) :: LLUNSTR + LOGICAL, VALUE, INTENT(IN) :: LMASKICE + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWCOU + LOGICAL, VALUE, INTENT(IN) :: LWFLUX + LOGICAL, VALUE, INTENT(IN) :: LWFLUXOUT + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSEND + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTK + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTRN + LOGICAL, VALUE, INTENT(IN) :: LWNEMOTAUOC + LOGICAL, VALUE, INTENT(IN) :: LWVFLX_SNL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MFRSTLW + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MLSTHG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNLCOEF(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATERM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSEMEAN_MIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKDMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_start + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_end + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK_step + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER, VALUE, INTENT(IN) :: NPROMA_WAM + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINFLX_RNFAC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SINFLX_TMP_EM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_UST(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_ENH(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_XNU(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SNONLIN_SIG_TH(:, :) + END SUBROUTINE IMPLSCH_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/ns_gc.c_hoist.F90 b/src/phys-scc-cuda/ns_gc.c_hoist.F90 new file mode 100644 index 00000000..0aba4c25 --- /dev/null +++ b/src/phys-scc-cuda/ns_gc.c_hoist.F90 @@ -0,0 +1,54 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) FUNCTION NS_GC_FC (USTAR, NWAV_GC, SQRTGOSURFT, XKM_GC, XLOGKRATIOM1_GC) + + ! ---------------------------------------------------------------------- + + !**** *NS_GC* - FUNCTION TO DETERMINE THE CUT-OFF ANGULAR FREQUENCY INDEX + ! FOR THE GRAVITY-CAPILLARY MODEL + ! !!!! rounded to the closest index of XK_GC !!!!! + + !** INTERFACE. + ! ---------- + + ! *FUNCTION* *NS_GC (USTAR)* + + ! *USTAR* - FRICTION VELOCITY. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER :: NS_GC_FC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + + REAL(KIND=JWRB) :: Y, XKS + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC +!$acc routine seq + + ! ---------------------------------------------------------------------- + + + !!!Y = 1.0_JWRB/(1.48_JWRB+2.05_JWRB*UST) + !!!Y = (1.0_JWRB + UST**2)/(1.0_JWRB+10.0_JWRB*UST**2) + + XKS = SQRTGOSURFT / (1.48_JWRB + 2.05_JWRB*USTAR) + + NS_GC_FC = MIN(INT(LOG(XKS*XKM_GC(1))*XLOGKRATIOM1_GC) + 1, NWAV_GC - 1) + + +END FUNCTION NS_GC_FC diff --git a/src/phys-scc-cuda/ns_gc_c.c b/src/phys-scc-cuda/ns_gc_c.c new file mode 100644 index 00000000..8c41f5d0 --- /dev/null +++ b/src/phys-scc-cuda/ns_gc_c.c @@ -0,0 +1,23 @@ +#include +#include +#include +#include +#include +#include +#include "ns_gc_c.h" + +__device__ int ns_gc_c(double ustar, int nwav_gc, double sqrtgosurft, + const double * xkm_gc, double xlogkratiom1_gc) { + + + int ns_gc; + + double y, xks; + // + xks = sqrtgosurft / ((double) 1.48 + (double) 2.05*ustar); + + ns_gc = min((double) ((int) (log(xks*xkm_gc[1 - 1])*xlogkratiom1_gc) + 1), (double) + (nwav_gc - 1)); + + return ns_gc; +} diff --git a/src/phys-scc-cuda/ns_gc_c.h b/src/phys-scc-cuda/ns_gc_c.h new file mode 100644 index 00000000..98e370e4 --- /dev/null +++ b/src/phys-scc-cuda/ns_gc_c.h @@ -0,0 +1,10 @@ +#include +#include +#include +#include +#include +#include + + +__device__ int ns_gc_c(double ustar, int nwav_gc, double sqrtgosurft, + const double * xkm_gc, double xlogkratiom1_gc); diff --git a/src/phys-scc-cuda/ns_gc_fc.F90 b/src/phys-scc-cuda/ns_gc_fc.F90 new file mode 100644 index 00000000..2d42a5f4 --- /dev/null +++ b/src/phys-scc-cuda/ns_gc_fc.F90 @@ -0,0 +1,35 @@ +MODULE NS_GC_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE NS_GC_fc (USTAR, NWAV_GC, SQRTGOSURFT, XKM_GC, XLOGKRATIOM1_GC) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: USTAR + + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC +!$acc routine seq + INTERFACE + SUBROUTINE NS_GC_iso_c (USTAR, NWAV_GC, SQRTGOSURFT, XKM_GC, XLOGKRATIOM1_GC) BIND(c, name="ns_gc_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + REAL, VALUE :: USTAR + INTEGER(KIND=c_int), VALUE :: NWAV_GC + REAL, VALUE :: SQRTGOSURFT + TYPE(c_ptr), VALUE :: XKM_GC + REAL, VALUE :: XLOGKRATIOM1_GC + END SUBROUTINE NS_GC_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) +!$acc host_data use_device( XKM_GC ) + CALL NS_GC_iso_c(USTAR, NWAV_GC, SQRTGOSURFT, c_loc(XKM_GC), XLOGKRATIOM1_GC) +!$acc end host_data + END SUBROUTINE NS_GC_fc +END MODULE NS_GC_FC_MOD diff --git a/src/phys-scc-cuda/ns_gc_fc.intfb.h b/src/phys-scc-cuda/ns_gc_fc.intfb.h new file mode 100644 index 00000000..e458f4d9 --- /dev/null +++ b/src/phys-scc-cuda/ns_gc_fc.intfb.h @@ -0,0 +1,18 @@ +INTERFACE + SUBROUTINE NS_GC_FC (USTAR, NWAV_GC, SQRTGOSURFT, XKM_GC, XLOGKRATIOM1_GC) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: USTAR + + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC +!$acc routine seq + END SUBROUTINE NS_GC_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/omegagc_c.c b/src/phys-scc-cuda/omegagc_c.c new file mode 100644 index 00000000..204ab776 --- /dev/null +++ b/src/phys-scc-cuda/omegagc_c.c @@ -0,0 +1,24 @@ +#include +#include +#include +#include +#include +#include +#include "omegagc_c.h" +#include "ns_gc_c.h" + +__device__ void omegagc_c(double ust, int *ns, double *xks, double *oms, int nwav_gc, + const double * omega_gc, double sqrtgosurft, const double * xkm_gc, + const double * xk_gc, double xlogkratiom1_gc) { + + + + + // + + (*ns) = ns_gc_c(ust, nwav_gc, sqrtgosurft, xkm_gc, xlogkratiom1_gc); + (*xks) = xk_gc[ (*ns) - 1]; + (*oms) = omega_gc[ (*ns) - 1]; + + +} diff --git a/src/phys-scc-cuda/omegagc_c.h b/src/phys-scc-cuda/omegagc_c.h new file mode 100644 index 00000000..bf8a0944 --- /dev/null +++ b/src/phys-scc-cuda/omegagc_c.h @@ -0,0 +1,11 @@ +#include +#include +#include +#include +#include +#include +#include "ns_gc_c.h" + +__device__ void omegagc_c(double ust, int *ns, double *xks, double *oms, int nwav_gc, + const double * omega_gc, double sqrtgosurft, const double * xkm_gc, + const double * xk_gc, double xlogkratiom1_gc); diff --git a/src/phys-scc-cuda/omegagc_fc.F90 b/src/phys-scc-cuda/omegagc_fc.F90 new file mode 100644 index 00000000..95127e1a --- /dev/null +++ b/src/phys-scc-cuda/omegagc_fc.F90 @@ -0,0 +1,53 @@ +MODULE OMEGAGC_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE OMEGAGC_fc (UST, NS, XKS, OMS, NWAV_GC, OMEGA_GC, SQRTGOSURFT, XKM_GC, XK_GC, XLOGKRATIOM1_GC) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION NS_GC (USTAR) + USE parkind_wave, ONLY: jwrb + INTEGER :: NS_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + END FUNCTION NS_GC + END INTERFACE + REAL(KIND=JWRB), INTENT(IN) :: UST + INTEGER(KIND=JWIM), INTENT(OUT) :: NS ! index in array XK_GC corresponding to XKS and OMS + REAL(KIND=JWRB), INTENT(OUT) :: XKS ! cut-off wave number + REAL(KIND=JWRB), INTENT(OUT) :: OMS ! cut-off angular frequency + + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC +!$acc routine seq + INTERFACE + SUBROUTINE OMEGAGC_iso_c (UST, NS, XKS, OMS, NWAV_GC, OMEGA_GC, SQRTGOSURFT, XKM_GC, XK_GC, XLOGKRATIOM1_GC) & + & BIND(c, name="omegagc_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + REAL, VALUE :: UST + INTEGER(KIND=c_int) :: NS + REAL :: XKS + REAL :: OMS + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OMEGA_GC + REAL, VALUE :: SQRTGOSURFT + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + END SUBROUTINE OMEGAGC_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) +!$acc host_data use_device( OMEGA_GC, XKM_GC, XK_GC ) + CALL OMEGAGC_iso_c(UST, NS, XKS, OMS, NWAV_GC, c_loc(OMEGA_GC), SQRTGOSURFT, c_loc(XKM_GC), c_loc(XK_GC), XLOGKRATIOM1_GC) +!$acc end host_data + END SUBROUTINE OMEGAGC_fc +END MODULE OMEGAGC_FC_MOD diff --git a/src/phys-scc-cuda/peak_ang.c_hoist.F90 b/src/phys-scc-cuda/peak_ang.c_hoist.F90 new file mode 100644 index 00000000..b15dd62b --- /dev/null +++ b/src/phys-scc-cuda/peak_ang.c_hoist.F90 @@ -0,0 +1,180 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE PEAK_ANG_FC (KIJS, KIJL, FL1, XNU, SIG_TH, COSTH, DELTH, DFIM, DFIMFR, DFIMFR2, FR, FRATIO, NANG, & +& NFRE, SINTH, TH, WETAIL, WP1TAIL, WP2TAIL, ICHNK, NCHNK, IJ) + + !*** *PEAK_ANG* DETERMINES ANGULAR WIDTH NEAR PEAK OF SPECTRUM + + ! PETER JANSSEN + + ! PURPOSE. + ! -------- + + ! DETERMINATION OF PEAK PARAMETERS + + ! INTERFACE. + ! ---------- + ! *CALL* *PEAK_ANG(KIJS,KIJL,FL1,XNU,SIG_TH)* + + ! INPUT: + ! *KIJS* - FIRST GRIDPOINT + ! *KIJL* - LAST GRIDPOINT + ! *FL1* - SPECTRUM + ! OUTPUT: + ! *XNU* - RELATIVE SPECTRAL WIDTH + ! *SIG_TH* - RELATIVE WIDTH IN DIRECTION + + ! METHOD. + ! ------- + ! NONE + + ! EXTERNALS. + ! ---------- + ! NONE + + !----------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: DFIMOFR + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XNU(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SIG_TH(:) + + + INTEGER(KIND=JWIM) :: NSH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: MMAX + INTEGER(KIND=JWIM) :: MMSTART + INTEGER(KIND=JWIM) :: MMSTOP + REAL(KIND=JWRB), PARAMETER :: CONST_SIG = 1.0_JWRB + REAL(KIND=JWRB) :: R1 + REAL(KIND=JWRB) :: DELT25 + REAL(KIND=JWRB) :: COEF_FR + REAL(KIND=JWRB) :: COEF_FR2 + REAL(KIND=JWRB) :: ZEPSILON + REAL(KIND=JWRB) :: SUM0 + REAL(KIND=JWRB) :: SUM1 + REAL(KIND=JWRB) :: SUM2 + REAL(KIND=JWRB) :: XMAX + REAL(KIND=JWRB) :: TEMP + REAL(KIND=JWRB) :: THMEAN + REAL(KIND=JWRB) :: SUM_S + REAL(KIND=JWRB) :: SUM_C + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + !*** 1. DETERMINE L-H SPECTRAL WIDTH OF THE 2-D SPECTRUM. + ! --------------------------------------------------- + + ZEPSILON = 10._JWRB*EPSILON(ZEPSILON) + NSH = 1 + INT(LOG(1.5_JWRB) / LOG(FRATIO)) + + + SUM0 = ZEPSILON + SUM1 = 0._JWRB + SUM2 = 0._JWRB + + DO M=1,NFRE + K = 1 + TEMP = FL1(IJ, K, M, ICHNK) + DO K=2,NANG + TEMP = TEMP + FL1(IJ, K, M, ICHNK) + END DO + SUM0 = SUM0 + TEMP*DFIM(M) + SUM1 = SUM1 + TEMP*DFIMFR(M) + SUM2 = SUM2 + TEMP*DFIMFR2(M) + END DO + + ! ADD TAIL CORRECTIONS + DELT25 = WETAIL*FR(NFRE)*DELTH + COEF_FR = WP1TAIL*DELTH*FR(NFRE)**2 + COEF_FR2 = WP2TAIL*DELTH*FR(NFRE)**3 + SUM0 = SUM0 + DELT25*TEMP + SUM1 = SUM1 + COEF_FR*TEMP + SUM2 = SUM2 + COEF_FR2*TEMP + + IF (SUM0 > ZEPSILON) THEN + XNU(IJ) = SQRT(MAX(ZEPSILON, SUM2*SUM0 / SUM1**2 - 1._JWRB)) + ELSE + XNU(IJ) = ZEPSILON + END IF + + !*** 2. DETERMINE ANGULAR WIDTH OF THE 2-D SPECTRUM. + ! ---------------------------------------------- + + ! MAX OF 2-D SPECTRUM + XMAX = 0._JWRB + MMAX = 2 + + DO M=2,NFRE - 1 + DO K=1,NANG + IF (FL1(IJ, K, M, ICHNK) > XMAX) THEN + MMAX = M + XMAX = FL1(IJ, K, M, ICHNK) + END IF + END DO + END DO + + SUM1 = ZEPSILON + SUM2 = 0._JWRB + + MMSTART = MAX(1, MMAX - NSH) + MMSTOP = MIN(NFRE, MMAX + NSH) + DO M=MMSTART,MMSTOP + SUM_S = 0._JWRB + SUM_C = ZEPSILON + DO K=1,NANG + SUM_S = SUM_S + SINTH(K)*FL1(IJ, K, M, ICHNK) + SUM_C = SUM_C + COSTH(K)*FL1(IJ, K, M, ICHNK) + END DO + THMEAN = ATAN2(SUM_S, SUM_C) + DO K=1,NANG + SUM1 = SUM1 + FL1(IJ, K, M, ICHNK)*DFIM(M) + SUM2 = SUM2 + COS(TH(K) - THMEAN)*FL1(IJ, K, M, ICHNK)*DFIM(M) + END DO + END DO + + IF (SUM1 > ZEPSILON) THEN + R1 = SUM2 / SUM1 + SIG_TH(IJ) = CONST_SIG*SQRT(2._JWRB*(1._JWRB - R1)) + ELSE + SIG_TH(IJ) = 0._JWRB + END IF + + + +END SUBROUTINE PEAK_ANG_FC diff --git a/src/phys-scc-cuda/peak_ang_c.c b/src/phys-scc-cuda/peak_ang_c.c new file mode 100644 index 00000000..4ea15826 --- /dev/null +++ b/src/phys-scc-cuda/peak_ang_c.c @@ -0,0 +1,118 @@ +#include +#include +#include +#include +#include +#include +#include "peak_ang_c.h" + +__device__ void peak_ang_c(int kijs, int kijl, const double * fl1, double * xnu, + double * sig_th, const double * costh, double delth, const double * dfim, + const double * dfimfr, const double * dfimfr2, const double * fr, double fratio, + int nang, int nfre, const double * sinth, const double * th, double wetail, + double wp1tail, double wp2tail, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int nsh; + int m; + int k; + int mmax; + int mmstart; + int mmstop; + double const_sig = (double) 1.0; + double r1; + double delt25; + double coef_fr; + double coef_fr2; + double zepsilon; + double sum0; + double sum1; + double sum2; + double xmax; + double temp; + double thmean; + double sum_s; + double sum_c; + zepsilon = (double) 10.* DBL_EPSILON; // epsilon(zepsilon); + nsh = 1 + (int) (log((double) 1.5) / log(fratio)); + + + sum0 = zepsilon; + sum1 = (double) 0.; + sum2 = (double) 0.; + + for (m = 1; m <= nfre; m += 1) { + k = 1; + temp = + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + for (k = 2; k <= nang; k += 1) { + temp = temp + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + sum0 = sum0 + temp*dfim[m - 1]; + sum1 = sum1 + temp*dfimfr[m - 1]; + sum2 = sum2 + temp*dfimfr2[m - 1]; + } + delt25 = wetail*fr[nfre - 1]*delth; + coef_fr = wp1tail*delth*(pow(fr[nfre - 1], 2)); + coef_fr2 = wp2tail*delth*(pow(fr[nfre - 1], 3)); + sum0 = sum0 + delt25*temp; + sum1 = sum1 + coef_fr*temp; + sum2 = sum2 + coef_fr2*temp; + + if (sum0 > zepsilon) { + xnu[ij - 1] = sqrt((double) (max((double) (zepsilon), (double) (sum2*sum0 / + (pow(sum1, 2)) - (double) 1.)))); + } else { + xnu[ij - 1] = zepsilon; + } + xmax = (double) 0.; + mmax = 2; + + for (m = 2; m <= nfre - 1; m += 1) { + for (k = 1; k <= nang; k += 1) { + if (fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1) + ))] > xmax) { + mmax = m; + xmax = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))]; + } + } + } + + sum1 = zepsilon; + sum2 = (double) 0.; + + mmstart = max((double) (1), (double) (mmax - nsh)); + mmstop = min((double) (nfre), (double) (mmax + nsh)); + for (m = mmstart; m <= mmstop; m += 1) { + sum_s = (double) 0.; + sum_c = zepsilon; + for (k = 1; k <= nang; k += 1) { + sum_s = sum_s + sinth[k - 1]*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + sum_c = sum_c + costh[k - 1]*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + thmean = atan2(sum_s, sum_c); + for (k = 1; k <= nang; k += 1) { + sum1 = sum1 + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]*dfim[m - 1]; + sum2 = sum2 + cos(th[k - 1] - thmean)*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m + - 1 + nfre_loki_param*(ichnk - 1)))]*dfim[m - 1]; + } + } + + if (sum1 > zepsilon) { + r1 = sum2 / sum1; + sig_th[ij - 1] = const_sig*sqrt((double) ((double) 2.*((double) 1. - r1))); + } else { + sig_th[ij - 1] = (double) 0.; + } + + + +} diff --git a/src/phys-scc-cuda/peak_ang_c.h b/src/phys-scc-cuda/peak_ang_c.h new file mode 100644 index 00000000..49df41aa --- /dev/null +++ b/src/phys-scc-cuda/peak_ang_c.h @@ -0,0 +1,13 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void peak_ang_c(int kijs, int kijl, const double * fl1, double * xnu, + double * sig_th, const double * costh, double delth, const double * dfim, + const double * dfimfr, const double * dfimfr2, const double * fr, double fratio, + int nang, int nfre, const double * sinth, const double * th, double wetail, + double wp1tail, double wp2tail, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/peak_ang_fc.F90 b/src/phys-scc-cuda/peak_ang_fc.F90 new file mode 100644 index 00000000..a957f36b --- /dev/null +++ b/src/phys-scc-cuda/peak_ang_fc.F90 @@ -0,0 +1,72 @@ +MODULE PEAK_ANG_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE PEAK_ANG_fc (KIJS, KIJL, FL1, XNU, SIG_TH, COSTH, DELTH, DFIM, DFIMFR, DFIMFR2, FR, FRATIO, NANG, NFRE, SINTH, TH, & + & WETAIL, WP1TAIL, WP2TAIL, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE PEAK_ANG_iso_c (KIJS, KIJL, FL1, XNU, SIG_TH, COSTH, DELTH, DFIM, DFIMFR, DFIMFR2, FR, FRATIO, NANG, NFRE, & + & SINTH, TH, WETAIL, WP1TAIL, WP2TAIL, ICHNK, NCHNK, IJ) BIND(c, name="peak_ang_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: XNU + TYPE(c_ptr), VALUE :: SIG_TH + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIMFR + TYPE(c_ptr), VALUE :: DFIMFR2 + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: FRATIO + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + TYPE(c_ptr), VALUE :: SINTH + TYPE(c_ptr), VALUE :: TH + REAL, VALUE :: WETAIL + REAL, VALUE :: WP1TAIL + REAL, VALUE :: WP2TAIL + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE PEAK_ANG_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XNU(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SIG_TH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) +!$acc host_data use_device( FL1, XNU, SIG_TH, COSTH, DFIM, DFIMFR, DFIMFR2, FR, SINTH, TH ) + CALL PEAK_ANG_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(XNU), c_loc(SIG_TH), c_loc(COSTH), DELTH, c_loc(DFIM), c_loc(DFIMFR), & + & c_loc(DFIMFR2), c_loc(FR), FRATIO, NANG, NFRE, c_loc(SINTH), c_loc(TH), WETAIL, WP1TAIL, WP2TAIL, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE PEAK_ANG_fc +END MODULE PEAK_ANG_FC_MOD diff --git a/src/phys-scc-cuda/peak_ang_fc.intfb.h b/src/phys-scc-cuda/peak_ang_fc.intfb.h new file mode 100644 index 00000000..ecfa3212 --- /dev/null +++ b/src/phys-scc-cuda/peak_ang_fc.intfb.h @@ -0,0 +1,37 @@ +INTERFACE + SUBROUTINE PEAK_ANG_FC (KIJS, KIJL, FL1, XNU, SIG_TH, COSTH, DELTH, DFIM, DFIMFR, DFIMFR2, FR, FRATIO, NANG, NFRE, SINTH, TH, & + & WETAIL, WP1TAIL, WP2TAIL, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: DFIMOFR + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XNU(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SIG_TH(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE PEAK_ANG_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sbottom.c_hoist.F90 b/src/phys-scc-cuda/sbottom.c_hoist.F90 new file mode 100644 index 00000000..633a9d2e --- /dev/null +++ b/src/phys-scc-cuda/sbottom.c_hoist.F90 @@ -0,0 +1,106 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SBOTTOM_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, BATHYMAX, GM1, NANG, NFRE_RED, ICHNK, NCHNK, & +& IJ) + + !SHALLOW + ! ---------------------------------------------------------------------- + + !**** *SBOTTOM* - COMPUTATION OF BOTTOM FRICTION. + + ! G.J.KOMEN AND Q.D.GAO + ! OPTIMIZED BY L.F. ZAMBRESKY + ! J. BIDLOT ECMWF FEBRUARY 1997 ADD SL IN SUBROUTINE CALL + + !* PURPOSE. + ! -------- + + ! COMPUTATION OF BOTTOM FRICTION DISSIPATION + + !** INTERFACE. + ! ---------- + + ! *CALL* *SBOTTOM (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH) + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* - TOTAL SOURCE FUNCTION ARRAY + ! *WAVNUM* - WAVE NUMBER + ! *DEPTH* - WATER DEPTH + + ! METHOD. + ! ------- + + ! SEE REFERENCES. + + ! REFERENCES. + ! ----------- + + ! HASSELMANN ET AL, D. HYDR. Z SUPPL A12(1973) (JONSWAP) + ! BOUWS AND KOMEN, JPO 13(1983)1653-1658 + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + REAL(KIND=JWRB) :: CONST + REAL(KIND=JWRB) :: ARG + REAL(KIND=JWRB) :: SBO + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + CONST = -2.0_JWRB*0.038_JWRB*GM1 + + DO M=1,NFRE_RED + IF (DEPTH(IJ, ICHNK) < BATHYMAX) THEN + ARG = 2.0_JWRB*DEPTH(IJ, ICHNK)*WAVNUM(IJ, M, ICHNK) + ARG = MIN(ARG, 50.0_JWRB) + SBO = CONST*WAVNUM(IJ, M, ICHNK) / SINH(ARG) + ELSE + SBO = 0.0_JWRB + END IF + + DO K=1,NANG + SL(IJ, K, M) = SL(IJ, K, M) + SBO*FL1(IJ, K, M, ICHNK) + FLD(IJ, K, M) = FLD(IJ, K, M) + SBO + END DO + END DO + + + +END SUBROUTINE SBOTTOM_FC diff --git a/src/phys-scc-cuda/sbottom_c.c b/src/phys-scc-cuda/sbottom_c.c new file mode 100644 index 00000000..c239093e --- /dev/null +++ b/src/phys-scc-cuda/sbottom_c.c @@ -0,0 +1,48 @@ +#include +#include +#include +#include +#include +#include +#include "sbottom_c.h" + +__device__ void sbottom_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * wavnum, const double * depth, double bathymax, double gm1, + int nang, int nfre_red, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int k; + int m; + double const_var; + double arg; + double sbo; + + const_var = -(double) 2.0*(double) 0.038*gm1; + + for (m = 1; m <= nfre_red; m += 1) { + if (depth[ij - 1 + kijl*(ichnk - 1)] < bathymax) { + arg = (double) 2.0*depth[ij - 1 + kijl*(ichnk - 1)]*wavnum[ij - 1 + kijl*(m - 1 + + nfre_loki_param*(ichnk - 1))]; + arg = min((double) (arg), (double) ((double) 50.0)); + sbo = + const_var*wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))] / sinh(arg) + ; + } else { + sbo = (double) 0.0; + } + + for (k = 1; k <= nang; k += 1) { + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = sl[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1))] + sbo*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] + sbo; + } + } + + + +} diff --git a/src/phys-scc-cuda/sbottom_c.h b/src/phys-scc-cuda/sbottom_c.h new file mode 100644 index 00000000..a3b1f9d1 --- /dev/null +++ b/src/phys-scc-cuda/sbottom_c.h @@ -0,0 +1,11 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void sbottom_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * wavnum, const double * depth, double bathymax, double gm1, + int nang, int nfre_red, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/sbottom_fc.F90 b/src/phys-scc-cuda/sbottom_fc.F90 new file mode 100644 index 00000000..1cc34c75 --- /dev/null +++ b/src/phys-scc-cuda/sbottom_fc.F90 @@ -0,0 +1,56 @@ +MODULE SBOTTOM_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SBOTTOM_fc (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, BATHYMAX, GM1, NANG, NFRE_RED, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SBOTTOM_iso_c (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, BATHYMAX, GM1, NANG, NFRE_RED, ICHNK, NCHNK, IJ) & + & BIND(c, name="sbottom_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: DEPTH + REAL, VALUE :: BATHYMAX + REAL, VALUE :: GM1 + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE_RED + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SBOTTOM_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) +!$acc host_data use_device( FL1, FLD, SL, WAVNUM, DEPTH ) + CALL SBOTTOM_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(FLD), c_loc(SL), c_loc(WAVNUM), c_loc(DEPTH), BATHYMAX, GM1, NANG, & + & NFRE_RED, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SBOTTOM_fc +END MODULE SBOTTOM_FC_MOD diff --git a/src/phys-scc-cuda/sbottom_fc.intfb.h b/src/phys-scc-cuda/sbottom_fc.intfb.h new file mode 100644 index 00000000..630eb459 --- /dev/null +++ b/src/phys-scc-cuda/sbottom_fc.intfb.h @@ -0,0 +1,29 @@ +INTERFACE + SUBROUTINE SBOTTOM_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, BATHYMAX, GM1, NANG, NFRE_RED, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE SBOTTOM_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sdepthlim.c_hoist.F90 b/src/phys-scc-cuda/sdepthlim.c_hoist.F90 new file mode 100644 index 00000000..169c6a33 --- /dev/null +++ b/src/phys-scc-cuda/sdepthlim.c_hoist.F90 @@ -0,0 +1,101 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SDEPTHLIM_FC (KIJS, KIJL, EMAXDPT, FL1, DELTH, DFIM, EPSMIN, FR, NANG, NFRE, WETAIL, ICHNK, NCHNK, & +& IJ) + ! ---------------------------------------------------------------------- + ! J. BIDLOT ECMWF NOVEMBER 2017 + + !* PURPOSE. + ! -------- + ! LIMITS THE SPECTRAL VARIANCE SUCH THAT THE TOTAL VARIANCE + ! DOES NOT EXCEED THE MAXIMUM WAVE VARIANCE ALLOWED FOR A GIVEN DEPTH + + !** INTERFACE. + ! ---------- + ! *CALL* *SDEPTHLIM((KIJS, KIJL, EMAXDPT, FL1) + ! *KIJS* - LOCAL INDEX OF FIRST GRIDPOINT + ! *KIJL* - LOCAL INDEX OF LAST GRIDPOIN + ! *EMAXDPT - MAXIMUM WAVE VARIANCE ALLOWED FOR A GIVEN DEPTH + ! *FL1* - SPECTRUM. + + + ! METHOD. + ! ------- + + ! EXTERNALS. + ! ---------- + + ! REFERENCE. + ! ---------- + ! NONE + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + REAL(KIND=JWRB) :: DELT25 + REAL(KIND=JWRB) :: EM + REAL(KIND=JWRB) :: TEMP + LOGICAL :: LLEPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + + EM = EPSMIN + DO M=1,NFRE + K = 1 + TEMP = FL1(IJ, K, M, ICHNK) + DO K=2,NANG + TEMP = TEMP + FL1(IJ, K, M, ICHNK) + END DO + EM = EM + DFIM(M)*TEMP + END DO + ! ---------------------------------------------------------------------- + + !* 3. ADD TAIL ENERGY. + ! ---------------- + + DELT25 = WETAIL*FR(NFRE)*DELTH + EM = EM + DELT25*TEMP + + EM = MIN(EMAXDPT(IJ, ICHNK) / EM, 1.0_JWRB) + + DO M=1,NFRE + DO K=1,NANG + FL1(IJ, K, M, ICHNK) = MAX(FL1(IJ, K, M, ICHNK)*EM, EPSMIN) + END DO + END DO + + + +END SUBROUTINE SDEPTHLIM_FC diff --git a/src/phys-scc-cuda/sdepthlim_c.c b/src/phys-scc-cuda/sdepthlim_c.c new file mode 100644 index 00000000..d482ae8b --- /dev/null +++ b/src/phys-scc-cuda/sdepthlim_c.c @@ -0,0 +1,52 @@ +#include +#include +#include +#include +#include +#include +#include "sdepthlim_c.h" + +__device__ void sdepthlim_c(int kijs, int kijl, const double * emaxdpt, double * fl1, + double delth, const double * dfim, double epsmin, const double * fr, int nang, + int nfre, double wetail, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + int k; + int m; + double delt25; + double em; + double temp; + int llepsmin; + + + em = epsmin; + for (m = 1; m <= nfre; m += 1) { + k = 1; + temp = + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + for (k = 2; k <= nang; k += 1) { + temp = temp + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + em = em + dfim[m - 1]*temp; + } + delt25 = wetail*fr[nfre - 1]*delth; + em = em + delt25*temp; + + em = min((double) (emaxdpt[ij - 1 + kijl*(ichnk - 1)] / em), (double) ((double) 1.0)); + + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))] + = max((double) (fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]*em), (double) (epsmin)); + } + } + + + +} diff --git a/src/phys-scc-cuda/sdepthlim_c.h b/src/phys-scc-cuda/sdepthlim_c.h new file mode 100644 index 00000000..7441dc2a --- /dev/null +++ b/src/phys-scc-cuda/sdepthlim_c.h @@ -0,0 +1,11 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void sdepthlim_c(int kijs, int kijl, const double * emaxdpt, double * fl1, + double delth, const double * dfim, double epsmin, const double * fr, int nang, + int nfre, double wetail, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/sdepthlim_fc.F90 b/src/phys-scc-cuda/sdepthlim_fc.F90 new file mode 100644 index 00000000..8b5fd7ef --- /dev/null +++ b/src/phys-scc-cuda/sdepthlim_fc.F90 @@ -0,0 +1,54 @@ +MODULE SDEPTHLIM_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SDEPTHLIM_fc (KIJS, KIJL, EMAXDPT, FL1, DELTH, DFIM, EPSMIN, FR, NANG, NFRE, WETAIL, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SDEPTHLIM_iso_c (KIJS, KIJL, EMAXDPT, FL1, DELTH, DFIM, EPSMIN, FR, NANG, NFRE, WETAIL, ICHNK, NCHNK, IJ) & + & BIND(c, name="sdepthlim_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: EMAXDPT + TYPE(c_ptr), VALUE :: FL1 + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + REAL, VALUE :: EPSMIN + TYPE(c_ptr), VALUE :: FR + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: WETAIL + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SDEPTHLIM_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) +!$acc host_data use_device( EMAXDPT, FL1, DFIM, FR ) + CALL SDEPTHLIM_iso_c(KIJS, KIJL, c_loc(EMAXDPT), c_loc(FL1), DELTH, c_loc(DFIM), EPSMIN, c_loc(FR), NANG, NFRE, WETAIL, & + & ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SDEPTHLIM_fc +END MODULE SDEPTHLIM_FC_MOD diff --git a/src/phys-scc-cuda/sdepthlim_fc.intfb.h b/src/phys-scc-cuda/sdepthlim_fc.intfb.h new file mode 100644 index 00000000..0101b5de --- /dev/null +++ b/src/phys-scc-cuda/sdepthlim_fc.intfb.h @@ -0,0 +1,26 @@ +INTERFACE + SUBROUTINE SDEPTHLIM_FC (KIJS, KIJL, EMAXDPT, FL1, DELTH, DFIM, EPSMIN, FR, NANG, NFRE, WETAIL, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE SDEPTHLIM_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sdissip.c_hoist.F90 b/src/phys-scc-cuda/sdissip.c_hoist.F90 new file mode 100644 index 00000000..8b394062 --- /dev/null +++ b/src/phys-scc-cuda/sdissip.c_hoist.F90 @@ -0,0 +1,137 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SDISSIP_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, & +& RAORW, CDIS, CDISVIS, CUMULW, DELTA_SDIS, G, INDICESSAT, IPHYS, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, RNU, & +& SATWEIGHTS, SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + ! ---------------------------------------------------------------------- + + !**** *SDISSIP* - COMPUTATION OF DEEP WATER DISSIPATION SOURCE FUNCTION. + + + !* PURPOSE. + ! -------- + ! COMPUTE DISSIPATION SOURCE FUNCTION AND STORE ADDITIVELY INTO + ! NET SOURCE FUNCTION ARRAY. ALSO COMPUTE FUNCTIONAL DERIVATIVE + ! OF DISSIPATION SOURCE FUNCTION. + + !** INTERFACE. + ! ---------- + + ! *CALL* *SDISSIP (KIJS, KIJL, FL1, FLD, SL, * + ! INDEP, WAVNUM, XK2CG, + ! EMEAN, F1MEAN, XKMEAN,* + ! UFRIC, COSWDIF, RAORW)* + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* - TOTAL SOURCE FUNCTION ARRAY + ! *INDEP* - DEPTH INDEX + ! *WAVNUM* - WAVE NUMBER + ! *XK2CG* - (WAVNUM)**2 * GROUP SPEED + ! *EMEAN* - MEAN ENERGY DENSITY + ! *F1MEAN* - MEAN FREQUENCY BASED ON 1st MOMENT. + ! *XKMEAN* - MEAN WAVE NUMBER BASED ON 1st MOMENT. + ! *UFRIC* - FRICTION VELOCITY IN M/S. + ! *RAORW* - RATIO AIR DENSITY TO WATER DENSITY + ! *COSWDIF*- COS(TH(K)-WDWAVE(IJ)) + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE SDISSIP_ARD_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: INDEP + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SDISSIP_ARD_FC + END INTERFACE + INTERFACE + SUBROUTINE SDISSIP_JAN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMEAN, F1MEAN, XKMEAN + END SUBROUTINE SDISSIP_JAN_FC + END INTERFACE + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + ! ---------------------------------------------------------------------- + + + SELECT CASE (IPHYS) + CASE (0) + CALL SDISSIP_JAN_FC(KIJS, KIJL, FL1(:, :, :, :), FLD(:, :, :), SL(:, :, :), WAVNUM(:, :, :), EMEAN(:), F1MEAN(:), XKMEAN(:), & + & CDIS, CDISVIS, DELTA_SDIS, NANG, NFRE, RNU, ZPI, ICHNK, NCHNK, IJ) + + CASE (1) + CALL SDISSIP_ARD_FC(KIJS, KIJL, FL1(:, :, :, :), FLD(:, :, :), SL(:, :, :), INDEP(:, :), WAVNUM(:, :, :), XK2CG(:, :, :), & + & UFRIC(:, :), COSWDIF(:, :), RAORW(:), CUMULW(:, :, :, :), G, INDICESSAT(:, :), IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, & + & NFRE, NSDSNTH, SATWEIGHTS(:, :), SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR(:), ICHNK, NCHNK, IJ) + END SELECT + + +END SUBROUTINE SDISSIP_FC diff --git a/src/phys-scc-cuda/sdissip_ard.c_hoist.F90 b/src/phys-scc-cuda/sdissip_ard.c_hoist.F90 new file mode 100644 index 00000000..096c4c15 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_ard.c_hoist.F90 @@ -0,0 +1,231 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SDISSIP_ARD_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW, CUMULW, G, & +& INDICESSAT, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, SATWEIGHTS, SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, & +& ZPI, ZPIFR, ICHNK, NCHNK, IJ) + ! ---------------------------------------------------------------------- + + !**** *SDISSIP_ARD* - COMPUTATION OF DISSIPATION SOURCE FUNCTION. + + ! LOTFI AOUF METEO FRANCE 2013 + ! FABRICE ARDHUIN IFREMER 2013 + + + !* PURPOSE. + ! -------- + ! COMPUTE DISSIPATION SOURCE FUNCTION AND STORE ADDITIVELY INTO + ! NET SOURCE FUNCTION ARRAY. ALSO COMPUTE FUNCTIONAL DERIVATIVE + ! OF DISSIPATION SOURCE FUNCTION. + + !** INTERFACE. + ! ---------- + + ! *CALL* *SDISSIP_ARD (KIJS, KIJL, FL1, FLD,SL,* + ! INDEP, WAVNUM, XK2CG, + ! UFRIC, COSWDIF, RAORW)* + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* - TOTAL SOURCE FUNCTION ARRAY + ! *INDEP* - DEPTH INDEX + ! *WAVNUM* - WAVE NUMBER + ! *XK2CG* - (WAVE NUMBER)**2 * GROUP SPEED + ! *UFRIC* - FRICTION VELOCITY IN M/S. + ! *RAORW* - RATIO AIR DENSITY TO WATER DENSITY + ! *COSWDIF*- COS(TH(K)-WDWAVE(IJ)) + + + ! METHOD. + ! ------- + + ! SEE REFERENCES. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! ARDHUIN et AL. JPO DOI:10.1175/20110JPO4324.1 + + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, TH + USE YOWPARAM, ONLY: NANG_PARAM + USE YOWPHYS, ONLY: ISB, SSDSBRF1, BRKPBCOEF, ISDSDTH + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: I + INTEGER(KIND=JWIM) :: J + INTEGER(KIND=JWIM) :: M2 + INTEGER(KIND=JWIM) :: K2 + INTEGER(KIND=JWIM) :: KK + + REAL(KIND=JWRB) :: TPIINV + REAL(KIND=JWRB) :: TPIINVH + REAL(KIND=JWRB) :: TMP01 + REAL(KIND=JWRB) :: TMP03 + REAL(KIND=JWRB) :: EPSR + REAL(KIND=JWRB) :: SSDSC6M1 + REAL(KIND=JWRB) :: ZCOEF + REAL(KIND=JWRB) :: ZCOEFM1 + + + REAL(KIND=JWRB) :: SSDSC2_SIG + REAL(KIND=JWRB) :: FACTURB + REAL(KIND=JWRB) :: BTH + REAL(KIND=JWRB) :: BTH0 + REAL(KIND=JWRB) :: SCUMUL(NANG_PARAM) + REAL(KIND=JWRB) :: D(NANG_PARAM) + + REAL(KIND=JWRB) :: RENEWALFREQ + INTEGER :: FOO + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + ! ---------------------------------------------------------------------- + + + ! INITIALISATION + + FOO = NDEPTH ! necessary for Loki ... + EPSR = SQRT(SDSBR) + + TPIINV = 1.0_JWRB / ZPI + TPIINVH = 0.5_JWRB*TPIINV + TMP03 = 1.0_JWRB / (SDSBR*MICHE) + SSDSC6M1 = 1._JWRB - SSDSC6 + + + DO M=1,NFRE + + ! SATURATION TERM + SSDSC2_SIG = SSDSC2*ZPIFR(M) + ZCOEF = SSDSC2_SIG*SSDSC6 + ZCOEFM1 = SSDSC2_SIG*SSDSC6M1 + + ! COMPUTE SATURATION SPECTRUM + BTH0 = 0.0_JWRB + + DO K=1,NANG + BTH = 0.0_JWRB + ! integrates in directional sector + DO K2=1,NSDSNTH*2 + 1 + KK = INDICESSAT(K, K2) + BTH = BTH + SATWEIGHTS(K, K2)*FL1(IJ, KK, M, ICHNK) + END DO + BTH = BTH*WAVNUM(IJ, M, ICHNK)*TPIINV*XK2CG(IJ, M, ICHNK) + BTH0 = MAX(BTH0, BTH) + + D(K) = ZCOEFM1*MAX(0._JWRB, BTH*TMP03 - SSDSC4)**IPSAT + + SCUMUL(K) = MAX(SQRT(ABS(BTH)) - EPSR, 0._JWRB)**2 + END DO + + DO K=1,NANG + ! cumulative term + D(K) = D(K) + ZCOEF*MAX(0._JWRB, BTH0*TMP03 - SSDSC4)**IPSAT + IF (BTH0 <= SDSBR) THEN + SCUMUL(K) = 0._JWRB + END IF + + END DO + + IF (M > NDIKCUMUL) THEN + ! CUMULATIVE TERM + IF (SSDSC3 /= 0.0_JWRB) THEN + + DO K=1,NANG + ! Correction of saturation level for shallow-water kinematics + ! Cumulative effect based on lambda (breaking probability is + ! the expected rate of sweeping by larger breaking waves) + + RENEWALFREQ = 0.0_JWRB + + DO M2=1,M - NDIKCUMUL + DO K2=1,NANG + KK = ABS(K2 - K) + IF (KK > NANG / 2) KK = KK - NANG / 2 + ! Integrates over frequencies M2 and directions K2 to + ! Integration is performed from M2=1 to a frequency lower than M: IK-NDIKCUMUL + RENEWALFREQ = RENEWALFREQ + CUMULW(INDEP(IJ, ICHNK), KK, M2, M)*SCUMUL(K2) + END DO + END DO + + D(K) = D(K) + RENEWALFREQ + END DO + END IF + END IF + + ! WAVE-TURBULENCE INTERACTION TERM + IF (SSDSC5 /= 0.0_JWRB) THEN + TMP01 = 2._JWRB*SSDSC5 / G + FACTURB = TMP01*RAORW(IJ)*UFRIC(IJ, ICHNK)*UFRIC(IJ, ICHNK) + DO K=1,NANG + D(K) = D(K) - ZPIFR(M)*WAVNUM(IJ, M, ICHNK)*FACTURB*COSWDIF(IJ, K) + END DO + END IF + + + ! ADD ALL CONTRIBUTIONS TO SOURCE TERM + DO K=1,NANG + SL(IJ, K, M) = SL(IJ, K, M) + D(K)*FL1(IJ, K, M, ICHNK) + FLD(IJ, K, M) = FLD(IJ, K, M) + D(K) + END DO + END DO + + + +END SUBROUTINE SDISSIP_ARD_FC diff --git a/src/phys-scc-cuda/sdissip_ard_c.c b/src/phys-scc-cuda/sdissip_ard_c.c new file mode 100644 index 00000000..49bd48a8 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_ard_c.c @@ -0,0 +1,136 @@ +#include +#include +#include +#include +#include +#include +#include "sdissip_ard_c.h" + +__device__ void sdissip_ard_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const int * indep, const double * wavnum, const double * xk2cg, + const double * ufric, const double * coswdif, const double * raorw, + const double * cumulw, double g, const int * indicessat, int ipsat, double miche, + int nang, int ndepth, int ndikcumul, int nfre, int nsdsnth, const double * satweights, + double sdsbr, double ssdsc2, double ssdsc3, double ssdsc4, double ssdsc5, + double ssdsc6, double zpi, const double * zpifr, int ichnk, int nchnk, int ij) { + + // Loki: parameters from YOWPARAM inlined + // Loki: parameters from YOWPHYS inlined + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + int k; + int m; + int i; + int j; + int m2; + int k2; + int kk; + + double tpiinv; + double tpiinvh; + double tmp01; + double tmp03; + double epsr; + double ssdsc6m1; + double zcoef; + double zcoefm1; + double ssdsc2_sig; + double facturb; + double bth; + double bth0; + double scumul[36]; + double d[36]; + + double renewalfreq; + int foo; + foo = ndepth; // necessary for Loki ... + epsr = sqrt((double) (sdsbr)); + + tpiinv = (double) 1.0 / zpi; + tpiinvh = (double) 0.5*tpiinv; + tmp03 = (double) 1.0 / (sdsbr*miche); + ssdsc6m1 = (double) 1. - ssdsc6; + + + for (m = 1; m <= nfre; m += 1) { + ssdsc2_sig = ssdsc2*zpifr[m - 1]; + zcoef = ssdsc2_sig*ssdsc6; + zcoefm1 = ssdsc2_sig*ssdsc6m1; + bth0 = (double) 0.0; + + for (k = 1; k <= nang; k += 1) { + bth = (double) 0.0; + // integrates in directional sector + for (k2 = 1; k2 <= nsdsnth*2 + 1; k2 += 1) { + kk = indicessat[k - 1 + nang_loki_param*(k2 - 1)]; + bth = bth + satweights[k - 1 + nang_loki_param*(k2 - 1)]*fl1[ij - 1 + kijl*(kk - + 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + } + bth = bth*wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1)) + ]*tpiinv*xk2cg[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]; + bth0 = max((double) (bth0), (double) (bth)); + + d[k - 1] = + zcoefm1*(pow(max((double) ((double) 0.), (double) (bth*tmp03 - ssdsc4)), ipsat)); + + scumul[k - 1] = pow(max((double) (sqrt((double) (abs((double) (bth)))) - epsr), + (double) ((double) 0.)), 2); + } + + for (k = 1; k <= nang; k += 1) { + // cumulative term + d[k - 1] = d[k - 1] + zcoef*(pow(max((double) ((double) 0.), (double) (bth0*tmp03 - + ssdsc4)), ipsat)); + if (bth0 <= sdsbr) { + scumul[k - 1] = (double) 0.; + } + + } + + if (m > ndikcumul) { + // CUMULATIVE TERM + if (ssdsc3 != (double) 0.0) { + + for (k = 1; k <= nang; k += 1) { + renewalfreq = (double) 0.0; + + for (m2 = 1; m2 <= m - ndikcumul; m2 += 1) { + for (k2 = 1; k2 <= nang; k2 += 1) { + kk = abs((double) (k2 - k)); + if (kk > nang / 2) { + kk = kk - nang / 2; + } + renewalfreq = renewalfreq + cumulw[indep[ij - 1 + kijl*(ichnk - 1)] - 1 + + ndepth*(1 + kk - 1 + (1 + nang / 2)*(m2 - 1 + nfre_loki_param*(m - 1))) + ]*scumul[k2 - 1]; + } + } + + d[k - 1] = d[k - 1] + renewalfreq; + } + } + } + if (ssdsc5 != (double) 0.0) { + tmp01 = (double) 2.*ssdsc5 / g; + facturb = tmp01*raorw[ij - 1]*ufric[ij - 1 + kijl*(ichnk - 1)]*ufric[ij - 1 + + kijl*(ichnk - 1)]; + for (k = 1; k <= nang; k += 1) { + d[k - 1] = d[k - 1] - zpifr[m - 1]*wavnum[ij - 1 + kijl*(m - 1 + + nfre_loki_param*(ichnk - 1))]*facturb*coswdif[ij - 1 + kijl*(k - 1)]; + } + } + for (k = 1; k <= nang; k += 1) { + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = sl[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1))] + d[k - 1]*fl1[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] + d[k - 1]; + } + } + + + +} diff --git a/src/phys-scc-cuda/sdissip_ard_c.h b/src/phys-scc-cuda/sdissip_ard_c.h new file mode 100644 index 00000000..bd4c6d37 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_ard_c.h @@ -0,0 +1,15 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void sdissip_ard_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const int * indep, const double * wavnum, const double * xk2cg, + const double * ufric, const double * coswdif, const double * raorw, + const double * cumulw, double g, const int * indicessat, int ipsat, double miche, + int nang, int ndepth, int ndikcumul, int nfre, int nsdsnth, const double * satweights, + double sdsbr, double ssdsc2, double ssdsc3, double ssdsc4, double ssdsc5, + double ssdsc6, double zpi, const double * zpifr, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/sdissip_ard_fc.F90 b/src/phys-scc-cuda/sdissip_ard_fc.F90 new file mode 100644 index 00000000..b89a161a --- /dev/null +++ b/src/phys-scc-cuda/sdissip_ard_fc.F90 @@ -0,0 +1,103 @@ +MODULE SDISSIP_ARD_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SDISSIP_ARD_fc (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW, CUMULW, G, INDICESSAT, & + & IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, SATWEIGHTS, SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR, & + & ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SDISSIP_ARD_iso_c (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW, CUMULW, G, & + & INDICESSAT, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, SATWEIGHTS, SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, & + & SSDSC6, ZPI, ZPIFR, ICHNK, NCHNK, IJ) BIND(c, name="sdissip_ard_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: INDEP + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: RAORW + TYPE(c_ptr), VALUE :: CUMULW + REAL, VALUE :: G + TYPE(c_ptr), VALUE :: INDICESSAT + INTEGER(KIND=c_int), VALUE :: IPSAT + REAL, VALUE :: MICHE + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NDEPTH + INTEGER(KIND=c_int), VALUE :: NDIKCUMUL + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: NSDSNTH + TYPE(c_ptr), VALUE :: SATWEIGHTS + REAL, VALUE :: SDSBR + REAL, VALUE :: SSDSC2 + REAL, VALUE :: SSDSC3 + REAL, VALUE :: SSDSC4 + REAL, VALUE :: SSDSC5 + REAL, VALUE :: SSDSC6 + REAL, VALUE :: ZPI + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SDISSIP_ARD_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) +!$acc host_data use_device( FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW, CUMULW, INDICESSAT, SATWEIGHTS, ZPIFR ) + CALL SDISSIP_ARD_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(FLD), c_loc(SL), c_loc(INDEP), c_loc(WAVNUM), c_loc(XK2CG), & + & c_loc(UFRIC), c_loc(COSWDIF), c_loc(RAORW), c_loc(CUMULW), G, c_loc(INDICESSAT), IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, & + & NFRE, NSDSNTH, c_loc(SATWEIGHTS), SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, c_loc(ZPIFR), ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SDISSIP_ARD_fc +END MODULE SDISSIP_ARD_FC_MOD diff --git a/src/phys-scc-cuda/sdissip_ard_fc.intfb.h b/src/phys-scc-cuda/sdissip_ard_fc.intfb.h new file mode 100644 index 00000000..a4cae37e --- /dev/null +++ b/src/phys-scc-cuda/sdissip_ard_fc.intfb.h @@ -0,0 +1,57 @@ +INTERFACE + SUBROUTINE SDISSIP_ARD_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW, CUMULW, G, INDICESSAT, & + & IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, SATWEIGHTS, SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR, & + & ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, TH + USE YOWPARAM, ONLY: NANG_PARAM + USE YOWPHYS, ONLY: ISB, SSDSBRF1, BRKPBCOEF, ISDSDTH + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE SDISSIP_ARD_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sdissip_c.c b/src/phys-scc-cuda/sdissip_c.c new file mode 100644 index 00000000..412fd6d4 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_c.c @@ -0,0 +1,43 @@ +#include +#include +#include +#include +#include +#include +#include "sdissip_c.h" +#include "sdissip_ard_c.h" +#include "sdissip_jan_c.h" + +__device__ void sdissip_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const int * indep, const double * wavnum, const double * xk2cg, + const double * emean, const double * f1mean, const double * xkmean, + const double * ufric, const double * coswdif, const double * raorw, double cdis, + double cdisvis, const double * cumulw, double delta_sdis, double g, + const int * indicessat, int iphys, int ipsat, double miche, int nang, int ndepth, + int ndikcumul, int nfre, int nsdsnth, double rnu, const double * satweights, + double sdsbr, double ssdsc2, double ssdsc3, double ssdsc4, double ssdsc5, + double ssdsc6, double zpi, const double * zpifr, int ichnk, int nchnk, int ij) { + + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + + switch (iphys) { + case 0: + sdissip_jan_c(kijs, kijl, fl1, fld, sl, wavnum, emean, f1mean, xkmean, cdis, + cdisvis, delta_sdis, nang, nfre, rnu, zpi, ichnk, nchnk, ij); + + break; + case 1: + sdissip_ard_c(kijs, kijl, fl1, fld, sl, indep, wavnum, xk2cg, ufric, coswdif, raorw, + cumulw, g, indicessat, ipsat, miche, nang, ndepth, ndikcumul, nfre, nsdsnth, + satweights, sdsbr, ssdsc2, ssdsc3, ssdsc4, ssdsc5, ssdsc6, zpi, zpifr, ichnk, + nchnk, ij); + break; + } + + +} diff --git a/src/phys-scc-cuda/sdissip_c.h b/src/phys-scc-cuda/sdissip_c.h new file mode 100644 index 00000000..85d9db5b --- /dev/null +++ b/src/phys-scc-cuda/sdissip_c.h @@ -0,0 +1,18 @@ +#include +#include +#include +#include +#include +#include +#include "sdissip_ard_c.h" +#include "sdissip_jan_c.h" + +__device__ void sdissip_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const int * indep, const double * wavnum, const double * xk2cg, + const double * emean, const double * f1mean, const double * xkmean, + const double * ufric, const double * coswdif, const double * raorw, double cdis, + double cdisvis, const double * cumulw, double delta_sdis, double g, + const int * indicessat, int iphys, int ipsat, double miche, int nang, int ndepth, + int ndikcumul, int nfre, int nsdsnth, double rnu, const double * satweights, + double sdsbr, double ssdsc2, double ssdsc3, double ssdsc4, double ssdsc5, + double ssdsc6, double zpi, const double * zpifr, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/sdissip_fc.F90 b/src/phys-scc-cuda/sdissip_fc.F90 new file mode 100644 index 00000000..dafcfed6 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_fc.F90 @@ -0,0 +1,138 @@ +MODULE SDISSIP_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SDISSIP_fc (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, RAORW, CDIS, & + & CDISVIS, CUMULW, DELTA_SDIS, G, INDICESSAT, IPHYS, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, RNU, SATWEIGHTS, & + & SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE SDISSIP_ARD (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: INDEP + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SDISSIP_ARD + END INTERFACE + INTERFACE + SUBROUTINE SDISSIP_JAN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMEAN, F1MEAN, XKMEAN + END SUBROUTINE SDISSIP_JAN + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTERFACE + SUBROUTINE SDISSIP_iso_c (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, RAORW, & + & CDIS, CDISVIS, CUMULW, DELTA_SDIS, G, INDICESSAT, IPHYS, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, RNU, & + & SATWEIGHTS, SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR, ICHNK, NCHNK, IJ) BIND(c, name="sdissip_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: INDEP + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: EMEAN + TYPE(c_ptr), VALUE :: F1MEAN + TYPE(c_ptr), VALUE :: XKMEAN + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: RAORW + REAL, VALUE :: CDIS + REAL, VALUE :: CDISVIS + TYPE(c_ptr), VALUE :: CUMULW + REAL, VALUE :: DELTA_SDIS + REAL, VALUE :: G + TYPE(c_ptr), VALUE :: INDICESSAT + INTEGER(KIND=c_int), VALUE :: IPHYS + INTEGER(KIND=c_int), VALUE :: IPSAT + REAL, VALUE :: MICHE + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NDEPTH + INTEGER(KIND=c_int), VALUE :: NDIKCUMUL + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: NSDSNTH + REAL, VALUE :: RNU + TYPE(c_ptr), VALUE :: SATWEIGHTS + REAL, VALUE :: SDSBR + REAL, VALUE :: SSDSC2 + REAL, VALUE :: SSDSC3 + REAL, VALUE :: SSDSC4 + REAL, VALUE :: SSDSC5 + REAL, VALUE :: SSDSC6 + REAL, VALUE :: ZPI + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SDISSIP_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) +!$acc host_data use_device( FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, RAORW, CUMULW, & +!$acc & INDICESSAT, SATWEIGHTS, ZPIFR ) + CALL SDISSIP_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(FLD), c_loc(SL), c_loc(INDEP), c_loc(WAVNUM), c_loc(XK2CG), c_loc(EMEAN), & + & c_loc(F1MEAN), c_loc(XKMEAN), c_loc(UFRIC), c_loc(COSWDIF), c_loc(RAORW), CDIS, CDISVIS, c_loc(CUMULW), DELTA_SDIS, G, & + & c_loc(INDICESSAT), IPHYS, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, RNU, c_loc(SATWEIGHTS), SDSBR, SSDSC2, & + & SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, c_loc(ZPIFR), ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SDISSIP_fc +END MODULE SDISSIP_FC_MOD diff --git a/src/phys-scc-cuda/sdissip_fc.intfb.h b/src/phys-scc-cuda/sdissip_fc.intfb.h new file mode 100644 index 00000000..9ad21347 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_fc.intfb.h @@ -0,0 +1,79 @@ +INTERFACE + SUBROUTINE SDISSIP_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, EMEAN, F1MEAN, XKMEAN, UFRIC, COSWDIF, RAORW, CDIS, & + & CDISVIS, CUMULW, DELTA_SDIS, G, INDICESSAT, IPHYS, IPSAT, MICHE, NANG, NDEPTH, NDIKCUMUL, NFRE, NSDSNTH, RNU, SATWEIGHTS, & + & SDSBR, SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE SDISSIP_ARD_FC (KIJS, KIJL, FL1, FLD, SL, INDEP, WAVNUM, XK2CG, UFRIC, COSWDIF, RAORW) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: INDEP + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: UFRIC, RAORW + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + END SUBROUTINE SDISSIP_ARD_FC + END INTERFACE + INTERFACE + SUBROUTINE SDISSIP_JAN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMEAN, F1MEAN, XKMEAN + END SUBROUTINE SDISSIP_JAN_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDEP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CUMULW(:, :, :, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INDICESSAT(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPSAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: MICHE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDEPTH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NDIKCUMUL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NSDSNTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SATWEIGHTS(:, :) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SDSBR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SSDSC6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + END SUBROUTINE SDISSIP_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sdissip_jan.c_hoist.F90 b/src/phys-scc-cuda/sdissip_jan.c_hoist.F90 new file mode 100644 index 00000000..a0591251 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_jan.c_hoist.F90 @@ -0,0 +1,141 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SDISSIP_JAN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN, CDIS, CDISVIS, & +& DELTA_SDIS, NANG, NFRE, RNU, ZPI, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *SDISSIP_JAN* - COMPUTATION OF DISSIPATION SOURCE FUNCTION. + + ! S.D.HASSELMANN. + ! MODIFIED TO SHALLOW WATER : G. KOMEN , P. JANSSEN + ! OPTIMIZATION : L. ZAMBRESKY + ! J. BIDLOT ECMWF FEBRUARY 1997 ADD SL IN SUBROUTINE CALL + ! J. BIDLOT ECMWF NOVEMBER 2004 REFORMULATION BASED ON XKMEAN + ! AND F1MEAN. + ! AUGUST 2020 Added small viscous dissipation term + + !* PURPOSE. + ! -------- + ! COMPUTE DISSIPATION SOURCE FUNCTION AND STORE ADDITIVELY INTO + ! NET SOURCE FUNCTION ARRAY. ALSO COMPUTE FUNCTIONAL DERIVATIVE + ! OF DISSIPATION SOURCE FUNCTION. + + !** INTERFACE. + ! ---------- + + ! *CALL* *SDISSIP_JAN (KIJS, KIJ, FL1, FLD, SL, + ! WAVNUM, + ! EMEAN,F1MEAN, XKMEAN,)* + ! *FL1* - SPECTRUM. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* - TOTAL SOURCE FUNCTION ARRAY + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *WAVNUM* - WAVE NUMBER + ! *EMEAN* - MEAN ENERGY DENSITY + ! *F1MEAN* - MEAN FREQUENCY BASED ON 1st MOMENT. + ! *XKMEAN* - MEAN WAVE NUMBER BASED ON 1st MOMENT. + + + ! METHOD. + ! ------- + + ! SEE REFERENCES. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! G.KOMEN, S. HASSELMANN AND K. HASSELMANN, ON THE EXISTENCE + ! OF A FULLY DEVELOPED WINDSEA SPECTRUM, JGR, 1984. + + ! --------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, DFIM, DELTH, FRATIO + USE YOWPCONS, ONLY: ZPI4GM2, G + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMEAN(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + + REAL(KIND=JWRB) :: SCDFM + REAL(KIND=JWRB) :: CONSD + REAL(KIND=JWRB) :: CONSS + REAL(KIND=JWRB) :: DELTA_SDISM1 + REAL(KIND=JWRB) :: CVIS + REAL(KIND=JWRB) :: TEMP1 + REAL(KIND=JWRB) :: SDS + REAL(KIND=JWRB) :: X + REAL(KIND=JWRB) :: XK2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + !* 1. ADDING DISSIPATION AND ITS FUNCTIONAL DERIVATIVE TO NET SOURCE + !* FUNCTION AND NET SOURCE FUNCTION DERIVATIVE. + ! -------------------------------------------------------------- + + DELTA_SDISM1 = 1.0_JWRB - DELTA_SDIS + + CONSS = CDIS*ZPI + + SDS = CONSS*F1MEAN(IJ)*EMEAN(IJ)**2*XKMEAN(IJ)**4 + + DO M=1,NFRE + X = WAVNUM(IJ, M, ICHNK) / XKMEAN(IJ) + XK2 = WAVNUM(IJ, M, ICHNK)**2 + + CVIS = RNU*CDISVIS + TEMP1 = SDS*X*(DELTA_SDISM1 + DELTA_SDIS*X) + CVIS*XK2 + + DO K=1,NANG + FLD(IJ, K, M) = FLD(IJ, K, M) + TEMP1 + SL(IJ, K, M) = SL(IJ, K, M) + TEMP1*FL1(IJ, K, M, ICHNK) + END DO + + END DO + + + +END SUBROUTINE SDISSIP_JAN_FC diff --git a/src/phys-scc-cuda/sdissip_jan_c.c b/src/phys-scc-cuda/sdissip_jan_c.c new file mode 100644 index 00000000..86584131 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_jan_c.c @@ -0,0 +1,56 @@ +#include +#include +#include +#include +#include +#include +#include "sdissip_jan_c.h" + +__device__ void sdissip_jan_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * wavnum, const double * emean, const double * f1mean, + const double * xkmean, double cdis, double cdisvis, double delta_sdis, int nang, + int nfre, double rnu, double zpi, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + int k; + int m; + + double scdfm; + double consd; + double conss; + double delta_sdism1; + double cvis; + double temp1; + double sds; + double x; + double xk2; + delta_sdism1 = (double) 1.0 - delta_sdis; + + conss = cdis*zpi; + + sds = conss*f1mean[ij - 1]*(pow(emean[ij - 1], 2))*(pow(xkmean[ij - 1], 4)); + + for (m = 1; m <= nfre; m += 1) { + x = wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))] / xkmean[ij - 1]; + xk2 = pow(wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))], 2); + + cvis = rnu*cdisvis; + temp1 = sds*x*(delta_sdism1 + delta_sdis*x) + cvis*xk2; + + for (k = 1; k <= nang; k += 1) { + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] + temp1; + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = sl[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1))] + temp1*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - + 1 + nfre_loki_param*(ichnk - 1)))]; + } + + } + + + +} diff --git a/src/phys-scc-cuda/sdissip_jan_c.h b/src/phys-scc-cuda/sdissip_jan_c.h new file mode 100644 index 00000000..78c482cb --- /dev/null +++ b/src/phys-scc-cuda/sdissip_jan_c.h @@ -0,0 +1,12 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void sdissip_jan_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * wavnum, const double * emean, const double * f1mean, + const double * xkmean, double cdis, double cdisvis, double delta_sdis, int nang, + int nfre, double rnu, double zpi, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/sdissip_jan_fc.F90 b/src/phys-scc-cuda/sdissip_jan_fc.F90 new file mode 100644 index 00000000..da533d5a --- /dev/null +++ b/src/phys-scc-cuda/sdissip_jan_fc.F90 @@ -0,0 +1,69 @@ +MODULE SDISSIP_JAN_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SDISSIP_JAN_fc (KIJS, KIJL, FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN, CDIS, CDISVIS, DELTA_SDIS, NANG, NFRE, & + & RNU, ZPI, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SDISSIP_JAN_iso_c (KIJS, KIJL, FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN, CDIS, CDISVIS, DELTA_SDIS, NANG, & + & NFRE, RNU, ZPI, ICHNK, NCHNK, IJ) BIND(c, name="sdissip_jan_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: EMEAN + TYPE(c_ptr), VALUE :: F1MEAN + TYPE(c_ptr), VALUE :: XKMEAN + REAL, VALUE :: CDIS + REAL, VALUE :: CDISVIS + REAL, VALUE :: DELTA_SDIS + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: RNU + REAL, VALUE :: ZPI + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SDISSIP_JAN_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMEAN(:) +!$acc host_data use_device( FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN ) + CALL SDISSIP_JAN_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(FLD), c_loc(SL), c_loc(WAVNUM), c_loc(EMEAN), c_loc(F1MEAN), & + & c_loc(XKMEAN), CDIS, CDISVIS, DELTA_SDIS, NANG, NFRE, RNU, ZPI, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SDISSIP_JAN_fc +END MODULE SDISSIP_JAN_FC_MOD diff --git a/src/phys-scc-cuda/sdissip_jan_fc.intfb.h b/src/phys-scc-cuda/sdissip_jan_fc.intfb.h new file mode 100644 index 00000000..48487577 --- /dev/null +++ b/src/phys-scc-cuda/sdissip_jan_fc.intfb.h @@ -0,0 +1,38 @@ +INTERFACE + SUBROUTINE SDISSIP_JAN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, EMEAN, F1MEAN, XKMEAN, CDIS, CDISVIS, DELTA_SDIS, NANG, NFRE, & + & RNU, ZPI, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, DFIM, DELTH, FRATIO + USE YOWPCONS, ONLY: ZPI4GM2, G + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMEAN(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDISVIS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTA_SDIS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE SDISSIP_JAN_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sdiwbk.c_hoist.F90 b/src/phys-scc-cuda/sdiwbk.c_hoist.F90 new file mode 100644 index 00000000..a5112077 --- /dev/null +++ b/src/phys-scc-cuda/sdiwbk.c_hoist.F90 @@ -0,0 +1,134 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SDIWBK_FC (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN, LBIWBK, NANG, NFRE_RED, ICHNK, & +& NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *SDIWBK* - COMPUTATION OF BOTTOM-INDUCED WAVE BREAKING DISSIPATION + + + !* PURPOSE. + ! -------- + ! COMPUTE BOTTOM-INDUCED DISSIPATION SOURCE FUNCTION AND STORE ADDITIVELY INTO + ! NET SOURCE FUNCTION ARRAY. ALSO COMPUTE FUNCTIONAL DERIVATIVE + ! OF DISSIPATION SOURCE FUNCTION. + + !** INTERFACE. + ! ---------- + + ! *CALL* *SDIWBK (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN)* + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* - TOTAL SOURCE FUNCTION ARRAY + ! *DEPTH* - WATER DEPTH + ! *EMAXDPT* - MAXIMUM WAVE VARIANCE ALLOWED FOR A GIVEN DEPTH + ! *EMEAN* - MEAN ENERGY DENSITY + ! *F1MEAN* - MEAN FREQUENCY BASED ON 1st MOMENT. + + ! METHOD. + ! ------- + + ! SEE REFERENCES. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: IC + REAL(KIND=JWRB) :: ALPH + REAL(KIND=JWRB) :: ARG + REAL(KIND=JWRB) :: Q + REAL(KIND=JWRB) :: Q_OLD + REAL(KIND=JWRB) :: REL_ERR + REAL(KIND=JWRB) :: EXPQ + REAL(KIND=JWRB) :: SDS + + REAL, PARAMETER :: ALPH_B_J = 1.0_JWRB + REAL, PARAMETER :: COEF_B_J = 2*ALPH_B_J + REAL, PARAMETER :: DEPTHTRS = 50.0_JWRB + LOGICAL, VALUE, INTENT(IN) :: LBIWBK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + !* 1. ADDING DISSIPATION AND ITS FUNCTIONAL DERIVATIVE TO NET SOURCE + !* FUNCTION AND NET SOURCE FUNCTION DERIVATIVE. + ! -------------------------------------------------------------- + + + IF (LBIWBK) THEN + ! (FOLLOWING BATTJES-JANSSEN AND BEJI) + IF (DEPTH(IJ, ICHNK) < DEPTHTRS) THEN + ALPH = 2.0_JWRB*EMAXDPT(IJ, ICHNK) / EMEAN(IJ) + ARG = MIN(ALPH, 50.0_JWRB) + Q_OLD = EXP(-ARG) + ! USE NEWTON-RAPHSON METHOD + DO IC=1,15 + EXPQ = EXP(-ARG*(1.0_JWRB - Q_OLD)) + Q = Q_OLD - (EXPQ - Q_OLD) / (ARG*EXPQ - 1.0_JWRB) + REL_ERR = ABS(Q - Q_OLD) / Q_OLD + IF (REL_ERR < 0.00001_JWRB) EXIT + Q_OLD = Q + END DO + Q = MIN(Q, 1.0_JWRB) + SDS = COEF_B_J*ALPH*Q*F1MEAN(IJ) + END IF + + DO M=1,NFRE_RED + DO K=1,NANG + IF (DEPTH(IJ, ICHNK) < DEPTHTRS) THEN + SL(IJ, K, M) = SL(IJ, K, M) - SDS*FL1(IJ, K, M, ICHNK) + FLD(IJ, K, M) = FLD(IJ, K, M) - SDS + END IF + END DO + END DO + + END IF + + + +END SUBROUTINE SDIWBK_FC diff --git a/src/phys-scc-cuda/sdiwbk_c.c b/src/phys-scc-cuda/sdiwbk_c.c new file mode 100644 index 00000000..d79b1262 --- /dev/null +++ b/src/phys-scc-cuda/sdiwbk_c.c @@ -0,0 +1,69 @@ +#include +#include +#include +#include +#include +#include +#include "sdiwbk_c.h" + +__device__ void sdiwbk_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * depth, const double * emaxdpt, const double * emean, + const double * f1mean, int lbiwbk, int nang, int nfre_red, int ichnk, int nchnk, int ij + ) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int k; + int m; + int ic; + double alph; + double arg; + double q; + double q_old; + double rel_err; + double expq; + double sds; + + double alph_b_j = (double) 1.0; + double coef_b_j = 2*alph_b_j; + double depthtrs = (double) 50.0; + + if (lbiwbk) { + // (FOLLOWING BATTJES-JANSSEN AND BEJI) + if (depth[ij - 1 + kijl*(ichnk - 1)] < depthtrs) { + alph = (double) 2.0*emaxdpt[ij - 1 + kijl*(ichnk - 1)] / emean[ij - 1]; + arg = min((double) (alph), (double) ((double) 50.0)); + q_old = exp((double) (-arg)); + // USE NEWTON-RAPHSON METHOD + for (ic = 1; ic <= 15; ic += 1) { + expq = exp((double) (-arg*((double) 1.0 - q_old))); + q = q_old - (expq - q_old) / (arg*expq - (double) 1.0); + rel_err = abs((double) (q - q_old)) / q_old; + if (rel_err < (double) 0.00001) { + // EXIT + } + q_old = q; + } + q = min((double) (q), (double) ((double) 1.0)); + sds = coef_b_j*alph*q*f1mean[ij - 1]; + } + + for (m = 1; m <= nfre_red; m += 1) { + for (k = 1; k <= nang; k += 1) { + if (depth[ij - 1 + kijl*(ichnk - 1)] < depthtrs) { + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = sl[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1))] - sds*fl1[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] - sds; + } + } + } + + } + + + +} diff --git a/src/phys-scc-cuda/sdiwbk_c.h b/src/phys-scc-cuda/sdiwbk_c.h new file mode 100644 index 00000000..fa8ead24 --- /dev/null +++ b/src/phys-scc-cuda/sdiwbk_c.h @@ -0,0 +1,12 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void sdiwbk_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * depth, const double * emaxdpt, const double * emean, + const double * f1mean, int lbiwbk, int nang, int nfre_red, int ichnk, int nchnk, int ij + ); diff --git a/src/phys-scc-cuda/sdiwbk_fc.F90 b/src/phys-scc-cuda/sdiwbk_fc.F90 new file mode 100644 index 00000000..24e24367 --- /dev/null +++ b/src/phys-scc-cuda/sdiwbk_fc.F90 @@ -0,0 +1,59 @@ +MODULE SDIWBK_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SDIWBK_fc (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN, LBIWBK, NANG, NFRE_RED, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + LOGICAL, VALUE, INTENT(IN) :: LBIWBK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SDIWBK_iso_c (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN, LBIWBK, NANG, NFRE_RED, ICHNK, NCHNK, IJ) & + & BIND(c, name="sdiwbk_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: DEPTH + TYPE(c_ptr), VALUE :: EMAXDPT + TYPE(c_ptr), VALUE :: EMEAN + TYPE(c_ptr), VALUE :: F1MEAN + LOGICAL, VALUE :: LBIWBK + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE_RED + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SDIWBK_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) +!$acc host_data use_device( FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN ) + CALL SDIWBK_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(FLD), c_loc(SL), c_loc(DEPTH), c_loc(EMAXDPT), c_loc(EMEAN), c_loc(F1MEAN), & + & LBIWBK, NANG, NFRE_RED, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SDIWBK_fc +END MODULE SDIWBK_FC_MOD diff --git a/src/phys-scc-cuda/sdiwbk_fc.intfb.h b/src/phys-scc-cuda/sdiwbk_fc.intfb.h new file mode 100644 index 00000000..b3bde1e6 --- /dev/null +++ b/src/phys-scc-cuda/sdiwbk_fc.intfb.h @@ -0,0 +1,31 @@ +INTERFACE + SUBROUTINE SDIWBK_FC (KIJS, KIJL, FL1, FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN, LBIWBK, NANG, NFRE_RED, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMAXDPT(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1MEAN(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + LOGICAL, VALUE, INTENT(IN) :: LBIWBK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_RED + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE SDIWBK_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/setice.c_hoist.F90 b/src/phys-scc-cuda/setice.c_hoist.F90 new file mode 100644 index 00000000..a7511d26 --- /dev/null +++ b/src/phys-scc-cuda/setice.c_hoist.F90 @@ -0,0 +1,92 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +!----------------------------------------------------------------------- +ATTRIBUTES(DEVICE) SUBROUTINE SETICE_FC (KIJS, KIJL, FL1, CICOVER, COSWDIF, CITHRSH, EPSMIN, FLMIN, NANG, NFRE, ICHNK, NCHNK, IJ) + + !----------------------------------------------------------------------- + + !**** *SETICE* ROUTINE TO SET SPECTRA ON ICE TO NOISE LEVEL. + + ! R.PORTZ MPI OKT.1992 + ! J. BIDLOT ECMWF JUNE 1996 MESSAGE PASSING + + ! PURPOSE. + ! ------- + + ! *SETICE* SET ICE SPECTRA (FL1) TO NOISE LEVEL + + !** INTERFACE. + ! ---------- + + ! *CALL* *SETICE(KIJS, KIJL, FL1, CICOVER, WSWAVE, COSWDIF)* + ! *KIJS* - LOCAL INDEX OF FIRST GRIDPOINT + ! *KIJL* - LOCAL INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRA + ! *CICOVER* - SEA ICE COVER + ! *WSWAVE* - WIND SPEED. + ! *COSWDIF* - COS(TH(K)-WDWAVE(IJ)) + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: K + + REAL(KIND=JWRB) :: CIREDUC + REAL(KIND=JWRB) :: TEMP + REAL(KIND=JWRB) :: ICEFREE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + ! ---------------------------------------------------------------------- + + + !* 1. SET SPECTRA TO NOISE LEVEL OVER ICE POINTS. + ! ---------------------------------------------- + + + IF (CICOVER(IJ, ICHNK) > CITHRSH) THEN + CIREDUC = MAX(EPSMIN, (1.0_JWRB - CICOVER(IJ, ICHNK))) + ICEFREE = 0.0_JWRB + ELSE + CIREDUC = 0.0_JWRB + ICEFREE = 1.0_JWRB + END IF + + TEMP = CIREDUC*FLMIN + DO M=1,NFRE + DO K=1,NANG + FL1(IJ, K, M, ICHNK) = FL1(IJ, K, M, ICHNK)*ICEFREE + TEMP*MAX(0.0_JWRB, COSWDIF(IJ, K))**2 + END DO + END DO + + + +END SUBROUTINE SETICE_FC diff --git a/src/phys-scc-cuda/setice_c.c b/src/phys-scc-cuda/setice_c.c new file mode 100644 index 00000000..85f5469c --- /dev/null +++ b/src/phys-scc-cuda/setice_c.c @@ -0,0 +1,45 @@ +#include +#include +#include +#include +#include +#include +#include "setice_c.h" + +__device__ void setice_c(int kijs, int kijl, double * fl1, const double * cicover, + const double * coswdif, double cithrsh, double epsmin, double flmin, int nang, + int nfre, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int m; + int k; + + double cireduc; + double temp; + double icefree; + + if (cicover[ij - 1 + kijl*(ichnk - 1)] > cithrsh) { + cireduc = max((double) (epsmin), (double) (((double) 1.0 - cicover[ij - 1 + + kijl*(ichnk - 1)]))); + icefree = (double) 0.0; + } else { + cireduc = (double) 0.0; + icefree = (double) 1.0; + } + + temp = cireduc*flmin; + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))] + = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1 + )))]*icefree + temp*(pow(max((double) ((double) 0.0), (double) (coswdif[ij - 1 + + kijl*(k - 1)])), 2)); + } + } + + + +} diff --git a/src/phys-scc-cuda/setice_c.h b/src/phys-scc-cuda/setice_c.h new file mode 100644 index 00000000..6bd3a283 --- /dev/null +++ b/src/phys-scc-cuda/setice_c.h @@ -0,0 +1,11 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void setice_c(int kijs, int kijl, double * fl1, const double * cicover, + const double * coswdif, double cithrsh, double epsmin, double flmin, int nang, + int nfre, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/setice_fc.F90 b/src/phys-scc-cuda/setice_fc.F90 new file mode 100644 index 00000000..e77609ba --- /dev/null +++ b/src/phys-scc-cuda/setice_fc.F90 @@ -0,0 +1,54 @@ +MODULE SETICE_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SETICE_fc (KIJS, KIJL, FL1, CICOVER, COSWDIF, CITHRSH, EPSMIN, FLMIN, NANG, NFRE, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SETICE_iso_c (KIJS, KIJL, FL1, CICOVER, COSWDIF, CITHRSH, EPSMIN, FLMIN, NANG, NFRE, ICHNK, NCHNK, IJ) & + & BIND(c, name="setice_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: COSWDIF + REAL, VALUE :: CITHRSH + REAL, VALUE :: EPSMIN + REAL, VALUE :: FLMIN + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SETICE_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) +!$acc host_data use_device( FL1, CICOVER, COSWDIF ) + CALL SETICE_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(CICOVER), c_loc(COSWDIF), CITHRSH, EPSMIN, FLMIN, NANG, NFRE, ICHNK, NCHNK, & + & IJ) +!$acc end host_data + END SUBROUTINE SETICE_fc +END MODULE SETICE_FC_MOD diff --git a/src/phys-scc-cuda/setice_fc.intfb.h b/src/phys-scc-cuda/setice_fc.intfb.h new file mode 100644 index 00000000..7a69f100 --- /dev/null +++ b/src/phys-scc-cuda/setice_fc.intfb.h @@ -0,0 +1,27 @@ +INTERFACE + SUBROUTINE SETICE_FC (KIJS, KIJL, FL1, CICOVER, COSWDIF, CITHRSH, EPSMIN, FLMIN, NANG, NFRE, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE SETICE_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sinflx.c_hoist.F90 b/src/phys-scc-cuda/sinflx.c_hoist.F90 new file mode 100644 index 00000000..cb9d1cbf --- /dev/null +++ b/src/phys-scc-cuda/sinflx.c_hoist.F90 @@ -0,0 +1,349 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SINFLX_FC (ICALL, KIJS, KIJL, LUPDTUS, FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, & +& WSTAR, CICOVER, COSWDIF, SINWDIF2, FMEAN, HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, & +& MIJ, RHOWGDFTH, XLLWS, ABMAX, ABMIN, ACD, ACDLIN, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, & +& BCDLIN, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CITHRSH_TAIL, CM_GC, COSTH, DELKCC_GC_NS, DELKCC_OMXKM3_GC, & +& DELTH, DFIM, DFIMOFR, DTHRN_A, DTHRN_U, EPS1, EPSMIN, EPSUS, FLOGSPRDM1, FR, FR5, FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, ICODE, & +& ICODE_CPL, IDAMPING, IPHYS, JTOT_TAUHF, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LWCOU, NANG, NFRE, NWAV_GC, OM3GMKM_GC, OMEGA_GC, & +& OMXKM3_GC, RHOWG_DFIM, RN1_RN, RNU, RNUM, SINTH, SQRTGOSURFT, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, & +& SWELLF7M1, SWELLFT, TAILFACTOR, TAILFACTOR_PM, TAUWSHELTER, TH, WETAIL, WSPMIN, WTAUHF, X0TAUHF, XKAPPA, XKMSQRTVGOC2_GC, & +& XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ, RNFAC, TMP_EM, & +& STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST) + + ! ---------------------------------------------------------------------- + + !**** *SINFLX* - UPDATE STRESS AND COMPUTE WIND INPUT SOURCE TERM. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE AIRSEA_FC (KIJS, KIJL, HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, ICODE_WND, IUSFG) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, ICODE_WND, IUSFG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: HALP, U10DIR, TAUW, TAUWDIR, RNFAC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: U10, US + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE AIRSEA_FC + END INTERFACE + INTERFACE + SUBROUTINE FEMEANWS_FC (KIJS, KIJL, FL1, XLLWS, FM, EM) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, XLLWS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FM + REAL(KIND=JWRB), OPTIONAL, INTENT(OUT), DIMENSION(KIJL) :: EM + END SUBROUTINE FEMEANWS_FC + END INTERFACE + INTERFACE + SUBROUTINE FRCUTINDEX_FC (KIJS, KIJL, FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(OUT) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: FM, FMWS, UFRIC, CICOVER + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + END SUBROUTINE FRCUTINDEX_FC + END INTERFACE + INTERFACE + SUBROUTINE HALPHAP_FC (KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: HALP + END SUBROUTINE HALPHAP_FC + END INTERFACE + INTERFACE + SUBROUTINE SINPUT_FC (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, & + & RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: NGST + LOGICAL, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, CINV, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE, WSWAVE, UFRIC, Z0M + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: RAORW, WSTAR, RNFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF, SINWDIF2 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL, SPOS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: XLLWS + END SUBROUTINE SINPUT_FC + END INTERFACE + INTERFACE + SUBROUTINE STRESSO_FC (KIJS, KIJL, MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, COSWDIF, SINWDIF2, & + & TAUW, TAUWDIR, PHIWA, LLPHIWA) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, SL, SPOS + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE, UFRIC, Z0M, AIRD, RNFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF, SINWDIF2 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: TAUW, TAUWDIR, PHIWA + LOGICAL, INTENT(IN) :: LLPHIWA + END SUBROUTINE STRESSO_FC + END INTERFACE + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICALL !! CALL NUMBER. + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS !! GRID POINT INDEXES. + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL !! GRID POINT INDEXES. + + LOGICAL, VALUE, INTENT(IN) :: LUPDTUS !! IF TRUE UFRIC AND Z0M WILL BE UPDATED (CALLING AIRSEA). + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) !! WAVE SPECTRUM. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) !! WAVE NUMBER. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) !! INVERSE PHASE VELOCITY. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) !! (WAVNUM)**2 * GROUP SPPED. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSWAVE(:, :) !! WIND SPEED IN M/S. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) !! WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC NOTATION. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) !! AIR DENSITY (KG/M**3). + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) !! RATIO AIR DENSITY TO WATER DENSITY. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) !! FREE CONVECTION VELOCITY SCALE (M/S) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) !! SEA ICE COVER. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) !! COS(TH(K)-WDWAVE(IJ)) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) !! SIN(TH(K)-WDWAVE(IJ))**2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FMEAN(:) !! MEAN FREQUENCY. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: HALP(:) !! 1/2 PHILLIPS PARAMETER + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FMEANWS(:) !! MEAN FREQUENCY OF THE WINDSEA. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLM(:, :) !! SPECTAL DENSITY MINIMUM VALUE + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UFRIC(:, :) !! FRICTION VELOCITY IN M/S. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUW(:, :) !! WAVE STRESS IN (M/S)**2 + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUWDIR(:, :) !! WAVE STRESS DIRECTION. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0M(:, :) !! ROUGHNESS LENGTH IN M. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0B(:, :) !! BACKGROUND ROUGHNESS LENGTH. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CHRNCK(:, :) !! CHARNOCK COEFFICIENT. + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIWA(:) !! ENERGY FLUX FROM WIND INTO WAVES. + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) !! DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE. + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) !! TOTAL SOURCE FUNCTION ARRAY. + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) !! POSITIVE SINPUT ONLY. + + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) !! LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE. + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: RHOWGDFTH(:, :) !! WATER DENSITY * G * DF * DTHETA + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) !! TOTAL WINDSEA MASK FROM INPUT SOURCE TERM. + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: IUSFG + INTEGER(KIND=JWIM) :: ICODE_WND + INTEGER(KIND=JWIM) :: NGST + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RNFAC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TMP_EM(:, :) + + LOGICAL :: LLPHIWA + LOGICAL :: LLSNEG + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_CPL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + LOGICAL, VALUE, INTENT(IN) :: LWCOU + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_UST(:, :) + + ! ---------------------------------------------------------------------- + + + ! UPDATE UFRIC AND Z0M + IF (ICALL == 1) THEN + IUSFG = 0 + IF (LWCOU) THEN + ICODE_WND = ICODE_CPL + ELSE + ICODE_WND = ICODE + END IF + + LLPHIWA = .false. + LLSNEG = .false. + ELSE + IUSFG = 1 + ICODE_WND = 3 + + LLPHIWA = .true. + LLSNEG = .true. + END IF + + + IF (LLNORMAGAM .and. LLCAPCHNK) THEN + RNFAC(IJ, ICHNK) = 1.0_JWRB + DTHRN_A*(1.0_JWRB + TANH(WSWAVE(IJ, ICHNK) - DTHRN_U)) + ELSE + RNFAC(IJ, ICHNK) = 1.0_JWRB + END IF + + + + IF (LUPDTUS) THEN + ! increase noise level in the tail + IF (ICALL == 1) THEN + + DO K=1,NANG + FL1(IJ, K, NFRE, ICHNK) = MAX(FL1(IJ, K, NFRE, ICHNK), FLM(IJ, K)) + END DO + + + IF (LLGCBZ0) THEN + CALL HALPHAP_FC(KIJS, KIJL, WAVNUM(:, :, :), COSWDIF(:, :), FL1(:, :, :, :), HALP(:), ALPHAPMAX, DELTH, DFIM(:), & + & DFIMOFR(:), EPSMIN, FR(:), FR5(:), FRTAIL, NANG, NFRE, WETAIL, ZPI4GM2, ICHNK, NCHNK, IJ) + ELSE + + HALP(IJ) = 0.0_JWRB + + END IF + + END IF + + CALL AIRSEA_FC(KIJS, KIJL, HALP(:), WSWAVE(:, :), WDWAVE(:, :), TAUW(:, :), TAUWDIR(:, :), RNFAC(:, ICHNK), UFRIC(:, :), & + & Z0M(:, :), Z0B(:, :), CHRNCK(:, :), ICODE_WND, IUSFG, ACD, ALPHA, ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, & + & BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC(:), CDMAX, CHNKMIN_U, CM_GC(:), DELKCC_GC_NS(:), DELKCC_OMXKM3_GC(:), EPS1, & + & EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC(:), OMXKM3_GC(:), RN1_RN, RNU, RNUM, & + & SQRTGOSURFT, WSPMIN, XKAPPA, XKMSQRTVGOC2_GC(:), XKM_GC(:), XK_GC(:), XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, IJ) + + END IF + + ! COMPUTE WIND INPUT + !! FLD AND SL ARE INITIALISED IN SINPUT + + CALL SINPUT_FC(ICALL, LLSNEG, KIJS, KIJL, FL1(:, :, :, :), WAVNUM(:, :, :), CINV(:, :, :), XK2CG(:, :, :), WDWAVE(:, :), & + & WSWAVE(:, :), UFRIC(:, :), Z0M(:, :), COSWDIF(:, :), SINWDIF2(:, :), RAORW(:), WSTAR(:, :), RNFAC(:, ICHNK), FLD(:, :, :), & + & SL(:, :, :), SPOS(:, :, :), XLLWS(:, :, :, :), ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, COSTH(:), & + & DELTH, DFIM(:), EPSMIN, EPSUS, G, IAB, IDAMPING, IPHYS, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH(:), SWELLF, & + & SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT(:), TAUWSHELTER, TH(:), WSPMIN, XKAPPA, Z0RAT, & + & Z0TUBMAX, ZALP, ZPI, ZPIFR(:), ICHNK, NCHNK, IJ) + + + ! MEAN FREQUENCY CHARACTERISTIC FOR WIND SEA + CALL FEMEANWS_FC(KIJS, KIJL, FL1(:, :, :, :), XLLWS(:, :, :, :), FMEANWS(:), TMP_EM(:, ICHNK), DELTH, DFIM(:), DFIMOFR(:), & + & EPSMIN, FR(:), FRTAIL, NANG, NFRE, WETAIL, ICHNK, NCHNK, IJ) + + ! COMPUTE LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM. + CALL FRCUTINDEX_FC(KIJS, KIJL, FMEAN(:), FMEANWS(:), UFRIC(:, :), CICOVER(:, :), MIJ(:, :), RHOWGDFTH(:, :), CITHRSH_TAIL, & + & EPSMIN, FLOGSPRDM1, FR(:), FRIC, G, NFRE, RHOWG_DFIM(:), TAILFACTOR, TAILFACTOR_PM, ZPIFR(:), ICHNK, NCHNK, IJ) + + ! UPDATE TAUW + CALL STRESSO_FC(KIJS, KIJL, MIJ(:, :), RHOWGDFTH(:, :), FL1(:, :, :, :), SL(:, :, :), SPOS(:, :, :), CINV(:, :, :), & + & WDWAVE(:, :), UFRIC(:, :), Z0M(:, :), AIRD(:, :), RNFAC(:, ICHNK), COSWDIF(:, :), SINWDIF2(:, :), TAUW(:, :), TAUWDIR(:, :), & + & PHIWA(:), LLPHIWA, COSTH(:), DELTH, EPS1, FR5(:), G, GAMNCONST, GM1, IPHYS, JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, NFRE, & + & NWAV_GC, OMEGA_GC(:), RHOWG_DFIM(:), SINTH(:), SQRTGOSURFT, TAUWSHELTER, WTAUHF(:), X0TAUHF, XKAPPA, XKM_GC(:), XK_GC(:), & + & XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR(:), ICHNK, NCHNK, IJ, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, & + & STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST) + + ! ---------------------------------------------------------------------- + + +END SUBROUTINE SINFLX_FC diff --git a/src/phys-scc-cuda/sinflx_c.c b/src/phys-scc-cuda/sinflx_c.c new file mode 100644 index 00000000..97ea3c89 --- /dev/null +++ b/src/phys-scc-cuda/sinflx_c.c @@ -0,0 +1,148 @@ +#include +#include +#include +#include +#include +#include +#include "sinflx_c.h" +#include "stresso_c.h" +#include "frcutindex_c.h" +#include "femeanws_c.h" +#include "sinput_c.h" +#include "airsea_c.h" +#include "halphap_c.h" + +__device__ void sinflx_c(int icall, int kijs, int kijl, int lupdtus, double * fl1, + const double * wavnum, const double * cinv, const double * xk2cg, double * wswave, + const double * wdwave, const double * aird, const double * raorw, + const double * wstar, const double * cicover, const double * coswdif, + const double * sinwdif2, const double * fmean, double * halp, double * fmeanws, + const double * flm, double * ufric, double * tauw, double * tauwdir, double * z0m, + double * z0b, double * chrnck, double * phiwa, double * fld, double * sl, + double * spos, int * mij, double * rhowgdfth, double * xllws, double abmax, + double abmin, double acd, double acdlin, double alpha, double alphamax, + double alphamin, double alphapmax, double ang_gc_a, double ang_gc_b, double ang_gc_c, + double bcd, double bcdlin, double betamaxoxkappa2, double bmaxokap, + const double * c2osqrtvg_gc, double cdmax, double chnkmin_u, double cithrsh_tail, + const double * cm_gc, const double * costh, const double * delkcc_gc_ns, + const double * delkcc_omxkm3_gc, double delth, const double * dfim, + const double * dfimofr, double dthrn_a, double dthrn_u, double eps1, double epsmin, + double epsus, double flogsprdm1, const double * fr, const double * fr5, double fric, + double frtail, double g, double gamnconst, double gm1, int iab, int icode, + int icode_cpl, int idamping, int iphys, int jtot_tauhf, int llcapchnk, int llgcbz0, + int llnormagam, int lwcou, int nang, int nfre, int nwav_gc, const double * om3gmkm_gc, + const double * omega_gc, const double * omxkm3_gc, const double * rhowg_dfim, + double rn1_rn, double rnu, double rnum, const double * sinth, double sqrtgosurft, + double swellf, double swellf2, double swellf3, double swellf4, double swellf5, + double swellf6, double swellf7, double swellf7m1, const double * swellft, + double tailfactor, double tailfactor_pm, double tauwshelter, const double * th, + double wetail, double wspmin, const double * wtauhf, double x0tauhf, double xkappa, + const double * xkmsqrtvgoc2_gc, const double * xkm_gc, const double * xk_gc, + double xlogkratiom1_gc, double xnlev, double z0rat, double z0tubmax, double zalp, + double zpi, double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk, + int nchnk, int ij, double * rnfac, double * tmp_em, double * stresso_xstress, + double * stresso_ystress, double * stresso_tauhf, double * stresso_phihf, + double * stresso_usdirp, double * stresso_ust) { + + + + + + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + + + + + + int k; + int iusfg; + int icode_wnd; + int ngst; + + + int llphiwa; + int llsneg; + if (icall == 1) { + iusfg = 0; + if (lwcou) { + icode_wnd = icode_cpl; + } else { + icode_wnd = icode; + } + + llphiwa = false; + llsneg = false; + } else { + iusfg = 1; + icode_wnd = 3; + + llphiwa = true; + llsneg = true; + } + + + if (llnormagam && llcapchnk) { + rnfac[ij - 1 + kijl*(ichnk - 1)] = (double) 1.0 + dthrn_a*((double) 1.0 + + tanh(wswave[ij - 1 + kijl*(ichnk - 1)] - dthrn_u)); + } else { + rnfac[ij - 1 + kijl*(ichnk - 1)] = (double) 1.0; + } + + if (lupdtus) { + // increase noise level in the tail + if (icall == 1) { + + for (k = 1; k <= nang; k += 1) { + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(nfre - 1 + nfre_loki_param*(ichnk - 1 + )))] = max((double) (fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(nfre - 1 + + nfre_loki_param*(ichnk - 1)))]), (double) (flm[ij - 1 + kijl*(k - 1)])); + } + + + if (llgcbz0) { + halphap_c(kijs, kijl, wavnum, coswdif, fl1, halp, alphapmax, delth, dfim, + dfimofr, epsmin, fr, fr5, frtail, nang, nfre, wetail, zpi4gm2, ichnk, nchnk, ij + ); + } else { + + halp[ij - 1] = (double) 0.0; + + } + + } + + airsea_c(kijs, kijl, halp, wswave, wdwave, tauw, tauwdir, + (&rnfac[ + kijl*(ichnk - 1)]), ufric, z0m, z0b, chrnck, icode_wnd, iusfg, acd, + alpha, alphamax, alphamin, ang_gc_a, ang_gc_b, ang_gc_c, bcd, betamaxoxkappa2, + bmaxokap, c2osqrtvg_gc, cdmax, chnkmin_u, cm_gc, delkcc_gc_ns, delkcc_omxkm3_gc, + eps1, epsmin, epsus, g, gm1, llcapchnk, llgcbz0, llnormagam, nwav_gc, om3gmkm_gc, + omxkm3_gc, rn1_rn, rnu, rnum, sqrtgosurft, wspmin, xkappa, xkmsqrtvgoc2_gc, + xkm_gc, xk_gc, xlogkratiom1_gc, xnlev, zalp, ichnk, nchnk, ij); + + } + sinput_c(icall, llsneg, kijs, kijl, fl1, wavnum, cinv, xk2cg, wdwave, wswave, ufric, + z0m, coswdif, sinwdif2, raorw, wstar, (&rnfac[ + kijl*(ichnk - 1)]), fld, sl, spos, + xllws, abmax, abmin, acdlin, alphamax, alphamin, bcdlin, betamaxoxkappa2, costh, + delth, dfim, epsmin, epsus, g, iab, idamping, iphys, llgcbz0, llnormagam, nang, + nfre, rnu, rnum, sinth, swellf, swellf2, swellf3, swellf4, swellf5, swellf6, + swellf7, swellf7m1, swellft, tauwshelter, th, wspmin, xkappa, z0rat, z0tubmax, zalp, + zpi, zpifr, ichnk, nchnk, ij); + femeanws_c(kijs, kijl, fl1, xllws, fmeanws, (&tmp_em[ + kijl*(ichnk - 1)]), delth, + dfim, dfimofr, epsmin, fr, frtail, nang, nfre, wetail, ichnk, nchnk, ij); + frcutindex_c(kijs, kijl, fmean, fmeanws, ufric, cicover, mij, rhowgdfth, cithrsh_tail, + epsmin, flogsprdm1, fr, fric, g, nfre, rhowg_dfim, tailfactor, tailfactor_pm, zpifr, + ichnk, nchnk, ij); + stresso_c(kijs, kijl, mij, rhowgdfth, fl1, sl, spos, cinv, wdwave, ufric, z0m, aird, + (&rnfac[ + kijl*(ichnk - 1)]), coswdif, sinwdif2, tauw, tauwdir, phiwa, llphiwa, + costh, delth, eps1, fr5, g, gamnconst, gm1, iphys, jtot_tauhf, llgcbz0, llnormagam, + nang, nfre, nwav_gc, omega_gc, rhowg_dfim, sinth, sqrtgosurft, tauwshelter, wtauhf, + x0tauhf, xkappa, xkm_gc, xk_gc, xlogkratiom1_gc, zalp, zpi4gm1, zpi4gm2, zpifr, + ichnk, nchnk, ij, stresso_xstress, stresso_ystress, stresso_tauhf, stresso_phihf, + stresso_usdirp, stresso_ust); + +} diff --git a/src/phys-scc-cuda/sinflx_c.h b/src/phys-scc-cuda/sinflx_c.h new file mode 100644 index 00000000..f306b571 --- /dev/null +++ b/src/phys-scc-cuda/sinflx_c.h @@ -0,0 +1,44 @@ +#include +#include +#include +#include +#include +#include +#include "stresso_c.h" +#include "frcutindex_c.h" +#include "femeanws_c.h" +#include "sinput_c.h" +#include "airsea_c.h" +#include "halphap_c.h" + +__device__ void sinflx_c(int icall, int kijs, int kijl, int lupdtus, double * fl1, + const double * wavnum, const double * cinv, const double * xk2cg, double * wswave, + const double * wdwave, const double * aird, const double * raorw, + const double * wstar, const double * cicover, const double * coswdif, + const double * sinwdif2, const double * fmean, double * halp, double * fmeanws, + const double * flm, double * ufric, double * tauw, double * tauwdir, double * z0m, + double * z0b, double * chrnck, double * phiwa, double * fld, double * sl, + double * spos, int * mij, double * rhowgdfth, double * xllws, double abmax, + double abmin, double acd, double acdlin, double alpha, double alphamax, + double alphamin, double alphapmax, double ang_gc_a, double ang_gc_b, double ang_gc_c, + double bcd, double bcdlin, double betamaxoxkappa2, double bmaxokap, + const double * c2osqrtvg_gc, double cdmax, double chnkmin_u, double cithrsh_tail, + const double * cm_gc, const double * costh, const double * delkcc_gc_ns, + const double * delkcc_omxkm3_gc, double delth, const double * dfim, + const double * dfimofr, double dthrn_a, double dthrn_u, double eps1, double epsmin, + double epsus, double flogsprdm1, const double * fr, const double * fr5, double fric, + double frtail, double g, double gamnconst, double gm1, int iab, int icode, + int icode_cpl, int idamping, int iphys, int jtot_tauhf, int llcapchnk, int llgcbz0, + int llnormagam, int lwcou, int nang, int nfre, int nwav_gc, const double * om3gmkm_gc, + const double * omega_gc, const double * omxkm3_gc, const double * rhowg_dfim, + double rn1_rn, double rnu, double rnum, const double * sinth, double sqrtgosurft, + double swellf, double swellf2, double swellf3, double swellf4, double swellf5, + double swellf6, double swellf7, double swellf7m1, const double * swellft, + double tailfactor, double tailfactor_pm, double tauwshelter, const double * th, + double wetail, double wspmin, const double * wtauhf, double x0tauhf, double xkappa, + const double * xkmsqrtvgoc2_gc, const double * xkm_gc, const double * xk_gc, + double xlogkratiom1_gc, double xnlev, double z0rat, double z0tubmax, double zalp, + double zpi, double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk, + int nchnk, int ij, double * rnfac, double * tmp_em, double * stresso_xstress, + double * stresso_ystress, double * stresso_tauhf, double * stresso_phihf, + double * stresso_usdirp, double * stresso_ust); diff --git a/src/phys-scc-cuda/sinflx_fc.F90 b/src/phys-scc-cuda/sinflx_fc.F90 new file mode 100644 index 00000000..aa004294 --- /dev/null +++ b/src/phys-scc-cuda/sinflx_fc.F90 @@ -0,0 +1,412 @@ +MODULE SINFLX_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SINFLX_fc (ICALL, KIJS, KIJL, LUPDTUS, FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, WSTAR, CICOVER, & + & COSWDIF, SINWDIF2, FMEAN, HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, MIJ, RHOWGDFTH, & + & XLLWS, ABMAX, ABMIN, ACD, ACDLIN, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BCDLIN, & + & BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CITHRSH_TAIL, CM_GC, COSTH, DELKCC_GC_NS, DELKCC_OMXKM3_GC, & + & DELTH, DFIM, DFIMOFR, DTHRN_A, DTHRN_U, EPS1, EPSMIN, EPSUS, FLOGSPRDM1, FR, FR5, FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, & + & ICODE, ICODE_CPL, IDAMPING, IPHYS, JTOT_TAUHF, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LWCOU, NANG, NFRE, NWAV_GC, OM3GMKM_GC, & + & OMEGA_GC, OMXKM3_GC, RHOWG_DFIM, RN1_RN, RNU, RNUM, SINTH, SQRTGOSURFT, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, & + & SWELLF7, SWELLF7M1, SWELLFT, TAILFACTOR, TAILFACTOR_PM, TAUWSHELTER, TH, WETAIL, WSPMIN, WTAUHF, X0TAUHF, XKAPPA, & + & XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, & + & IJ, RNFAC, TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE AIRSEA (KIJS, KIJL, HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, ICODE_WND, IUSFG) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, ICODE_WND, IUSFG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: HALP, U10DIR, TAUW, TAUWDIR, RNFAC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: U10, US + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE AIRSEA + END INTERFACE + INTERFACE + SUBROUTINE FEMEANWS (KIJS, KIJL, FL1, XLLWS, FM, EM) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, XLLWS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FM + REAL(KIND=JWRB), OPTIONAL, INTENT(OUT), DIMENSION(KIJL) :: EM + END SUBROUTINE FEMEANWS + END INTERFACE + INTERFACE + SUBROUTINE FRCUTINDEX (KIJS, KIJL, FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(OUT) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: FM, FMWS, UFRIC, CICOVER + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + END SUBROUTINE FRCUTINDEX + END INTERFACE + INTERFACE + SUBROUTINE HALPHAP (KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: HALP + END SUBROUTINE HALPHAP + END INTERFACE + INTERFACE + SUBROUTINE SINPUT (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, & + & RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: NGST + LOGICAL, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, CINV, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE, WSWAVE, UFRIC, Z0M + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: RAORW, WSTAR, RNFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF, SINWDIF2 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL, SPOS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: XLLWS + END SUBROUTINE SINPUT + END INTERFACE + INTERFACE + SUBROUTINE STRESSO (KIJS, KIJL, MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, COSWDIF, SINWDIF2, & + & TAUW, TAUWDIR, PHIWA, LLPHIWA) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, SL, SPOS + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE, UFRIC, Z0M, AIRD, RNFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF, SINWDIF2 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: TAUW, TAUWDIR, PHIWA + LOGICAL, INTENT(IN) :: LLPHIWA + END SUBROUTINE STRESSO + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICALL !! CALL NUMBER. + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS !! GRID POINT INDEXES. + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL !! GRID POINT INDEXES. + + LOGICAL, VALUE, INTENT(IN) :: LUPDTUS !! IF TRUE UFRIC AND Z0M WILL BE UPDATED (CALLING AIRSEA). + + + + + + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_CPL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + LOGICAL, VALUE, INTENT(IN) :: LWCOU + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SINFLX_iso_c (ICALL, KIJS, KIJL, LUPDTUS, FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, WSTAR, & + & CICOVER, COSWDIF, SINWDIF2, FMEAN, HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, & + & MIJ, RHOWGDFTH, XLLWS, ABMAX, ABMIN, ACD, ACDLIN, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, & + & BCD, BCDLIN, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CITHRSH_TAIL, CM_GC, COSTH, DELKCC_GC_NS, & + & DELKCC_OMXKM3_GC, DELTH, DFIM, DFIMOFR, DTHRN_A, DTHRN_U, EPS1, EPSMIN, EPSUS, FLOGSPRDM1, FR, FR5, FRIC, FRTAIL, G, & + & GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IPHYS, JTOT_TAUHF, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LWCOU, NANG, NFRE, & + & NWAV_GC, OM3GMKM_GC, OMEGA_GC, OMXKM3_GC, RHOWG_DFIM, RN1_RN, RNU, RNUM, SINTH, SQRTGOSURFT, SWELLF, SWELLF2, SWELLF3, & + & SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAILFACTOR, TAILFACTOR_PM, TAUWSHELTER, TH, WETAIL, WSPMIN, & + & WTAUHF, X0TAUHF, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, & + & ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ, RNFAC, TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, & + & STRESSO_USDIRP, STRESSO_UST) BIND(c, name="sinflx_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: ICALL + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + LOGICAL, VALUE :: LUPDTUS + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: CINV + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: AIRD + TYPE(c_ptr), VALUE :: RAORW + TYPE(c_ptr), VALUE :: WSTAR + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: SINWDIF2 + TYPE(c_ptr), VALUE :: FMEAN + TYPE(c_ptr), VALUE :: HALP + TYPE(c_ptr), VALUE :: FMEANWS + TYPE(c_ptr), VALUE :: FLM + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: TAUW + TYPE(c_ptr), VALUE :: TAUWDIR + TYPE(c_ptr), VALUE :: Z0M + TYPE(c_ptr), VALUE :: Z0B + TYPE(c_ptr), VALUE :: CHRNCK + TYPE(c_ptr), VALUE :: PHIWA + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: SPOS + TYPE(c_ptr), VALUE :: MIJ + TYPE(c_ptr), VALUE :: RHOWGDFTH + TYPE(c_ptr), VALUE :: XLLWS + REAL, VALUE :: ABMAX + REAL, VALUE :: ABMIN + REAL, VALUE :: ACD + REAL, VALUE :: ACDLIN + REAL, VALUE :: ALPHA + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: ALPHAPMAX + REAL, VALUE :: ANG_GC_A + REAL, VALUE :: ANG_GC_B + REAL, VALUE :: ANG_GC_C + REAL, VALUE :: BCD + REAL, VALUE :: BCDLIN + REAL, VALUE :: BETAMAXOXKAPPA2 + REAL, VALUE :: BMAXOKAP + TYPE(c_ptr), VALUE :: C2OSQRTVG_GC + REAL, VALUE :: CDMAX + REAL, VALUE :: CHNKMIN_U + REAL, VALUE :: CITHRSH_TAIL + TYPE(c_ptr), VALUE :: CM_GC + TYPE(c_ptr), VALUE :: COSTH + TYPE(c_ptr), VALUE :: DELKCC_GC_NS + TYPE(c_ptr), VALUE :: DELKCC_OMXKM3_GC + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIMOFR + REAL, VALUE :: DTHRN_A + REAL, VALUE :: DTHRN_U + REAL, VALUE :: EPS1 + REAL, VALUE :: EPSMIN + REAL, VALUE :: EPSUS + REAL, VALUE :: FLOGSPRDM1 + TYPE(c_ptr), VALUE :: FR + TYPE(c_ptr), VALUE :: FR5 + REAL, VALUE :: FRIC + REAL, VALUE :: FRTAIL + REAL, VALUE :: G + REAL, VALUE :: GAMNCONST + REAL, VALUE :: GM1 + INTEGER(KIND=c_int), VALUE :: IAB + INTEGER(KIND=c_int), VALUE :: ICODE + INTEGER(KIND=c_int), VALUE :: ICODE_CPL + INTEGER(KIND=c_int), VALUE :: IDAMPING + INTEGER(KIND=c_int), VALUE :: IPHYS + INTEGER(KIND=c_int), VALUE :: JTOT_TAUHF + LOGICAL, VALUE :: LLCAPCHNK + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + LOGICAL, VALUE :: LWCOU + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OM3GMKM_GC + TYPE(c_ptr), VALUE :: OMEGA_GC + TYPE(c_ptr), VALUE :: OMXKM3_GC + TYPE(c_ptr), VALUE :: RHOWG_DFIM + REAL, VALUE :: RN1_RN + REAL, VALUE :: RNU + REAL, VALUE :: RNUM + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: SQRTGOSURFT + REAL, VALUE :: SWELLF + REAL, VALUE :: SWELLF2 + REAL, VALUE :: SWELLF3 + REAL, VALUE :: SWELLF4 + REAL, VALUE :: SWELLF5 + REAL, VALUE :: SWELLF6 + REAL, VALUE :: SWELLF7 + REAL, VALUE :: SWELLF7M1 + TYPE(c_ptr), VALUE :: SWELLFT + REAL, VALUE :: TAILFACTOR + REAL, VALUE :: TAILFACTOR_PM + REAL, VALUE :: TAUWSHELTER + TYPE(c_ptr), VALUE :: TH + REAL, VALUE :: WETAIL + REAL, VALUE :: WSPMIN + TYPE(c_ptr), VALUE :: WTAUHF + REAL, VALUE :: X0TAUHF + REAL, VALUE :: XKAPPA + TYPE(c_ptr), VALUE :: XKMSQRTVGOC2_GC + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + REAL, VALUE :: XNLEV + REAL, VALUE :: Z0RAT + REAL, VALUE :: Z0TUBMAX + REAL, VALUE :: ZALP + REAL, VALUE :: ZPI + REAL, VALUE :: ZPI4GM1 + REAL, VALUE :: ZPI4GM2 + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: TMP_EM + TYPE(c_ptr), VALUE :: STRESSO_XSTRESS + TYPE(c_ptr), VALUE :: STRESSO_YSTRESS + TYPE(c_ptr), VALUE :: STRESSO_TAUHF + TYPE(c_ptr), VALUE :: STRESSO_PHIHF + TYPE(c_ptr), VALUE :: STRESSO_USDIRP + TYPE(c_ptr), VALUE :: STRESSO_UST + END SUBROUTINE SINFLX_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FMEANWS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CHRNCK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIWA(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RNFAC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TMP_EM(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_UST(:, :) +!$acc host_data use_device( FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, WSTAR, CICOVER, COSWDIF, SINWDIF2, FMEAN, & +!$acc & HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, MIJ, RHOWGDFTH, XLLWS, C2OSQRTVG_GC, & +!$acc & CM_GC, COSTH, DELKCC_GC_NS, DELKCC_OMXKM3_GC, DFIM, DFIMOFR, FR, FR5, OM3GMKM_GC, OMEGA_GC, OMXKM3_GC, RHOWG_DFIM, & +!$acc & SINTH, SWELLFT, TH, WTAUHF, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, ZPIFR, RNFAC, TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, & +!$acc & STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST ) + CALL SINFLX_iso_c(ICALL, KIJS, KIJL, LUPDTUS, c_loc(FL1), c_loc(WAVNUM), c_loc(CINV), c_loc(XK2CG), c_loc(WSWAVE), & + & c_loc(WDWAVE), c_loc(AIRD), c_loc(RAORW), c_loc(WSTAR), c_loc(CICOVER), c_loc(COSWDIF), c_loc(SINWDIF2), c_loc(FMEAN), & + & c_loc(HALP), c_loc(FMEANWS), c_loc(FLM), c_loc(UFRIC), c_loc(TAUW), c_loc(TAUWDIR), c_loc(Z0M), c_loc(Z0B), c_loc(CHRNCK), & + & c_loc(PHIWA), c_loc(FLD), c_loc(SL), c_loc(SPOS), c_loc(MIJ), c_loc(RHOWGDFTH), c_loc(XLLWS), ABMAX, ABMIN, ACD, ACDLIN, & + & ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BCDLIN, BETAMAXOXKAPPA2, BMAXOKAP, & + & c_loc(C2OSQRTVG_GC), CDMAX, CHNKMIN_U, CITHRSH_TAIL, c_loc(CM_GC), c_loc(COSTH), c_loc(DELKCC_GC_NS), & + & c_loc(DELKCC_OMXKM3_GC), DELTH, c_loc(DFIM), c_loc(DFIMOFR), DTHRN_A, DTHRN_U, EPS1, EPSMIN, EPSUS, FLOGSPRDM1, c_loc(FR), & + & c_loc(FR5), FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IPHYS, JTOT_TAUHF, LLCAPCHNK, LLGCBZ0, & + & LLNORMAGAM, LWCOU, NANG, NFRE, NWAV_GC, c_loc(OM3GMKM_GC), c_loc(OMEGA_GC), c_loc(OMXKM3_GC), c_loc(RHOWG_DFIM), RN1_RN, & + & RNU, RNUM, c_loc(SINTH), SQRTGOSURFT, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, & + & c_loc(SWELLFT), TAILFACTOR, TAILFACTOR_PM, TAUWSHELTER, c_loc(TH), WETAIL, WSPMIN, c_loc(WTAUHF), X0TAUHF, XKAPPA, & + & c_loc(XKMSQRTVGOC2_GC), c_loc(XKM_GC), c_loc(XK_GC), XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, & + & c_loc(ZPIFR), ICHNK, NCHNK, IJ, c_loc(RNFAC), c_loc(TMP_EM), c_loc(STRESSO_XSTRESS), c_loc(STRESSO_YSTRESS), & + & c_loc(STRESSO_TAUHF), c_loc(STRESSO_PHIHF), c_loc(STRESSO_USDIRP), c_loc(STRESSO_UST)) +!$acc end host_data + END SUBROUTINE SINFLX_fc +END MODULE SINFLX_FC_MOD diff --git a/src/phys-scc-cuda/sinflx_fc.intfb.h b/src/phys-scc-cuda/sinflx_fc.intfb.h new file mode 100644 index 00000000..e315ec3d --- /dev/null +++ b/src/phys-scc-cuda/sinflx_fc.intfb.h @@ -0,0 +1,238 @@ +INTERFACE + SUBROUTINE SINFLX_FC (ICALL, KIJS, KIJL, LUPDTUS, FL1, WAVNUM, CINV, XK2CG, WSWAVE, WDWAVE, AIRD, RAORW, WSTAR, CICOVER, & + & COSWDIF, SINWDIF2, FMEAN, HALP, FMEANWS, FLM, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, PHIWA, FLD, SL, SPOS, MIJ, RHOWGDFTH, & + & XLLWS, ABMAX, ABMIN, ACD, ACDLIN, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BCDLIN, & + & BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CITHRSH_TAIL, CM_GC, COSTH, DELKCC_GC_NS, DELKCC_OMXKM3_GC, & + & DELTH, DFIM, DFIMOFR, DTHRN_A, DTHRN_U, EPS1, EPSMIN, EPSUS, FLOGSPRDM1, FR, FR5, FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, & + & ICODE, ICODE_CPL, IDAMPING, IPHYS, JTOT_TAUHF, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LWCOU, NANG, NFRE, NWAV_GC, OM3GMKM_GC, & + & OMEGA_GC, OMXKM3_GC, RHOWG_DFIM, RN1_RN, RNU, RNUM, SINTH, SQRTGOSURFT, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, & + & SWELLF7, SWELLF7M1, SWELLFT, TAILFACTOR, TAILFACTOR_PM, TAUWSHELTER, TH, WETAIL, WSPMIN, WTAUHF, X0TAUHF, XKAPPA, & + & XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, & + & IJ, RNFAC, TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE AIRSEA_FC (KIJS, KIJL, HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, US, Z0, Z0B, CHRNCK, ICODE_WND, IUSFG) + USE parkind_wave, ONLY: jwim, jwrb + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, ICODE_WND, IUSFG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: HALP, U10DIR, TAUW, TAUWDIR, RNFAC + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: U10, US + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: Z0, Z0B, CHRNCK + END SUBROUTINE AIRSEA_FC + END INTERFACE + INTERFACE + SUBROUTINE FEMEANWS_FC (KIJS, KIJL, FL1, XLLWS, FM, EM) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, XLLWS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FM + REAL(KIND=JWRB), OPTIONAL, INTENT(OUT), DIMENSION(KIJL) :: EM + END SUBROUTINE FEMEANWS_FC + END INTERFACE + INTERFACE + SUBROUTINE FRCUTINDEX_FC (KIJS, KIJL, FM, FMWS, UFRIC, CICOVER, MIJ, RHOWGDFTH) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(OUT) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: FM, FMWS, UFRIC, CICOVER + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + END SUBROUTINE FRCUTINDEX_FC + END INTERFACE + INTERFACE + SUBROUTINE HALPHAP_FC (KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: HALP + END SUBROUTINE HALPHAP_FC + END INTERFACE + INTERFACE + SUBROUTINE SINPUT_FC (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, & + & RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: NGST + LOGICAL, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM, CINV, XK2CG + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE, WSWAVE, UFRIC, Z0M + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: RAORW, WSTAR, RNFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF, SINWDIF2 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: FLD, SL, SPOS + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: XLLWS + END SUBROUTINE SINPUT_FC + END INTERFACE + INTERFACE + SUBROUTINE STRESSO_FC (KIJS, KIJL, MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, COSWDIF, & + & SINWDIF2, TAUW, TAUWDIR, PHIWA, LLPHIWA) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + INTEGER(KIND=JWIM), INTENT(IN) :: MIJ(KIJL) + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: RHOWGDFTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1, SL, SPOS + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE, UFRIC, Z0M, AIRD, RNFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG) :: COSWDIF, SINWDIF2 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: TAUW, TAUWDIR, PHIWA + LOGICAL, INTENT(IN) :: LLPHIWA + END SUBROUTINE STRESSO_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICALL !! CALL NUMBER. + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS !! GRID POINT INDEXES. + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL !! GRID POINT INDEXES. + + LOGICAL, VALUE, INTENT(IN) :: LUPDTUS !! IF TRUE UFRIC AND Z0M WILL BE UPDATED (CALLING AIRSEA). + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FL1(:, :, :, :) !! WAVE SPECTRUM. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) !! WAVE NUMBER. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) !! INVERSE PHASE VELOCITY. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) !! (WAVNUM)**2 * GROUP SPPED. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: WSWAVE(:, :) !! WIND SPEED IN M/S. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) !! WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC NOTATION. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) !! AIR DENSITY (KG/M**3). + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) !! RATIO AIR DENSITY TO WATER DENSITY. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) !! FREE CONVECTION VELOCITY SCALE (M/S) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) !! SEA ICE COVER. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) !! COS(TH(K)-WDWAVE(IJ)) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) !! SIN(TH(K)-WDWAVE(IJ))**2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FMEAN(:) !! MEAN FREQUENCY. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: HALP(:) !! 1/2 PHILLIPS PARAMETER + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FMEANWS(:) !! MEAN FREQUENCY OF THE WINDSEA. + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FLM(:, :) !! SPECTAL DENSITY MINIMUM VALUE + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UFRIC(:, :) !! FRICTION VELOCITY IN M/S. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUW(:, :) !! WAVE STRESS IN (M/S)**2 + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUWDIR(:, :) !! WAVE STRESS DIRECTION. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0M(:, :) !! ROUGHNESS LENGTH IN M. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: Z0B(:, :) !! BACKGROUND ROUGHNESS LENGTH. + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: CHRNCK(:, :) !! CHARNOCK COEFFICIENT. + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIWA(:) !! ENERGY FLUX FROM WIND INTO WAVES. + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) !! DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE. + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) !! TOTAL SOURCE FUNCTION ARRAY. + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) !! POSITIVE SINPUT ONLY. + + INTEGER(KIND=JWIM), TARGET, INTENT(OUT) :: MIJ(:, :) !! LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE. + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: RHOWGDFTH(:, :) !! WATER DENSITY * G * DF * DTHETA + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) !! TOTAL WINDSEA MASK FROM INPUT SOURCE TERM. + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: RNFAC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TMP_EM(:, :) + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAPMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH_TAIL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMOFR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DTHRN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLOGSPRDM1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRIC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRTAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICODE_CPL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + LOGICAL, VALUE, INTENT(IN) :: LWCOU + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAILFACTOR_PM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRESSO_UST(:, :) + END SUBROUTINE SINFLX_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sinput.c_hoist.F90 b/src/phys-scc-cuda/sinput.c_hoist.F90 new file mode 100644 index 00000000..dc8bbe57 --- /dev/null +++ b/src/phys-scc-cuda/sinput.c_hoist.F90 @@ -0,0 +1,167 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SINPUT_FC (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, & +& COSWDIF, SINWDIF2, RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, & +& BETAMAXOXKAPPA2, COSTH, DELTH, DFIM, EPSMIN, EPSUS, G, IAB, IDAMPING, IPHYS, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, & +& SINTH, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAUWSHELTER, TH, WSPMIN, XKAPPA, & +& Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + ! ---------------------------------------------------------------------- + + !**** *SINPUT* - COMPUTATION OF INPUT SOURCE FUNCTION. + + + !** INTERFACE. + ! ---------- + + ! *CALL* *SINPUT (NGST, LLSNEG, KIJS, KIJL, FL1, + ! & WAVNUM, CINV, XK2CG, + ! & WDWAVE, UFRIC, Z0M, + ! & COSWDIF, SINWDIF2, + ! & RAORW, WSTAR, FLD, SL, SPOS, XLLWS) + ! *NGST* - IF = 1 THEN NO GUSTINESS PARAMETERISATION + ! - IF = 2 THEN GUSTINESS PARAMETERISATION + ! *LLSNEG* - IF TRUE THEN THE NEGATIVE SINPUT WILL BE COMPUTED + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *FL1* - SPECTRUM. + ! *WAVNUM* - WAVE NUMBER. + ! *CINV* - INVERSE PHASE VELOCITY. + ! *XK2CG* - (WAVE NUMBER)**2 * GROUP SPPED. + ! *WDWAVE* - WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC + ! NOTATION (POINTING ANGLE OF WIND VECTOR, + ! CLOCKWISE FROM NORTH). + ! *UFRIC* - FRICTION VELOCITY IN M/S. + ! *Z0M* - ROUGHNESS LENGTH IN M. + ! *COSWDIF* - COS(TH(K)-WDWAVE(IJ)) + ! *SINWDIF2* - SIN(TH(K)-WDWAVE(IJ))**2 + ! *RAORW* - RATIO AIR DENSITY TO WATER DENSITY. + ! *WSTAR* - FREE CONVECTION VELOCITY SCALE (M/S). + ! *RNFAC* - WIND DEPENDENT FACTOR USED IN THE GROWTH RENORMALISATION. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE. + ! *SL* - TOTAL SOURCE FUNCTION ARRAY. + ! *SPOS* - POSITIVE SOURCE FUNCTION ARRAY. + ! *XLLWS* - = 1 WHERE SINPUT IS POSITIVE + + ! METHOD. + ! ------- + + ! DEPENDING ON THE VALUE OF IPHYS, DIFFERENT INPUTE SOURCE TERm WILL BE CALLED + + ! EXTERNALS. + ! ---------- + + ! MODIFICATIONS + ! ------------- + + ! REFERENCE. + ! ---------- + + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + USE SINPUT_ARD_FC_MOD, ONLY: SINPUT_ARD_FC, SINPUT_JAN_FC + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NGST + LOGICAL, VALUE, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + ! ---------------------------------------------------------------------- + + + SELECT CASE (IPHYS) + CASE (0) + CALL SINPUT_JAN_FC(NGST, LLSNEG, KIJS, KIJL, FL1(:, :, :, :), WAVNUM(:, :, :), CINV(:, :, :), XK2CG(:, :, :), WSWAVE(:, :), & + & UFRIC(:, :), Z0M(:, :), COSWDIF(:, :), SINWDIF2(:, :), RAORW(:), WSTAR(:, :), RNFAC(:), FLD(:, :, :), SL(:, :, :), & + & SPOS(:, :, :), XLLWS(:, :, :, :), ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, DELTH, EPSUS, G, IDAMPING, LLGCBZ0, & + & LLNORMAGAM, NANG, NFRE, RNUM, WSPMIN, XKAPPA, ZALP, ZPI, ZPIFR(:), ICHNK, NCHNK, IJ) + CASE (1) + CALL SINPUT_ARD_FC(NGST, LLSNEG, KIJS, KIJL, FL1(:, :, :, :), WAVNUM(:, :, :), CINV(:, :, :), XK2CG(:, :, :), WDWAVE(:, :), & + & WSWAVE(:, :), UFRIC(:, :), Z0M(:, :), COSWDIF(:, :), SINWDIF2(:, :), RAORW(:), WSTAR(:, :), RNFAC(:), FLD(:, :, :), & + & SL(:, :, :), SPOS(:, :, :), XLLWS(:, :, :, :), ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, & + & COSTH(:), DELTH, DFIM(:), EPSMIN, EPSUS, G, IAB, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH(:), SWELLF, SWELLF2, & + & SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT(:), TAUWSHELTER, TH(:), WSPMIN, XKAPPA, Z0RAT, Z0TUBMAX, & + & ZALP, ZPI, ZPIFR(:), ICHNK, NCHNK, IJ) + END SELECT + + +END SUBROUTINE SINPUT_FC diff --git a/src/phys-scc-cuda/sinput_ard.c_hoist.F90 b/src/phys-scc-cuda/sinput_ard.c_hoist.F90 new file mode 100644 index 00000000..bd83e119 --- /dev/null +++ b/src/phys-scc-cuda/sinput_ard.c_hoist.F90 @@ -0,0 +1,1010 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE SINPUT_ARD_FC_MOD + !CONTAINED SUBROUTINES: + ! - WSIGSTAR + ! - SINPUT_ARD + ! - SINPUT_JAN + CONTAINS + ATTRIBUTES(DEVICE) SUBROUTINE WSIGSTAR_FC (WSWAVE, UFRIC, Z0M, WSTAR, SIG_N, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, EPSUS, G, & + & LLGCBZ0, RNUM, WSPMIN, XKAPPA) + ! ---------------------------------------------------------------------- + + !**** *WSIGSTAR* - COMPUTATION OF THE RELATIVE STANDARD DEVIATION OF USTAR. + + !* PURPOSE. + ! --------- + + ! COMPUTES THE STANDARD DEVIATION OF USTAR DUE TO SMALL SCALE GUSTINESS + ! RELATIVE TO USTAR + + !** INTERFACE. + ! ---------- + + ! *CALL* *WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *WSWAVE* - 10M WIND SPEED (m/s). + ! *UFRIC* - NEW FRICTION VELOCITY IN M/S. + ! *Z0M* - ROUGHNESS LENGTH IN M. + ! *WSTAR* - FREE CONVECTION VELOCITY SCALE (M/S). + ! *SIG_N* - ESTINATED RELATIVE STANDARD DEVIATION OF USTAR. + + ! METHOD. + ! ------- + + ! USE PANOFSKY (1991) TO EXPRESS THE STANDARD DEVIATION OF U10 IN TERMS + ! USTAR AND w* THE CONVECTIVE VELOCITY SCALE. + ! (but with the background gustiness set to 0.) + ! and USTAR=SQRT(Cd)*U10 to DERIVE THE STANDARD DEVIATION OF USTAR. + ! WITH CD=A+B*U10 (see below). + + ! REFERENCE. + ! ---------- + + ! SEE SECTION 3.2.1 OF THE WAM DOCUMENTATION. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: WSWAVE, UFRIC, Z0M, WSTAR + REAL(KIND=JWRB), INTENT(OUT) :: SIG_N + + REAL(KIND=JWRB), PARAMETER :: BG_GUST = 0.0_JWRB ! NO BACKGROUND GUSTINESS (S0 12. IS NOT USED) + REAL(KIND=JWRB), PARAMETER :: ONETHIRD = 1.0_JWRB / 3.0_JWRB + REAL(KIND=JWRB), PARAMETER :: SIG_NMAX = 0.9_JWRB ! MAX OF RELATIVE STANDARD DEVIATION OF USTAR + + REAL(KIND=JWRB), PARAMETER :: LOG10 = LOG(10.0_JWRB) + REAL(KIND=JWRB), PARAMETER :: C1 = 1.03E-3_JWRB + REAL(KIND=JWRB), PARAMETER :: C2 = 0.04E-3_JWRB + REAL(KIND=JWRB), PARAMETER :: P1 = 1.48_JWRB + REAL(KIND=JWRB), PARAMETER :: P2 = -0.21_JWRB + + ! $ loki routine seq + REAL(KIND=JWRB) :: ZCHAR, C_D, DC_DDU, SIG_CONV + REAL(KIND=JWRB) :: XKAPPAD, U10, C2U10P1, U10P2 + REAL(KIND=JWRB) :: BCD, U10M1, ZN, Z0VIS + REAL(KIND=JWRB), INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), INTENT(IN) :: EPSUS + REAL(KIND=JWRB), INTENT(IN) :: G + LOGICAL, INTENT(IN) :: LLGCBZ0 + REAL(KIND=JWRB), INTENT(IN) :: RNUM + REAL(KIND=JWRB), INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), INTENT(IN) :: XKAPPA +!$acc routine seq + + + ! ---------------------------------------------------------------------- + + + + IF (LLGCBZ0) THEN + ZN = RNUM + + U10M1 = 1.0_JWRB / MAX(WSWAVE, WSPMIN) + ! CHARNOCK: + Z0VIS = ZN / MAX(UFRIC, EPSUS) + ZCHAR = G*(Z0M - Z0VIS) / MAX(UFRIC**2, EPSUS) + ZCHAR = MAX(MIN(ZCHAR, ALPHAMAX), ALPHAMIN) + + BCD = BCDLIN*SQRT(ZCHAR) + C_D = ACDLIN + BCD*WSWAVE + DC_DDU = BCD + SIG_CONV = 1.0_JWRB + 0.5_JWRB*WSWAVE / C_D*DC_DDU + SIG_N = MIN(SIG_NMAX, SIG_CONV*U10M1*(BG_GUST*UFRIC**3 + 0.5_JWRB*XKAPPA*WSTAR**3)**ONETHIRD) + ELSE + ZN = 0.0_JWRB + + !!! for consistency I have kept the old method, even though the new method above could be used, + !!! but until LLGCBZ0 is the default, keep the old scheme whe it is not... + ! + ! IN THE FOLLOWING U10 IS ESTIMATED ASSUMING EVERYTHING IS + ! BASED ON U* + ! + XKAPPAD = 1.0_JWRB / XKAPPA + U10 = UFRIC*XKAPPAD*(LOG10 - LOG(Z0M)) + U10 = MAX(U10, WSPMIN) + U10M1 = 1.0_JWRB / U10 + C2U10P1 = C2*U10**P1 + U10P2 = U10**P2 + C_D = (C1 + C2U10P1)*U10P2 + DC_DDU = (P2*C1 + (P1 + P2)*C2U10P1)*U10P2*U10M1 + SIG_CONV = 1.0_JWRB + 0.5_JWRB*U10 / C_D*DC_DDU + SIG_N = MIN(SIG_NMAX, SIG_CONV*U10M1*(BG_GUST*UFRIC**3 + 0.5_JWRB*XKAPPA*WSTAR**3)**ONETHIRD) + END IF + + + END SUBROUTINE WSIGSTAR_FC + ATTRIBUTES(DEVICE) SUBROUTINE SINPUT_ARD_FC (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, & + & COSWDIF, SINWDIF2, RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, & + & BETAMAXOXKAPPA2, COSTH, DELTH, DFIM, EPSMIN, EPSUS, G, IAB, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH, SWELLF, & + & SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAUWSHELTER, TH, WSPMIN, XKAPPA, Z0RAT, Z0TUBMAX, & + & ZALP, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + ! ---------------------------------------------------------------------- + + !**** *SINPUT_ARD* - COMPUTATION OF INPUT SOURCE FUNCTION. + + + !* PURPOSE. + ! --------- + + ! COMPUTE THE WIND INPUT SOURCE TRERM BASED ON ARDHUIN ET AL. 2010. + + ! COMPUTE INPUT SOURCE FUNCTION AND STORE ADDITIVELY INTO NET + ! SOURCE FUNCTION ARRAY, ALSO COMPUTE FUNCTIONAL DERIVATIVE OF + ! INPUT SOURCE FUNCTION. + ! + ! GUSTINESS IS INTRODUCED FOLL0WING THE APPROACH OF JANSSEN(1986), + ! USING A GAUSS-HERMITE APPROXIMATION SUGGESTED BY MILES(1997). + ! IN THE PRESENT VERSION ONLY TWO HERMITE POLYNOMIALS ARE UTILISED + ! IN THE EVALUATION OF THE PROBABILITY INTEGRAL. EXPLICITELY ONE THEN + ! FINDS: + ! + ! = 0.5*( GAMMA(X(1+SIG)) + GAMMA(X(1-SIG)) ) + ! + ! WHERE X IS THE FRICTION VELOCITY AND SIG IS THE RELATIVE GUSTINESS + ! LEVEL. + + !** INTERFACE. + ! ---------- + + ! *CALL* *SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, + ! & WAVNUM, CINV, XK2CG, + ! & WSWAVE, WDWAVE, UFRIC, Z0M, + ! & COSWDIF, SINWDIF2, + ! & RAORW, WSTAR, RNFAC, + ! & FLD, SL, SPOS, XLLWS) + ! *NGST* - IF = 1 THEN NO GUSTINESS PARAMETERISATION + ! - IF = 2 THEN GUSTINESS PARAMETERISATION + ! *LLSNEG- IF TRUE THEN THE NEGATIVE SINPUT (SWELL DAMPING) WILL BE COMPUTED + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *FL1* - SPECTRUM. + ! *WAVNUM* - WAVE NUMBER. + ! *CINV* - INVERSE PHASE VELOCITY. + ! *XK2CG* - (WAVNUM)**2 * GROUP SPPED. + ! *WDWAVE* - WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC + ! NOTATION (POINTING ANGLE OF WIND VECTOR, + ! CLOCKWISE FROM NORTH). + ! *UFRIC* - NEW FRICTION VELOCITY IN M/S. + ! *Z0M* - ROUGHNESS LENGTH IN M. + ! *COSWDIF* - COS(TH(K)-WDWAVE(IJ)) + ! *SINWDIF2* - SIN(TH(K)-WDWAVE(IJ))**2 + ! *RAORW* - RATIO AIR DENSITY TO WATER DENSITY. + ! *WSTAR* - FREE CONVECTION VELOCITY SCALE (M/S). + ! *RNFAC* - WIND DEPENDENT FACTOR USED IN THE GROWTH RENORMALISATION. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE. + ! *SL* - TOTAL SOURCE FUNCTION ARRAY. + ! *SPOS* - POSITIVE SOURCE FUNCTION ARRAY. + ! *XLLWS* - = 1 WHERE SINPUT IS POSITIVE + + ! METHOD. + ! ------- + + ! SEE REFERENCE. + + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWCOUP, ONLY: LLCAPCHNK + USE YOWFRED, ONLY: FR + USE YOWPARAM, ONLY: NANG_PARAM + USE YOWPCONS, ONLY: GM1 + USE YOWPHYS, ONLY: RN1_RN + USE YOWTEST, ONLY: IU06 + USE YOWSTAT, ONLY: IDAMPING + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NGST + LOGICAL, VALUE, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: IND + INTEGER(KIND=JWIM) :: IGST + + REAL(KIND=JWRB) :: CONSTN + REAL(KIND=JWRB) :: AVG_GST + REAL(KIND=JWRB) :: ABS_TAUWSHELTER + REAL(KIND=JWRB) :: CONST1 + REAL(KIND=JWRB) :: ZNZ + REAL(KIND=JWRB) :: X1 + REAL(KIND=JWRB) :: X2 + REAL(KIND=JWRB) :: ZLOG + REAL(KIND=JWRB) :: ZLOG1 + REAL(KIND=JWRB) :: ZLOG2 + REAL(KIND=JWRB) :: ZLOG2X + REAL(KIND=JWRB) :: XV1 + REAL(KIND=JWRB) :: XV2 + REAL(KIND=JWRB) :: ZBETA1 + REAL(KIND=JWRB) :: ZBETA2 + REAL(KIND=JWRB) :: XI + REAL(KIND=JWRB) :: X + REAL(KIND=JWRB) :: DELI1 + REAL(KIND=JWRB) :: DELI2 + REAL(KIND=JWRB) :: FU + REAL(KIND=JWRB) :: FUD + REAL(KIND=JWRB) :: NU_AIR + REAL(KIND=JWRB) :: SMOOTH + REAL(KIND=JWRB) :: HFTSWELLF6 + REAL(KIND=JWRB) :: Z0TUB + REAL(KIND=JWRB) :: FAC_NU_AIR + REAL(KIND=JWRB) :: FACM1_NU_AIR + REAL(KIND=JWRB) :: ARG + REAL(KIND=JWRB) :: DELABM1 + REAL(KIND=JWRB) :: TAUPX + REAL(KIND=JWRB) :: TAUPY + REAL(KIND=JWRB) :: DSTAB2 + + REAL(KIND=JWRB) :: SIG2 + REAL(KIND=JWRB) :: COEF + REAL(KIND=JWRB) :: COEF5 + REAL(KIND=JWRB) :: DFIM_SIG2 + REAL(KIND=JWRB) :: COSLP + + REAL(KIND=JWRB) :: XNGAMCONST + REAL(KIND=JWRB) :: CONSTF + REAL(KIND=JWRB) :: CONST11 + REAL(KIND=JWRB) :: CONST22 + REAL(KIND=JWRB) :: Z0VIS + REAL(KIND=JWRB) :: Z0NOZ + REAL(KIND=JWRB) :: FWW + REAL(KIND=JWRB) :: PVISC + REAL(KIND=JWRB) :: PTURB + REAL(KIND=JWRB) :: ZCN + REAL(KIND=JWRB) :: SIG_N + REAL(KIND=JWRB) :: UORBT + REAL(KIND=JWRB) :: AORB + REAL(KIND=JWRB) :: TEMP + REAL(KIND=JWRB) :: RE + REAL(KIND=JWRB) :: RE_C + REAL(KIND=JWRB) :: ZORB + REAL(KIND=JWRB) :: CNSN + REAL(KIND=JWRB) :: SUMF + REAL(KIND=JWRB) :: SUMFSIN2 + REAL(KIND=JWRB) :: CSTRNFAC + REAL(KIND=JWRB) :: FLP_AVG + REAL(KIND=JWRB) :: SLP_AVG + REAL(KIND=JWRB) :: ROGOROAIR + REAL(KIND=JWRB) :: AIRD_PVISC + REAL(KIND=JWRB) :: DSTAB1 + REAL(KIND=JWRB) :: TEMP1 + REAL(KIND=JWRB) :: TEMP2 + + REAL(KIND=JWRB) :: XSTRESS(2) + REAL(KIND=JWRB) :: YSTRESS(2) + REAL(KIND=JWRB) :: FLP(2) + REAL(KIND=JWRB) :: SLP(2) + REAL(KIND=JWRB) :: USG2(2) + REAL(KIND=JWRB) :: TAUX(2) + REAL(KIND=JWRB) :: TAUY(2) + REAL(KIND=JWRB) :: USTP(2) + REAL(KIND=JWRB) :: USTPM1(2) + REAL(KIND=JWRB) :: USDIRP(2) + REAL(KIND=JWRB) :: UCN(2) + REAL(KIND=JWRB) :: UCNZALPD(2) + REAL(KIND=JWRB) :: GAMNORMA(2) ! ! RENORMALISATION FACTOR OF THE GROWTH RATE + REAL(KIND=JWRB) :: GAM0(2, NANG_PARAM) + REAL(KIND=JWRB) :: DSTAB(2, NANG_PARAM) + + LOGICAL :: LTAUWSHELTER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + ! ---------------------------------------------------------------------- + + + AVG_GST = 1.0_JWRB / NGST + CONST1 = BETAMAXOXKAPPA2 + CONSTN = DELTH / (XKAPPA*ZPI) + + ABS_TAUWSHELTER = ABS(TAUWSHELTER) + IF (ABS_TAUWSHELTER == 0.0_JWRB) THEN + LTAUWSHELTER = .false. + ELSE + LTAUWSHELTER = .true. + END IF + + + IF (NGST > 1) THEN + CALL WSIGSTAR_FC(WSWAVE(IJ, ICHNK), UFRIC(IJ, ICHNK), Z0M(IJ, ICHNK), WSTAR(IJ, ICHNK), SIG_N, ACDLIN, ALPHAMAX, ALPHAMIN, & + & BCDLIN, EPSUS, G, LLGCBZ0, RNUM, WSPMIN, XKAPPA) + END IF + + + IF (LLNORMAGAM) THEN + CSTRNFAC = CONSTN*RNFAC(IJ) / RAORW(IJ) + END IF + + + ! ESTIMATE THE STANDARD DEVIATION OF GUSTINESS. + + ! ---------------------------------------------------------------------- + IF (LLSNEG) THEN + !!!! only for the negative sinput + NU_AIR = RNU + FACM1_NU_AIR = 4.0_JWRB / NU_AIR + + FAC_NU_AIR = RNUM + + FU = ABS(SWELLF3) + FUD = SWELLF2 + DELABM1 = REAL(IAB) / (ABMAX - ABMIN) + + + ! computation of Uorb and Aorb + UORBT = EPSMIN + AORB = EPSMIN + + DO M=1,NFRE + SIG2 = ZPIFR(M)**2 + DFIM_SIG2 = DFIM(M)*SIG2 + + K = 1 + TEMP = FL1(IJ, K, M, ICHNK) + DO K=2,NANG + TEMP = TEMP + FL1(IJ, K, M, ICHNK) + END DO + + UORBT = UORBT + DFIM_SIG2*TEMP + AORB = AORB + DFIM(M)*TEMP + END DO + + UORBT = 2.0_JWRB*SQRT(UORBT) ! this is the significant orbital amplitude + AORB = 2.0_JWRB*SQRT(AORB) ! this 1/2 Hs + RE = FACM1_NU_AIR*UORBT*AORB ! this is the Reynolds number + Z0VIS = FAC_NU_AIR / MAX(UFRIC(IJ, ICHNK), 0.0001_JWRB) + Z0TUB = Z0RAT*MIN(Z0TUBMAX, Z0M(IJ, ICHNK)) + Z0NOZ = MAX(Z0VIS, Z0TUB) + ZORB = AORB / Z0NOZ + + ! compute fww + XI = (LOG10(MAX(ZORB, 3.0_JWRB)) - ABMIN)*DELABM1 + IND = MIN(IAB - 1, INT(XI)) + DELI1 = MIN(1.0_JWRB, XI - REAL(IND, kind=JWRB)) + DELI2 = 1.0_JWRB - DELI1 + FWW = SWELLFT(IND)*DELI2 + SWELLFT(IND + 1)*DELI1 + TEMP2 = FWW*UORBT + + ! Define the critical Reynolds number + IF (SWELLF6 == 1.0_JWRB) THEN + RE_C = SWELLF4 + ELSE + HFTSWELLF6 = 1.0_JWRB - SWELLF6 + RE_C = SWELLF4*(2.0_JWRB / AORB)**HFTSWELLF6 + END IF + + ! Swell damping weight between viscous and turbulent boundary layer + IF (SWELLF7 > 0.0_JWRB) THEN + SMOOTH = 0.5_JWRB*TANH((RE - RE_C)*SWELLF7M1) + PTURB = 0.5_JWRB + SMOOTH + PVISC = 0.5_JWRB - SMOOTH + ELSE + IF (RE <= RE_C) THEN + PTURB = 0.0_JWRB + PVISC = 0.5_JWRB + ELSE + PTURB = 0.5_JWRB + PVISC = 0.0_JWRB + END IF + END IF + + AIRD_PVISC = PVISC*RAORW(IJ) + + END IF + + + + ! Initialisation + + IF (NGST == 1) THEN + USTP(1) = UFRIC(IJ, ICHNK) + ELSE + USTP(1) = UFRIC(IJ, ICHNK)*(1.0_JWRB + SIG_N) + USTP(2) = UFRIC(IJ, ICHNK)*(1.0_JWRB - SIG_N) + END IF + + DO IGST=1,NGST + USTPM1(IGST) = 1.0_JWRB / MAX(USTP(IGST), EPSUS) + END DO + + IF (LTAUWSHELTER) THEN + DO IGST=1,NGST + XSTRESS(IGST) = 0.0_JWRB + YSTRESS(IGST) = 0.0_JWRB + USG2(IGST) = USTP(IGST)**2 + TAUX(IGST) = USG2(IGST)*SIN(WDWAVE(IJ, ICHNK)) + TAUY(IGST) = USG2(IGST)*COS(WDWAVE(IJ, ICHNK)) + END DO + + ROGOROAIR = G / RAORW(IJ) + END IF + + + !* 2. MAIN LOOP OVER FREQUENCIES. + ! --------------------------- + + IF (.not.LLNORMAGAM) THEN + DO IGST=1,NGST + GAMNORMA(IGST) = 1.0_JWRB + END DO + END IF + + IF (.not.LLSNEG) THEN + DO K=1,NANG + DO IGST=1,NGST + DSTAB(IGST, K) = 0.0_JWRB + END DO + END DO + END IF + + DO M=1,NFRE + + IF (LTAUWSHELTER) THEN + DO IGST=1,NGST + TAUPX = TAUX(IGST) - ABS_TAUWSHELTER*XSTRESS(IGST) + TAUPY = TAUY(IGST) - ABS_TAUWSHELTER*YSTRESS(IGST) + USDIRP(IGST) = ATAN2(TAUPX, TAUPY) + USTP(IGST) = (TAUPX**2 + TAUPY**2)**0.25_JWRB + USTPM1(IGST) = 1.0_JWRB / MAX(USTP(IGST), EPSUS) + END DO + + CONSTF = ROGOROAIR*CINV(IJ, M, ICHNK)*DFIM(M) + END IF + + + !* PRECALCULATE FREQUENCY DEPENDENCE. + ! ---------------------------------- + + DO IGST=1,NGST + UCN(IGST) = USTP(IGST)*CINV(IJ, M, ICHNK) + UCNZALPD(IGST) = XKAPPA / (UCN(IGST) + ZALP) + END DO + ZCN = LOG(WAVNUM(IJ, M, ICHNK)*Z0M(IJ, ICHNK)) + CNSN = ZPIFR(M)*CONST1*RAORW(IJ) + + !* 2.1 LOOP OVER DIRECTIONS. + ! --------------------- + + DO K=1,NANG + XLLWS(IJ, K, M, ICHNK) = 0.0_JWRB + END DO + + IF (LLSNEG) THEN + ! SWELL DAMPING: + + SIG2 = ZPIFR(M)**2 + DFIM_SIG2 = DFIM(M)*SIG2 + + COEF = -SWELLF*16._JWRB*SIG2 / G + COEF5 = -SWELLF5*2._JWRB*SQRT(2._JWRB*NU_AIR*ZPIFR(M)) + + DSTAB1 = COEF5*AIRD_PVISC*WAVNUM(IJ, M, ICHNK) + TEMP1 = COEF*RAORW(IJ) + END IF + + DO K=1,NANG + DO IGST=1,NGST + + SUMF = 0.0_JWRB + SUMFSIN2 = 0.0_JWRB + + IF (LTAUWSHELTER) THEN + COSLP = COS(TH(K) - USDIRP(IGST)) + ELSE + COSLP = COSWDIF(IJ, K) + END IF + + GAM0(IGST, K) = 0._JWRB + IF (COSLP > 0.01_JWRB) THEN + X = COSLP*UCN(IGST) + ZLOG = ZCN + UCNZALPD(IGST) / COSLP + IF (ZLOG < 0.0_JWRB) THEN + ZLOG2X = ZLOG*ZLOG*X + GAM0(IGST, K) = EXP(ZLOG)*ZLOG2X*ZLOG2X*CNSN + XLLWS(IJ, K, M, ICHNK) = 1.0_JWRB + END IF + END IF + + IF (LLSNEG) THEN + DSTAB2 = TEMP1*(TEMP2 + (FU + FUD*COSLP)*USTP(IGST)) + DSTAB(IGST, K) = DSTAB1 + PTURB*DSTAB2 + END IF + + SUMF = SUMF + GAM0(IGST, K)*FL1(IJ, K, M, ICHNK) + SUMFSIN2 = SUMFSIN2 + GAM0(IGST, K)*FL1(IJ, K, M, ICHNK)*SINWDIF2(IJ, K) + END DO + END DO + + IF (LLNORMAGAM) THEN + + XNGAMCONST = CSTRNFAC*XK2CG(IJ, M, ICHNK) + DO IGST=1,NGST + ZNZ = XNGAMCONST*USTPM1(IGST) + GAMNORMA(IGST) = (1.0_JWRB + ZNZ*SUMFSIN2) / (1.0_JWRB + ZNZ*SUMF) + END DO + + END IF + + + + !* 2.2 UPDATE THE SHELTERING STRESS (in any), + ! AND THEN ADDING INPUT SOURCE TERM TO NET SOURCE FUNCTION. + ! --------------------------------------------------------- + + DO K=1,NANG + + DO IGST=1,NGST + ! SLP: only the positive contributions + SLP(IGST) = GAM0(IGST, K)*GAMNORMA(IGST) + FLP(IGST) = SLP(IGST) + DSTAB(IGST, K) + END DO + + DO IGST=1,NGST + SLP(IGST) = SLP(IGST)*FL1(IJ, K, M, ICHNK) + END DO + + IF (LTAUWSHELTER) THEN + CONST11 = CONSTF*SINTH(K) + CONST22 = CONSTF*COSTH(K) + DO IGST=1,NGST + XSTRESS(IGST) = XSTRESS(IGST) + SLP(IGST)*CONST11 + YSTRESS(IGST) = YSTRESS(IGST) + SLP(IGST)*CONST22 + END DO + END IF + + IGST = 1 + SLP_AVG = SLP(IGST) + FLP_AVG = FLP(IGST) + DO IGST=2,NGST + SLP_AVG = SLP_AVG + SLP(IGST) + FLP_AVG = FLP_AVG + FLP(IGST) + END DO + + SPOS(IJ, K, M) = AVG_GST*SLP_AVG + FLD(IJ, K, M) = AVG_GST*FLP_AVG + SL(IJ, K, M) = FLD(IJ, K, M)*FL1(IJ, K, M, ICHNK) + + END DO + + END DO + + ! END LOOP OVER FREQUENCIES + + + END SUBROUTINE SINPUT_ARD_FC + ATTRIBUTES(DEVICE) SUBROUTINE SINPUT_JAN_FC (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WSWAVE, UFRIC, Z0M, COSWDIF, & + & SINWDIF2, RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, DELTH, EPSUS, G, & + & IDAMPING, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNUM, WSPMIN, XKAPPA, ZALP, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + ! ---------------------------------------------------------------------- + + !**** *SINPUT_JAN* - COMPUTATION OF INPUT SOURCE FUNCTION. + + ! P.A.E.M. JANSSEN KNMI AUGUST 1990 + + ! OPTIMIZED BY : H. GUENTHER + + ! MODIFIED BY : + ! J-R BIDLOT NOVEMBER 1995 + ! J-R BIDLOT FEBRUARY 1996-97 + ! J-R BIDLOT FEBRUARY 1999 : INTRODUCE ICALL AND NCALL + ! P.A.E.M. JANSSEN MAY 2000 : INTRODUCE GUSTINESS + ! J-R BIDLOT FEBRUARY 2001 : MAKE IT FULLY IMPLICIT BY ONLY + ! USING NEW STRESS AND ROUGHNESS. + ! S. ABDALLA OCTOBER 2001: INTRODUCTION OF VARIABLE AIR + ! DENSITY AND STABILITY-DEPENDENT + ! WIND GUSTINESS + ! P.A.E.M. JANSSEN OCTOBER 2008: INTRODUCE DAMPING WHEN WAVES ARE + ! RUNNING FASTER THAN THE WIND. + ! J-R BIDLOT JANUARY 2013: SHALLOW WATER FORMULATION. + + !* PURPOSE. + ! --------- + + ! COMPUTE INPUT SOURCE FUNCTION AND STORE ADDITIVELY INTO NET + ! SOURCE FUNCTION ARRAY, ALSO COMPUTE FUNCTIONAL DERIVATIVE OF + ! INPUT SOURCE FUNCTION. + ! + ! GUSTINESS IS INTRODUCED FOLL0WING THE APPROACH OF JANSSEN(1986), + ! USING A GAUSS-HERMITE APPROXIMATION SUGGESTED BY MILES(1997). + ! IN THE PRESENT VERSION ONLY TWO HERMITE POLYNOMIALS ARE UTILISED + ! IN THE EVALUATION OF THE PROBABILITY INTEGRAL. EXPLICITELY ONE THEN + ! FINDS: + ! + ! = 0.5*( GAMMA(X(1+SIG)) + GAMMA(X(1-SIG)) ) + ! + ! WHERE X IS THE FRICTION VELOCITY AND SIG IS THE RELATIVE GUSTINESS + ! LEVEL. + + !** INTERFACE. + ! ---------- + + ! *CALL* *SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1, + ! & WAVNUM, CINV, XK2CG, + ! & WDWAVE, WSWAVE, UFRIC, Z0M, + ! & COSWDIF, SINWDIF2, + ! & RAORW, WSTAR, RNFAC, + ! & FLD, SL, SPOS, XLLWS) + ! *NGST* - IF = 1 THEN NO GUSTINESS PARAMETERISATION + ! - IF = 2 THEN GUSTINESS PARAMETERISATION + ! *LLSNEG- IF TRUE THEN THE NEGATIVE SINPUT (SWELL DAMPING) WILL BE COMPUTED + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *FL1* - SPECTRUM. + ! *WAVNUM* - WAVE NUMBER. + ! *CINV* - INVERSE PHASE VELOCITY. + ! *XK2CG* - (WAVNUM)**2 * GROUP SPPED. + ! *WDWAVE* - WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC + ! NOTATION (POINTING ANGLE OF WIND VECTOR, + ! CLOCKWISE FROM NORTH). + ! *UFRIC* - FRICTION VELOCITY IN M/S. + ! *Z0M* - ROUGHNESS LENGTH IN M. + ! *COSWDIF* - COS(TH(K)-WDWAVE(IJ)) + ! *SINWDIF2* - SIN(TH(K)-WDWAVE(IJ))**2 + ! *RAORW* - RATIO AIR DENSITY TO WATER DENSITY + ! *RNFAC* - WIND DEPENDENT FACTOR USED IN THE GROWTH RENORMALISATION. + ! *WSTAR* - FREE CONVECTION VELOCITY SCALE (M/S). + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE. + ! *SL* - TOTAL SOURCE FUNCTION ARRAY. + ! *SPOS* - ONLY POSITIVE PART OF INPUT SOURCE FUNCTION ARRAY. + ! *XLLWS* - 1 WHERE SINPUT IS POSITIVE. + + + ! METHOD. + ! ------- + + ! SEE REFERENCE. + + ! EXTERNALS. + ! ---------- + + ! WSIGSTAR. + + ! MODIFICATIONS + ! ------------- + + ! - REMOVAL OF CALL TO CRAY SPECIFIC FUNCTIONS EXPHF AND ALOGHF + ! BY THEIR STANDARD FORTRAN EQUIVALENT EXP and ALOGHF + ! - MODIFIED TO MAKE INTEGRATION SCHEME FULLY IMPLICIT + ! - INTRODUCTION OF VARIABLE AIR DENSITY + ! - INTRODUCTION OF WIND GUSTINESS + + ! REFERENCE. + ! ---------- + + ! P. JANSSEN, J.P.O., 1989. + ! P. JANSSEN, J.P.O., 1991 + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: TH + USE YOWFRED, ONLY: FR, TH + USE YOWPARAM, ONLY: NANG_PARAM + USE YOWPCONS, ONLY: GM1 + USE YOWTEST, ONLY: IU06 + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NGST + LOGICAL, VALUE, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: IG + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: IGST + + REAL(KIND=JWRB) :: CONST1 + REAL(KIND=JWRB) :: CONST3 + REAL(KIND=JWRB) :: XKAPPAD + REAL(KIND=JWRB) :: CONSTN + REAL(KIND=JWRB) :: ZNZ + REAL(KIND=JWRB) :: X + REAL(KIND=JWRB) :: ZLOG + REAL(KIND=JWRB) :: ZLOG2X + REAL(KIND=JWRB) :: ZBETA + REAL(KIND=JWRB) :: TEMPD + + REAL(KIND=JWRB) :: WSIN(2) + REAL(KIND=JWRB) :: ZTANHKD + REAL(KIND=JWRB) :: SIG_N + REAL(KIND=JWRB) :: CNSN + REAL(KIND=JWRB) :: SUMF + REAL(KIND=JWRB) :: SUMFSIN2 + REAL(KIND=JWRB) :: CSTRNFAC + REAL(KIND=JWRB) :: UFAC1 + REAL(KIND=JWRB) :: UFAC2 + REAL(KIND=JWRB) :: GAMNORMA(2) ! ! RENORMALISATION FACTOR OF THE GROWTH RATE + REAL(KIND=JWRB) :: SIGDEV(2) + REAL(KIND=JWRB) :: US(2) + REAL(KIND=JWRB) :: Z0(2) + REAL(KIND=JWRB) :: UCN(2) + REAL(KIND=JWRB) :: ZCN(2) + REAL(KIND=JWRB) :: USTPM1(2) + REAL(KIND=JWRB) :: XVD(2) + REAL(KIND=JWRB) :: UCND(2) + REAL(KIND=JWRB) :: CONST3_UCN2(2) + REAL(KIND=JWRB) :: GAM0(2, NANG_PARAM) + + LOGICAL :: LZ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + CONST1 = BETAMAXOXKAPPA2 + CONST3 = 2.0_JWRB*XKAPPA / CONST1 ! SEE IDAMPING + XKAPPAD = 1.E0_JWRB / XKAPPA + + CONST3 = IDAMPING*CONST3 + + CONSTN = DELTH / (XKAPPA*ZPI) + + ! ESTIMATE THE STANDARD DEVIATION OF GUSTINESS. + + IF (NGST > 1) THEN + CALL WSIGSTAR_FC(WSWAVE(IJ, ICHNK), UFRIC(IJ, ICHNK), Z0M(IJ, ICHNK), WSTAR(IJ, ICHNK), SIG_N, ACDLIN, ALPHAMAX, ALPHAMIN, & + & BCDLIN, EPSUS, G, LLGCBZ0, RNUM, WSPMIN, XKAPPA) + END IF + + ! DEFINE WHERE SINPUT WILL BE EVALUATED IN RELATIVE TERM WRT USTAR + ! DEFINE ALSO THE RELATIVE WEIGHT OF EACH. + + IF (NGST == 1) THEN + WSIN(1) = 1.0_JWRB + SIGDEV(1) = 1.0_JWRB + ELSE + WSIN(1) = 0.5_JWRB + WSIN(2) = 0.5_JWRB + SIGDEV(1) = 1.0_JWRB - SIG_N + SIGDEV(2) = 1.0_JWRB + SIG_N + END IF + + + IF (NGST == 1) THEN + US(1) = UFRIC(IJ, ICHNK) + Z0(1) = Z0M(IJ, ICHNK) + ELSE + DO IGST=1,NGST + US(IGST) = UFRIC(IJ, ICHNK)*SIGDEV(IGST) + Z0(IGST) = Z0M(IJ, ICHNK) + END DO + END IF + + DO IGST=1,NGST + USTPM1(IGST) = 1.0_JWRB / MAX(US(IGST), EPSUS) + END DO + + ! ---------------------------------------------------------------------- + + !* 2. LOOP OVER FREQUENCIES. + ! ---------------------- + + DO M=1,NFRE + + !* PRECALCULATE FREQUENCY DEPENDENCE. + ! ---------------------------------- + + ZTANHKD = ZPIFR(M)**2 / (G*WAVNUM(IJ, M, ICHNK)) + CNSN = CONST1*ZPIFR(M)*ZTANHKD*RAORW(IJ) + + DO IGST=1,NGST + UCN(IGST) = US(IGST)*CINV(IJ, M, ICHNK) + ZALP + CONST3_UCN2(IGST) = CONST3*UCN(IGST)**2 + UCND(IGST) = 1.0_JWRB / UCN(IGST) + ZCN(IGST) = LOG(WAVNUM(IJ, M, ICHNK)*Z0(IGST)) + XVD(IGST) = 1.0_JWRB / (-US(IGST)*XKAPPAD*ZCN(IGST)*CINV(IJ, M, ICHNK)) + END DO + + !* 2.1 LOOP OVER DIRECTIONS. + ! --------------------- + + ! WIND INPUT: + DO K=1,NANG + XLLWS(IJ, K, M, ICHNK) = 0.0_JWRB + + DO IGST=1,NGST + + IF (COSWDIF(IJ, K) > 0.01_JWRB) THEN + LZ = .true. + TEMPD = XKAPPA / COSWDIF(IJ, K) + ELSE + LZ = .false. + TEMPD = XKAPPA + END IF + + GAM0(IGST, K) = 0.0_JWRB + IF (LZ) THEN + ZLOG = ZCN(IGST) + TEMPD*UCND(IGST) + IF (ZLOG < 0.0_JWRB) THEN + X = COSWDIF(IJ, K)*UCN(IGST) + ZLOG2X = ZLOG*ZLOG*X + GAM0(IGST, K) = ZLOG2X*ZLOG2X*EXP(ZLOG)*CNSN + XLLWS(IJ, K, M, ICHNK) = 1.0_JWRB + END IF + END IF + END DO + + END DO + + + IF (LLNORMAGAM) THEN + + SUMF = 0.0_JWRB + SUMFSIN2 = 0.0_JWRB + DO K=1,NANG + DO IGST=1,NGST + SUMF = SUMF + GAM0(IGST, K)*FL1(IJ, K, M, ICHNK) + SUMFSIN2 = SUMFSIN2 + GAM0(IGST, K)*FL1(IJ, K, M, ICHNK)*SINWDIF2(IJ, K) + END DO + + CSTRNFAC = CONSTN*RNFAC(IJ) / RAORW(IJ) + ZNZ = CSTRNFAC*XK2CG(IJ, M, ICHNK)*USTPM1(IGST) + GAMNORMA(IGST) = (1.0_JWRB + ZNZ*SUMFSIN2) / (1.0_JWRB + ZNZ*SUMF) + + END DO + ELSE + DO IGST=1,NGST + GAMNORMA(IGST) = 1.0_JWRB + END DO + END IF + + DO K=1,NANG + UFAC1 = WSIN(1)*GAM0(1, K)*GAMNORMA(1) + DO IGST=2,NGST + UFAC1 = UFAC1 + WSIN(IGST)*GAM0(IGST, K)*GAMNORMA(IGST) + END DO + + UFAC2 = 0.0_JWRB + IF (LLSNEG) THEN + ! SWELL DAMPING: + ZBETA = CONST3_UCN2(1)*(COSWDIF(IJ, K) - XVD(1)) + UFAC2 = WSIN(1)*ZBETA + DO IGST=2,NGST + ZBETA = CONST3_UCN2(IGST)*(COSWDIF(IJ, K) - XVD(IGST)) + UFAC2 = UFAC2 + WSIN(IGST)*ZBETA + END DO + END IF + + FLD(IJ, K, M) = UFAC1 + UFAC2*CNSN + SPOS(IJ, K, M) = UFAC1*FL1(IJ, K, M, ICHNK) + SL(IJ, K, M) = FLD(IJ, K, M)*FL1(IJ, K, M, ICHNK) + END DO + + !* 2.2 ADDING INPUT SOURCE TERM TO NET SOURCE FUNCTION. + ! ------------------------------------------------ + + END DO + + + + END SUBROUTINE SINPUT_JAN_FC +END MODULE SINPUT_ARD_FC_MOD diff --git a/src/phys-scc-cuda/sinput_ard_c.c b/src/phys-scc-cuda/sinput_ard_c.c new file mode 100644 index 00000000..fab8d50c --- /dev/null +++ b/src/phys-scc-cuda/sinput_ard_c.c @@ -0,0 +1,370 @@ +#include +#include +#include +#include +#include +#include +#include "sinput_ard_c.h" +#include "wsigstar_c.h" + +__device__ void sinput_ard_c(int ngst, int llsneg, int kijs, int kijl, + const double * fl1, const double * wavnum, const double * cinv, const double * xk2cg, + const double * wdwave, const double * wswave, const double * ufric, + const double * z0m, const double * coswdif, const double * sinwdif2, + const double * raorw, const double * wstar, const double * rnfac, double * fld, + double * sl, double * spos, double * xllws, double abmax, double abmin, double acdlin, + double alphamax, double alphamin, double bcdlin, double betamaxoxkappa2, + const double * costh, double delth, const double * dfim, double epsmin, double epsus, + double g, int iab, int llgcbz0, int llnormagam, int nang, int nfre, double rnu, + double rnum, const double * sinth, double swellf, double swellf2, double swellf3, + double swellf4, double swellf5, double swellf6, double swellf7, double swellf7m1, + const double * swellft, double tauwshelter, const double * th, double wspmin, + double xkappa, double z0rat, double z0tubmax, double zalp, double zpi, + const double * zpifr, int ichnk, int nchnk, int ij) { + + // Loki: parameters from YOWPARAM inlined + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int k; + int m; + int ind; + int igst; + + double constn; + double avg_gst; + double abs_tauwshelter; + double const1; + double znz; + double x1; + double x2; + double zlog; + double zlog1; + double zlog2; + double zlog2x; + double xv1; + double xv2; + double zbeta1; + double zbeta2; + double xi; + double x; + double deli1; + double deli2; + double fu; + double fud; + double nu_air; + double smooth; + double hftswellf6; + double z0tub; + double fac_nu_air; + double facm1_nu_air; + double arg; + double delabm1; + double taupx; + double taupy; + double dstab2; + + double sig2; + double coef; + double coef5; + double dfim_sig2; + double coslp; + + double xngamconst; + double constf; + double const11; + double const22; + double z0vis; + double z0noz; + double fww; + double pvisc; + double pturb; + double zcn; + double sig_n; + double uorbt; + double aorb; + double temp; + double re; + double re_c; + double zorb; + double cnsn; + double sumf; + double sumfsin2; + double cstrnfac; + double flp_avg; + double slp_avg; + double rogoroair; + double aird_pvisc; + double dstab1; + double temp1; + double temp2; + + double xstress[2]; + double ystress[2]; + double flp[2]; + double slp[2]; + double usg2[2]; + double taux[2]; + double tauy[2]; + double ustp[2]; + double ustpm1[2]; + double usdirp[2]; + double ucn[2]; + double ucnzalpd[2]; + double gamnorma[2]; // ! RENORMALISATION FACTOR OF THE GROWTH RATE + + int ltauwshelter; + double gam0[36*2]; + double dstab[36*2]; + + avg_gst = (double) 1.0 / ngst; + const1 = betamaxoxkappa2; + constn = delth / (xkappa*zpi); + + abs_tauwshelter = abs((double) (tauwshelter)); + if (abs_tauwshelter == (double) 0.0) { + ltauwshelter = false; + } else { + ltauwshelter = true; + } + + + if (ngst > 1) { + wsigstar_c(wswave[ij - 1 + kijl*(ichnk - 1)], ufric[ij - 1 + kijl*(ichnk - 1)], + z0m[ij - 1 + kijl*(ichnk - 1)], wstar[ij - 1 + kijl*(ichnk - 1)], (&sig_n), + acdlin, alphamax, alphamin, bcdlin, epsus, g, llgcbz0, rnum, wspmin, xkappa); + } + if (llnormagam) { + cstrnfac = constn*rnfac[ij - 1] / raorw[ij - 1]; + } + if (llsneg) { + //!!! only for the negative sinput + nu_air = rnu; + facm1_nu_air = (double) 4.0 / nu_air; + + fac_nu_air = rnum; + + fu = abs((double) (swellf3)); + fud = swellf2; + delabm1 = (double) (iab) / (abmax - abmin); + uorbt = epsmin; + aorb = epsmin; + + for (m = 1; m <= nfre; m += 1) { + sig2 = pow(zpifr[m - 1], 2); + dfim_sig2 = dfim[m - 1]*sig2; + + k = 1; + temp = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - + 1)))]; + for (k = 2; k <= nang; k += 1) { + temp = temp + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + + uorbt = uorbt + dfim_sig2*temp; + aorb = aorb + dfim[m - 1]*temp; + } + + uorbt = (double) 2.0*sqrt((double) (uorbt)); // this is the significant orbital amplitude + aorb = (double) 2.0*sqrt((double) (aorb)); // this 1/2 Hs + re = facm1_nu_air*uorbt*aorb; // this is the Reynolds number + z0vis = fac_nu_air / max((double) (ufric[ij - 1 + kijl*(ichnk - 1)]), (double) + ((double) 0.0001)); + z0tub = z0rat*min((double) (z0tubmax), (double) (z0m[ij - 1 + kijl*(ichnk - 1)])); + z0noz = max((double) (z0vis), (double) (z0tub)); + zorb = aorb / z0noz; + xi = (log10(max((double) (zorb), (double) ((double) 3.0))) - abmin)*delabm1; + ind = min((double) (iab - 1), (double) ((int) (xi))); + deli1 = min((double) ((double) 1.0), (double) (xi - (double) (ind))); + deli2 = (double) 1.0 - deli1; + fww = swellft[ind - 1]*deli2 + swellft[ind + 1 - 1]*deli1; + temp2 = fww*uorbt; + if (swellf6 == (double) 1.0) { + re_c = swellf4; + } else { + hftswellf6 = (double) 1.0 - swellf6; + re_c = swellf4*(pow(((double) 2.0 / aorb), hftswellf6)); + } + if (swellf7 > (double) 0.0) { + smooth = (double) 0.5*tanh((re - re_c)*swellf7m1); + pturb = (double) 0.5 + smooth; + pvisc = (double) 0.5 - smooth; + } else { + if (re <= re_c) { + pturb = (double) 0.0; + pvisc = (double) 0.5; + } else { + pturb = (double) 0.5; + pvisc = (double) 0.0; + } + } + + aird_pvisc = pvisc*raorw[ij - 1]; + + } + if (ngst == 1) { + ustp[1 - 1] = ufric[ij - 1 + kijl*(ichnk - 1)]; + } else { + ustp[1 - 1] = ufric[ij - 1 + kijl*(ichnk - 1)]*((double) 1.0 + sig_n); + ustp[2 - 1] = ufric[ij - 1 + kijl*(ichnk - 1)]*((double) 1.0 - sig_n); + } + + for (igst = 1; igst <= ngst; igst += 1) { + ustpm1[igst - 1] = (double) 1.0 / max((double) (ustp[igst - 1]), (double) (epsus)); + } + + if (ltauwshelter) { + for (igst = 1; igst <= ngst; igst += 1) { + xstress[igst - 1] = (double) 0.0; + ystress[igst - 1] = (double) 0.0; + usg2[igst - 1] = pow(ustp[igst - 1], 2); + taux[igst - 1] = usg2[igst - 1]*sin(wdwave[ij - 1 + kijl*(ichnk - 1)]); + tauy[igst - 1] = usg2[igst - 1]*cos(wdwave[ij - 1 + kijl*(ichnk - 1)]); + } + + rogoroair = g / raorw[ij - 1]; + } + if (!llnormagam) { + for (igst = 1; igst <= ngst; igst += 1) { + gamnorma[igst - 1] = (double) 1.0; + } + } + + if (!llsneg) { + for (k = 1; k <= nang; k += 1) { + for (igst = 1; igst <= ngst; igst += 1) { + dstab[igst - 1 + 2*(k - 1)] = (double) 0.0; + } + } + } + + for (m = 1; m <= nfre; m += 1) { + + if (ltauwshelter) { + for (igst = 1; igst <= ngst; igst += 1) { + taupx = taux[igst - 1] - abs_tauwshelter*xstress[igst - 1]; + taupy = tauy[igst - 1] - abs_tauwshelter*ystress[igst - 1]; + usdirp[igst - 1] = atan2(taupx, taupy); + ustp[igst - 1] = pow(((pow(taupx, 2)) + (pow(taupy, 2))), (double) 0.25); + ustpm1[igst - 1] = + (double) 1.0 / max((double) (ustp[igst - 1]), (double) (epsus)); + } + + constf = + rogoroair*cinv[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]*dfim[m - 1]; + } + for (igst = 1; igst <= ngst; igst += 1) { + ucn[igst - 1] = + ustp[igst - 1]*cinv[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]; + ucnzalpd[igst - 1] = xkappa / (ucn[igst - 1] + zalp); + } + zcn = log(wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]*z0m[ij - 1 + + kijl*(ichnk - 1)]); + cnsn = zpifr[m - 1]*const1*raorw[ij - 1]; + for (k = 1; k <= nang; k += 1) { + xllws[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1))) + ] = (double) 0.0; + } + + if (llsneg) { + sig2 = pow(zpifr[m - 1], 2); + dfim_sig2 = dfim[m - 1]*sig2; + + coef = -swellf*(double) 16.*sig2 / g; + coef5 = -swellf5*(double) 2.*sqrt((double) ((double) 2.*nu_air*zpifr[m - 1])); + + dstab1 = + coef5*aird_pvisc*wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]; + temp1 = coef*raorw[ij - 1]; + } + + for (k = 1; k <= nang; k += 1) { + for (igst = 1; igst <= ngst; igst += 1) { + + sumf = (double) 0.0; + sumfsin2 = (double) 0.0; + + if (ltauwshelter) { + coslp = cos(th[k - 1] - usdirp[igst - 1]); + } else { + coslp = coswdif[ij - 1 + kijl*(k - 1)]; + } + + gam0[igst - 1 + 2*(k - 1)] = (double) 0.; + if (coslp > (double) 0.01) { + x = coslp*ucn[igst - 1]; + zlog = zcn + ucnzalpd[igst - 1] / coslp; + if (zlog < (double) 0.0) { + zlog2x = zlog*zlog*x; + gam0[igst - 1 + 2*(k - 1)] = exp((double) (zlog))*zlog2x*zlog2x*cnsn; + xllws[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = (double) 1.0; + } + } + + if (llsneg) { + dstab2 = temp1*(temp2 + (fu + fud*coslp)*ustp[igst - 1]); + dstab[igst - 1 + 2*(k - 1)] = dstab1 + pturb*dstab2; + } + + sumf = sumf + gam0[igst - 1 + 2*(k - 1)]*fl1[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + sumfsin2 = sumfsin2 + gam0[igst - 1 + 2*(k - 1)]*fl1[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]*sinwdif2[ij - 1 + + kijl*(k - 1)]; + } + } + + if (llnormagam) { + + xngamconst = cstrnfac*xk2cg[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]; + for (igst = 1; igst <= ngst; igst += 1) { + znz = xngamconst*ustpm1[igst - 1]; + gamnorma[igst - 1] = ((double) 1.0 + znz*sumfsin2) / ((double) 1.0 + znz*sumf); + } + + } + for (k = 1; k <= nang; k += 1) { + + for (igst = 1; igst <= ngst; igst += 1) { + // SLP: only the positive contributions + slp[igst - 1] = gam0[igst - 1 + 2*(k - 1)]*gamnorma[igst - 1]; + flp[igst - 1] = slp[igst - 1] + dstab[igst - 1 + 2*(k - 1)]; + } + + for (igst = 1; igst <= ngst; igst += 1) { + slp[igst - 1] = slp[igst - 1]*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + + if (ltauwshelter) { + const11 = constf*sinth[k - 1]; + const22 = constf*costh[k - 1]; + for (igst = 1; igst <= ngst; igst += 1) { + xstress[igst - 1] = xstress[igst - 1] + slp[igst - 1]*const11; + ystress[igst - 1] = ystress[igst - 1] + slp[igst - 1]*const22; + } + } + + igst = 1; + slp_avg = slp[igst - 1]; + flp_avg = flp[igst - 1]; + for (igst = 2; igst <= ngst; igst += 1) { + slp_avg = slp_avg + slp[igst - 1]; + flp_avg = flp_avg + flp[igst - 1]; + } + + spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = avg_gst*slp_avg; + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = avg_gst*flp_avg; + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = fld[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1))]*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + + } + + } + + +} diff --git a/src/phys-scc-cuda/sinput_ard_c.h b/src/phys-scc-cuda/sinput_ard_c.h new file mode 100644 index 00000000..3e8ad130 --- /dev/null +++ b/src/phys-scc-cuda/sinput_ard_c.h @@ -0,0 +1,22 @@ +#include +#include +#include +#include +#include +#include +#include "wsigstar_c.h" + +__device__ void sinput_ard_c(int ngst, int llsneg, int kijs, int kijl, + const double * fl1, const double * wavnum, const double * cinv, const double * xk2cg, + const double * wdwave, const double * wswave, const double * ufric, + const double * z0m, const double * coswdif, const double * sinwdif2, + const double * raorw, const double * wstar, const double * rnfac, double * fld, + double * sl, double * spos, double * xllws, double abmax, double abmin, double acdlin, + double alphamax, double alphamin, double bcdlin, double betamaxoxkappa2, + const double * costh, double delth, const double * dfim, double epsmin, double epsus, + double g, int iab, int llgcbz0, int llnormagam, int nang, int nfre, double rnu, + double rnum, const double * sinth, double swellf, double swellf2, double swellf3, + double swellf4, double swellf5, double swellf6, double swellf7, double swellf7m1, + const double * swellft, double tauwshelter, const double * th, double wspmin, + double xkappa, double z0rat, double z0tubmax, double zalp, double zpi, + const double * zpifr, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/sinput_ard_fc.F90 b/src/phys-scc-cuda/sinput_ard_fc.F90 new file mode 100644 index 00000000..9b027d54 --- /dev/null +++ b/src/phys-scc-cuda/sinput_ard_fc.F90 @@ -0,0 +1,170 @@ +MODULE SINPUT_ARD_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SINPUT_ARD_fc (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, & + & RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, COSTH, DELTH, & + & DFIM, EPSMIN, EPSUS, G, IAB, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, & + & SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAUWSHELTER, TH, WSPMIN, XKAPPA, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NGST + LOGICAL, VALUE, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SINPUT_ARD_iso_c (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, & + & SINWDIF2, RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, & + & COSTH, DELTH, DFIM, EPSMIN, EPSUS, G, IAB, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH, SWELLF, SWELLF2, SWELLF3, & + & SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAUWSHELTER, TH, WSPMIN, XKAPPA, Z0RAT, Z0TUBMAX, ZALP, ZPI, & + & ZPIFR, ICHNK, NCHNK, IJ) BIND(c, name="sinput_ard_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: NGST + LOGICAL, VALUE :: LLSNEG + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: CINV + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: Z0M + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: SINWDIF2 + TYPE(c_ptr), VALUE :: RAORW + TYPE(c_ptr), VALUE :: WSTAR + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: SPOS + TYPE(c_ptr), VALUE :: XLLWS + REAL, VALUE :: ABMAX + REAL, VALUE :: ABMIN + REAL, VALUE :: ACDLIN + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: BCDLIN + REAL, VALUE :: BETAMAXOXKAPPA2 + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + REAL, VALUE :: EPSMIN + REAL, VALUE :: EPSUS + REAL, VALUE :: G + INTEGER(KIND=c_int), VALUE :: IAB + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: RNU + REAL, VALUE :: RNUM + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: SWELLF + REAL, VALUE :: SWELLF2 + REAL, VALUE :: SWELLF3 + REAL, VALUE :: SWELLF4 + REAL, VALUE :: SWELLF5 + REAL, VALUE :: SWELLF6 + REAL, VALUE :: SWELLF7 + REAL, VALUE :: SWELLF7M1 + TYPE(c_ptr), VALUE :: SWELLFT + REAL, VALUE :: TAUWSHELTER + TYPE(c_ptr), VALUE :: TH + REAL, VALUE :: WSPMIN + REAL, VALUE :: XKAPPA + REAL, VALUE :: Z0RAT + REAL, VALUE :: Z0TUBMAX + REAL, VALUE :: ZALP + REAL, VALUE :: ZPI + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SINPUT_ARD_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) +!$acc host_data use_device( FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, RAORW, WSTAR, RNFAC, FLD, & +!$acc & SL, SPOS, XLLWS, COSTH, DFIM, SINTH, SWELLFT, TH, ZPIFR ) + CALL SINPUT_ARD_iso_c(NGST, LLSNEG, KIJS, KIJL, c_loc(FL1), c_loc(WAVNUM), c_loc(CINV), c_loc(XK2CG), c_loc(WDWAVE), & + & c_loc(WSWAVE), c_loc(UFRIC), c_loc(Z0M), c_loc(COSWDIF), c_loc(SINWDIF2), c_loc(RAORW), c_loc(WSTAR), c_loc(RNFAC), & + & c_loc(FLD), c_loc(SL), c_loc(SPOS), c_loc(XLLWS), ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, & + & c_loc(COSTH), DELTH, c_loc(DFIM), EPSMIN, EPSUS, G, IAB, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, c_loc(SINTH), SWELLF, & + & SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, c_loc(SWELLFT), TAUWSHELTER, c_loc(TH), WSPMIN, XKAPPA, & + & Z0RAT, Z0TUBMAX, ZALP, ZPI, c_loc(ZPIFR), ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SINPUT_ARD_fc +END MODULE SINPUT_ARD_FC_MOD diff --git a/src/phys-scc-cuda/sinput_c.c b/src/phys-scc-cuda/sinput_c.c new file mode 100644 index 00000000..bbfbb208 --- /dev/null +++ b/src/phys-scc-cuda/sinput_c.c @@ -0,0 +1,53 @@ +#include +#include +#include +#include +#include +#include +#include "sinput_c.h" +#include "sinput_ard_c.h" +#include "sinput_jan_c.c" + +__device__ void sinput_c(int ngst, int llsneg, int kijs, int kijl, const double * fl1, + const double * wavnum, const double * cinv, const double * xk2cg, + const double * wdwave, const double * wswave, const double * ufric, + const double * z0m, const double * coswdif, const double * sinwdif2, + const double * raorw, const double * wstar, const double * rnfac, double * fld, + double * sl, double * spos, double * xllws, double abmax, double abmin, double acdlin, + double alphamax, double alphamin, double bcdlin, double betamaxoxkappa2, + const double * costh, double delth, const double * dfim, double epsmin, double epsus, + double g, int iab, int idamping, int iphys, int llgcbz0, int llnormagam, int nang, + int nfre, double rnu, double rnum, const double * sinth, double swellf, + double swellf2, double swellf3, double swellf4, double swellf5, double swellf6, + double swellf7, double swellf7m1, const double * swellft, double tauwshelter, + const double * th, double wspmin, double xkappa, double z0rat, double z0tubmax, + double zalp, double zpi, const double * zpifr, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + + + + switch (iphys) { + case 0: + sinput_jan_c(ngst, llsneg, kijs, kijl, fl1, wavnum, cinv, xk2cg, wswave, ufric, z0m, + coswdif, sinwdif2, raorw, wstar, rnfac, fld, sl, spos, xllws, acdlin, alphamax, + alphamin, bcdlin, betamaxoxkappa2, delth, epsus, g, idamping, llgcbz0, llnormagam, + nang, nfre, rnum, wspmin, xkappa, zalp, zpi, zpifr, ichnk, nchnk, ij); + break; + case 1: + sinput_ard_c(ngst, llsneg, kijs, kijl, fl1, wavnum, cinv, xk2cg, wdwave, wswave, + ufric, z0m, coswdif, sinwdif2, raorw, wstar, rnfac, fld, sl, spos, xllws, abmax, + abmin, acdlin, alphamax, alphamin, bcdlin, betamaxoxkappa2, costh, delth, dfim, + epsmin, epsus, g, iab, llgcbz0, llnormagam, nang, nfre, rnu, rnum, sinth, swellf, + swellf2, swellf3, swellf4, swellf5, swellf6, swellf7, swellf7m1, swellft, + tauwshelter, th, wspmin, xkappa, z0rat, z0tubmax, zalp, zpi, zpifr, ichnk, nchnk, + ij); + break; + } + + +} diff --git a/src/phys-scc-cuda/sinput_c.h b/src/phys-scc-cuda/sinput_c.h new file mode 100644 index 00000000..33e04292 --- /dev/null +++ b/src/phys-scc-cuda/sinput_c.h @@ -0,0 +1,23 @@ +#include +#include +#include +#include +#include +#include +#include "sinput_ard_c.h" +#include "sinput_jan_c.h" + +__device__ void sinput_c(int ngst, int llsneg, int kijs, int kijl, const double * fl1, + const double * wavnum, const double * cinv, const double * xk2cg, + const double * wdwave, const double * wswave, const double * ufric, + const double * z0m, const double * coswdif, const double * sinwdif2, + const double * raorw, const double * wstar, const double * rnfac, double * fld, + double * sl, double * spos, double * xllws, double abmax, double abmin, double acdlin, + double alphamax, double alphamin, double bcdlin, double betamaxoxkappa2, + const double * costh, double delth, const double * dfim, double epsmin, double epsus, + double g, int iab, int idamping, int iphys, int llgcbz0, int llnormagam, int nang, + int nfre, double rnu, double rnum, const double * sinth, double swellf, + double swellf2, double swellf3, double swellf4, double swellf5, double swellf6, + double swellf7, double swellf7m1, const double * swellft, double tauwshelter, + const double * th, double wspmin, double xkappa, double z0rat, double z0tubmax, + double zalp, double zpi, const double * zpifr, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/sinput_fc.F90 b/src/phys-scc-cuda/sinput_fc.F90 new file mode 100644 index 00000000..30067f0f --- /dev/null +++ b/src/phys-scc-cuda/sinput_fc.F90 @@ -0,0 +1,173 @@ +MODULE SINPUT_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SINPUT_fc (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, & + & RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, COSTH, DELTH, & + & DFIM, EPSMIN, EPSUS, G, IAB, IDAMPING, IPHYS, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH, SWELLF, SWELLF2, SWELLF3, & + & SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAUWSHELTER, TH, WSPMIN, XKAPPA, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPIFR, & + & ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NGST + LOGICAL, VALUE, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTERFACE + SUBROUTINE SINPUT_iso_c (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, & + & SINWDIF2, RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, & + & COSTH, DELTH, DFIM, EPSMIN, EPSUS, G, IAB, IDAMPING, IPHYS, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH, SWELLF, & + & SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAUWSHELTER, TH, WSPMIN, XKAPPA, Z0RAT, & + & Z0TUBMAX, ZALP, ZPI, ZPIFR, ICHNK, NCHNK, IJ) BIND(c, name="sinput_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: NGST + LOGICAL, VALUE :: LLSNEG + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: CINV + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: Z0M + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: SINWDIF2 + TYPE(c_ptr), VALUE :: RAORW + TYPE(c_ptr), VALUE :: WSTAR + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: SPOS + TYPE(c_ptr), VALUE :: XLLWS + REAL, VALUE :: ABMAX + REAL, VALUE :: ABMIN + REAL, VALUE :: ACDLIN + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: BCDLIN + REAL, VALUE :: BETAMAXOXKAPPA2 + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + REAL, VALUE :: EPSMIN + REAL, VALUE :: EPSUS + REAL, VALUE :: G + INTEGER(KIND=c_int), VALUE :: IAB + INTEGER(KIND=c_int), VALUE :: IDAMPING + INTEGER(KIND=c_int), VALUE :: IPHYS + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: RNU + REAL, VALUE :: RNUM + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: SWELLF + REAL, VALUE :: SWELLF2 + REAL, VALUE :: SWELLF3 + REAL, VALUE :: SWELLF4 + REAL, VALUE :: SWELLF5 + REAL, VALUE :: SWELLF6 + REAL, VALUE :: SWELLF7 + REAL, VALUE :: SWELLF7M1 + TYPE(c_ptr), VALUE :: SWELLFT + REAL, VALUE :: TAUWSHELTER + TYPE(c_ptr), VALUE :: TH + REAL, VALUE :: WSPMIN + REAL, VALUE :: XKAPPA + REAL, VALUE :: Z0RAT + REAL, VALUE :: Z0TUBMAX + REAL, VALUE :: ZALP + REAL, VALUE :: ZPI + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SINPUT_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) +!$acc host_data use_device( FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, RAORW, WSTAR, RNFAC, FLD, & +!$acc & SL, SPOS, XLLWS, COSTH, DFIM, SINTH, SWELLFT, TH, ZPIFR ) + CALL SINPUT_iso_c(NGST, LLSNEG, KIJS, KIJL, c_loc(FL1), c_loc(WAVNUM), c_loc(CINV), c_loc(XK2CG), c_loc(WDWAVE), & + & c_loc(WSWAVE), c_loc(UFRIC), c_loc(Z0M), c_loc(COSWDIF), c_loc(SINWDIF2), c_loc(RAORW), c_loc(WSTAR), c_loc(RNFAC), & + & c_loc(FLD), c_loc(SL), c_loc(SPOS), c_loc(XLLWS), ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, & + & c_loc(COSTH), DELTH, c_loc(DFIM), EPSMIN, EPSUS, G, IAB, IDAMPING, IPHYS, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, & + & c_loc(SINTH), SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, c_loc(SWELLFT), TAUWSHELTER, & + & c_loc(TH), WSPMIN, XKAPPA, Z0RAT, Z0TUBMAX, ZALP, ZPI, c_loc(ZPIFR), ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SINPUT_fc +END MODULE SINPUT_FC_MOD diff --git a/src/phys-scc-cuda/sinput_fc.intfb.h b/src/phys-scc-cuda/sinput_fc.intfb.h new file mode 100644 index 00000000..6c4750df --- /dev/null +++ b/src/phys-scc-cuda/sinput_fc.intfb.h @@ -0,0 +1,87 @@ +INTERFACE + SUBROUTINE SINPUT_FC (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WDWAVE, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, & + & RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ABMAX, ABMIN, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, COSTH, DELTH, & + & DFIM, EPSMIN, EPSUS, G, IAB, IDAMPING, IPHYS, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNU, RNUM, SINTH, SWELLF, SWELLF2, SWELLF3, & + & SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, SWELLFT, TAUWSHELTER, TH, WSPMIN, XKAPPA, Z0RAT, Z0TUBMAX, ZALP, ZPI, ZPIFR, & + & ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + USE SINPUT_ARD_FC_MOD, ONLY: SINPUT_ARD_FC, SINPUT_JAN_FC + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NGST + LOGICAL, VALUE, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ABMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IAB + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF3 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF4 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF5 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF6 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SWELLF7M1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SWELLFT(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0RAT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: Z0TUBMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + END SUBROUTINE SINPUT_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/sinput_jan_c.c b/src/phys-scc-cuda/sinput_jan_c.c new file mode 100644 index 00000000..219263f8 --- /dev/null +++ b/src/phys-scc-cuda/sinput_jan_c.c @@ -0,0 +1,196 @@ +#include +#include +#include +#include +#include +#include +#include "sinput_jan_c.h" +#include "wsigstar_c.c" + +__device__ void sinput_jan_c(int ngst, int llsneg, int kijs, int kijl, + const double * fl1, const double * wavnum, const double * cinv, const double * xk2cg, + const double * wswave, const double * ufric, const double * z0m, + const double * coswdif, const double * sinwdif2, const double * raorw, + const double * wstar, const double * rnfac, double * fld, double * sl, double * spos, + double * xllws, double acdlin, double alphamax, double alphamin, double bcdlin, + double betamaxoxkappa2, double delth, double epsus, double g, int idamping, + int llgcbz0, int llnormagam, int nang, int nfre, double rnum, double wspmin, + double xkappa, double zalp, double zpi, const double * zpifr, int ichnk, int nchnk, + int ij) { + + // Loki: parameters from YOWPARAM inlined + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int ig; + int k; + int m; + int igst; + + double const1; + double const3; + double xkappad; + double constn; + double znz; + double x; + double zlog; + double zlog2x; + double zbeta; + double tempd; + + double wsin[2]; + double ztanhkd; + double sig_n; + double cnsn; + double sumf; + double sumfsin2; + double cstrnfac; + double ufac1; + double ufac2; + double gamnorma[2]; // ! RENORMALISATION FACTOR OF THE GROWTH RATE + double sigdev[2]; + double us[2]; + double z0[2]; + double ucn[2]; + double zcn[2]; + double ustpm1[2]; + double xvd[2]; + double ucnd[2]; + double const3_ucn2[2]; + + int lz; + double gam0[36*2]; + + const1 = betamaxoxkappa2; + const3 = (double) 2.0*xkappa / const1; // SEE IDAMPING + xkappad = (double) 1.E0 / xkappa; + + const3 = idamping*const3; + + constn = delth / (xkappa*zpi); + + if (ngst > 1) { + wsigstar_c(wswave[ij - 1 + kijl*(ichnk - 1)], ufric[ij - 1 + kijl*(ichnk - 1)], + z0m[ij - 1 + kijl*(ichnk - 1)], wstar[ij - 1 + kijl*(ichnk - 1)], (&sig_n), + acdlin, alphamax, alphamin, bcdlin, epsus, g, llgcbz0, rnum, wspmin, xkappa); + } + if (ngst == 1) { + wsin[1 - 1] = (double) 1.0; + sigdev[1 - 1] = (double) 1.0; + } else { + wsin[1 - 1] = (double) 0.5; + wsin[2 - 1] = (double) 0.5; + sigdev[1 - 1] = (double) 1.0 - sig_n; + sigdev[2 - 1] = (double) 1.0 + sig_n; + } + if (ngst == 1) { + us[1 - 1] = ufric[ij - 1 + kijl*(ichnk - 1)]; + z0[1 - 1] = z0m[ij - 1 + kijl*(ichnk - 1)]; + } else { + for (igst = 1; igst <= ngst; igst += 1) { + us[igst - 1] = ufric[ij - 1 + kijl*(ichnk - 1)]*sigdev[igst - 1]; + z0[igst - 1] = z0m[ij - 1 + kijl*(ichnk - 1)]; + } + } + + for (igst = 1; igst <= ngst; igst += 1) { + ustpm1[igst - 1] = (double) 1.0 / max((double) (us[igst - 1]), (double) (epsus)); + } + for (m = 1; m <= nfre; m += 1) { + ztanhkd = (pow(zpifr[m - 1], 2)) / (g*wavnum[ij - 1 + kijl*(m - 1 + + nfre_loki_param*(ichnk - 1))]); + cnsn = const1*zpifr[m - 1]*ztanhkd*raorw[ij - 1]; + + for (igst = 1; igst <= ngst; igst += 1) { + ucn[igst - 1] = + us[igst - 1]*cinv[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))] + zalp; + const3_ucn2[igst - 1] = const3*(pow(ucn[igst - 1], 2)); + ucnd[igst - 1] = (double) 1.0 / ucn[igst - 1]; + zcn[igst - 1] = + log(wavnum[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]*z0[igst - 1]); + xvd[igst - 1] = (double) 1.0 / (-us[igst - 1]*xkappad*zcn[igst - 1]*cinv[ij - 1 + + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]); + } + for (k = 1; k <= nang; k += 1) { + xllws[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1))) + ] = (double) 0.0; + + for (igst = 1; igst <= ngst; igst += 1) { + + if (coswdif[ij - 1 + kijl*(k - 1)] > (double) 0.01) { + lz = true; + tempd = xkappa / coswdif[ij - 1 + kijl*(k - 1)]; + } else { + lz = false; + tempd = xkappa; + } + + gam0[igst - 1 + 2*(k - 1)] = (double) 0.0; + if (lz) { + zlog = zcn[igst - 1] + tempd*ucnd[igst - 1]; + if (zlog < (double) 0.0) { + x = coswdif[ij - 1 + kijl*(k - 1)]*ucn[igst - 1]; + zlog2x = zlog*zlog*x; + gam0[igst - 1 + 2*(k - 1)] = zlog2x*zlog2x*exp((double) (zlog))*cnsn; + xllws[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk + - 1)))] = (double) 1.0; + } + } + } + + } + if (llnormagam) { + + sumf = (double) 0.0; + sumfsin2 = (double) 0.0; + for (k = 1; k <= nang; k += 1) { + for (igst = 1; igst <= ngst; igst += 1) { + sumf = sumf + gam0[igst - 1 + 2*(k - 1)]*fl1[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + sumfsin2 = sumfsin2 + gam0[igst - 1 + 2*(k - 1)]*fl1[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]*sinwdif2[ij - 1 + + kijl*(k - 1)]; + } + + cstrnfac = constn*rnfac[ij - 1] / raorw[ij - 1]; + znz = cstrnfac*xk2cg[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1)) + ]*ustpm1[igst - 1]; + gamnorma[igst - 1] = ((double) 1.0 + znz*sumfsin2) / ((double) 1.0 + znz*sumf); + + } + } else { + for (igst = 1; igst <= ngst; igst += 1) { + gamnorma[igst - 1] = (double) 1.0; + } + } + + for (k = 1; k <= nang; k += 1) { + ufac1 = wsin[1 - 1]*gam0[1 - 1 + 2*(k - 1)]*gamnorma[1 - 1]; + for (igst = 2; igst <= ngst; igst += 1) { + ufac1 = ufac1 + wsin[igst - 1]*gam0[igst - 1 + 2*(k - 1)]*gamnorma[igst - 1]; + } + + ufac2 = (double) 0.0; + if (llsneg) { + // SWELL DAMPING: + zbeta = const3_ucn2[1 - 1]*(coswdif[ij - 1 + kijl*(k - 1)] - xvd[1 - 1]); + ufac2 = wsin[1 - 1]*zbeta; + for (igst = 2; igst <= ngst; igst += 1) { + zbeta = const3_ucn2[igst - 1]*(coswdif[ij - 1 + kijl*(k - 1)] - xvd[igst - 1]); + ufac2 = ufac2 + wsin[igst - 1]*zbeta; + } + } + + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = ufac1 + ufac2*cnsn; + spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = ufac1*fl1[ij - 1 + kijl*(k + - 1 + nang_loki_param*(m - 1 + nfre_loki_param*(ichnk - 1)))]; + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))] = fld[ij - 1 + kijl*(k - 1 + + nang_loki_param*(m - 1))]*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + } + } + + + +} diff --git a/src/phys-scc-cuda/sinput_jan_c.h b/src/phys-scc-cuda/sinput_jan_c.h new file mode 100644 index 00000000..7a5623f0 --- /dev/null +++ b/src/phys-scc-cuda/sinput_jan_c.h @@ -0,0 +1,18 @@ +#include +#include +#include +#include +#include +#include +#include "wsigstar_c.h" + +__device__ void sinput_jan_c(int ngst, int llsneg, int kijs, int kijl, + const double * fl1, const double * wavnum, const double * cinv, const double * xk2cg, + const double * wswave, const double * ufric, const double * z0m, + const double * coswdif, const double * sinwdif2, const double * raorw, + const double * wstar, const double * rnfac, double * fld, double * sl, double * spos, + double * xllws, double acdlin, double alphamax, double alphamin, double bcdlin, + double betamaxoxkappa2, double delth, double epsus, double g, int idamping, + int llgcbz0, int llnormagam, int nang, int nfre, double rnum, double wspmin, + double xkappa, double zalp, double zpi, const double * zpifr, int ichnk, int nchnk, + int ij); diff --git a/src/phys-scc-cuda/sinput_jan_fc.F90 b/src/phys-scc-cuda/sinput_jan_fc.F90 new file mode 100644 index 00000000..4b1f617a --- /dev/null +++ b/src/phys-scc-cuda/sinput_jan_fc.F90 @@ -0,0 +1,122 @@ +MODULE SINPUT_JAN_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SINPUT_JAN_fc (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, RAORW, & + & WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, DELTH, EPSUS, G, IDAMPING, LLGCBZ0, & + & LLNORMAGAM, NANG, NFRE, RNUM, WSPMIN, XKAPPA, ZALP, ZPI, ZPIFR, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NGST + LOGICAL, VALUE, INTENT(IN) :: LLSNEG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IDAMPING + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SINPUT_JAN_iso_c (NGST, LLSNEG, KIJS, KIJL, FL1, WAVNUM, CINV, XK2CG, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, & + & RAORW, WSTAR, RNFAC, FLD, SL, SPOS, XLLWS, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, DELTH, EPSUS, G, & + & IDAMPING, LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNUM, WSPMIN, XKAPPA, ZALP, ZPI, ZPIFR, ICHNK, NCHNK, IJ) & + & BIND(c, name="sinput_jan_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: NGST + LOGICAL, VALUE :: LLSNEG + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: CINV + TYPE(c_ptr), VALUE :: XK2CG + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: Z0M + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: SINWDIF2 + TYPE(c_ptr), VALUE :: RAORW + TYPE(c_ptr), VALUE :: WSTAR + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: SPOS + TYPE(c_ptr), VALUE :: XLLWS + REAL, VALUE :: ACDLIN + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: BCDLIN + REAL, VALUE :: BETAMAXOXKAPPA2 + REAL, VALUE :: DELTH + REAL, VALUE :: EPSUS + REAL, VALUE :: G + INTEGER(KIND=c_int), VALUE :: IDAMPING + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: RNUM + REAL, VALUE :: WSPMIN + REAL, VALUE :: XKAPPA + REAL, VALUE :: ZALP + REAL, VALUE :: ZPI + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE SINPUT_JAN_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK2CG(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RAORW(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: XLLWS(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) +!$acc host_data use_device( FL1, WAVNUM, CINV, XK2CG, WSWAVE, UFRIC, Z0M, COSWDIF, SINWDIF2, RAORW, WSTAR, RNFAC, FLD, SL, SPOS, & +!$acc & XLLWS, ZPIFR ) + CALL SINPUT_JAN_iso_c(NGST, LLSNEG, KIJS, KIJL, c_loc(FL1), c_loc(WAVNUM), c_loc(CINV), c_loc(XK2CG), c_loc(WSWAVE), & + & c_loc(UFRIC), c_loc(Z0M), c_loc(COSWDIF), c_loc(SINWDIF2), c_loc(RAORW), c_loc(WSTAR), c_loc(RNFAC), c_loc(FLD), & + & c_loc(SL), c_loc(SPOS), c_loc(XLLWS), ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, BETAMAXOXKAPPA2, DELTH, EPSUS, G, IDAMPING, & + & LLGCBZ0, LLNORMAGAM, NANG, NFRE, RNUM, WSPMIN, XKAPPA, ZALP, ZPI, c_loc(ZPIFR), ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE SINPUT_JAN_fc +END MODULE SINPUT_JAN_FC_MOD diff --git a/src/phys-scc-cuda/snonlin.c_hoist.F90 b/src/phys-scc-cuda/snonlin.c_hoist.F90 new file mode 100644 index 00000000..582d1109 --- /dev/null +++ b/src/phys-scc-cuda/snonlin.c_hoist.F90 @@ -0,0 +1,480 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE SNONLIN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN, AF11, BATHYMAX, COSTH, DAL1, DAL2, & +& DELTH, DFIM, DFIMFR, DFIMFR2, DKMAX, FKLAM, FKLAM1, FKLAP, FKLAP1, FR, FRATIO, G, GM1, IKM, IKM1, IKP, IKP1, INLCOEF, & +& ISNONLIN, K11W, K1W, K21W, K2W, KFRH, MFRSTLW, MLSTHG, NANG, NFRE, RNLCOEF, SINTH, TH, WETAIL, WP1TAIL, WP2TAIL, XKDMIN, & +& ZPIFR, ICHNK, NCHNK, IJ, ENH, XNU, SIG_TH) + + ! ---------------------------------------------------------------------- + + !**** *SNONLIN* - COMPUTATION OF NONLINEAR TRANSFER RATE AND ITS + !**** FUNCTIONAL DERIVATIVE (DIAGONAL TERMS ONLY) AND + !**** ADDITION TO CORRESPONDING NET EXPRESSIONS. + + ! S.D. HASSELMANN. MPI + + ! G. KOMEN, P. JANSSEN KNMI MODIFIED TO SHALLOW WATER + ! H. GUENTHER, L. ZAMBRESKY OPTIMIZED + ! H. GUENTHER GKSS/ECMWF JUNE 1991 INTERACTIONS BETWEEN DIAG- + ! AND PROGNOSTIC PART. + ! J. BIDLOT ECMWF FEBRUARY 1997 ADD SL IN SUBROUTINE CALL + ! P. JANSSEN ECMWF JUNE 2005 IMPROVED SCALING IN SHALLOW + ! WATER + ! J. BIDLOT ECMWF AUGUST 2006 KEEP THE OLD FORMULATION + ! UNDER A SWITCH (ISNONLIN = 0 for OLD + ! = 1 for NEW + ! BE AWARE THAT THE OLD FORMULATION + ! REQUIRES THE MEAN WAVE NUMBER AKMEAN. + ! J. BIDLOT ECMWF JANUARY 2012 ADD EXTENSION TO LOW FREQUENCIES + ! OPTIMISATION FOR IBM. + + !* PURPOSE. + ! -------- + + ! SEE ABOVE. + + !** INTERFACE. + ! ---------- + + ! *CALL* *SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN)* + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *FL1* - SPECTRUM. + ! *FLD* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE + ! *SL* - TOTAL SOURCE FUNCTION ARRAY. + ! *WAVNUM* - WAVE NUMBER. + ! *DEPTH* - WATER DEPTH. + ! *AKMEAN* - MEAN WAVE NUMBER BASED ON sqrt(1/k)*F INTGRATION + + ! METHOD. + ! ------- + + ! NONE. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! NONE. + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE PEAK_ANG_FC (KIJS, KIJL, FL1, XNU, SIG_TH) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: XNU, SIG_TH + END SUBROUTINE PEAK_ANG_FC + END INTERFACE + INTERFACE + FUNCTION TRANSF_FC (XK, D) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: TRANSF + REAL(KIND=JWRB), INTENT(IN) :: XK, D + END FUNCTION TRANSF_FC + END INTERFACE + INTERFACE + FUNCTION TRANSF_SNL_FC (XK0, D, XNU, SIG_TH) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: TRANSF_SNL + REAL(KIND=JWRB), INTENT(IN) :: XK0, D, XNU, SIG_TH + END FUNCTION TRANSF_SNL_FC + END INTERFACE + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), PARAMETER :: NRNL = 25 + INTEGER(KIND=JWIM), PARAMETER :: NINL = 5 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AKMEAN(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: MC + INTEGER(KIND=JWIM) :: KH + INTEGER(KIND=JWIM) :: K1 + INTEGER(KIND=JWIM) :: K2 + INTEGER(KIND=JWIM) :: K11 + INTEGER(KIND=JWIM) :: K21 + INTEGER(KIND=JWIM) :: MP + INTEGER(KIND=JWIM) :: MP1 + INTEGER(KIND=JWIM) :: MM + INTEGER(KIND=JWIM) :: MM1 + INTEGER(KIND=JWIM) :: IC + INTEGER(KIND=JWIM) :: IP + INTEGER(KIND=JWIM) :: IP1 + INTEGER(KIND=JWIM) :: IM + INTEGER(KIND=JWIM) :: IM1 + INTEGER(KIND=JWIM) :: MFR1STFR + INTEGER(KIND=JWIM) :: MFRLSTFR + + REAL(KIND=JWRB), PARAMETER :: ENH_MAX = 10.0_JWRB + REAL(KIND=JWRB), PARAMETER :: ENH_MIN = 0.1_JWRB ! to prevent ENH to become too small + REAL(KIND=JWRB) :: XK + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: ENH(:, :, :) + + REAL(KIND=JWRB) :: FTAIL + REAL(KIND=JWRB) :: FKLAMP + REAL(KIND=JWRB) :: GW1 + REAL(KIND=JWRB) :: GW2 + REAL(KIND=JWRB) :: GW3 + REAL(KIND=JWRB) :: GW4 + REAL(KIND=JWRB) :: FKLAMPA + REAL(KIND=JWRB) :: FKLAMPB + REAL(KIND=JWRB) :: FKLAMP2 + REAL(KIND=JWRB) :: FKLAMP1 + REAL(KIND=JWRB) :: FKLAPA2 + REAL(KIND=JWRB) :: FKLAPB2 + REAL(KIND=JWRB) :: FKLAP12 + REAL(KIND=JWRB) :: FKLAP22 + REAL(KIND=JWRB) :: FKLAMM + REAL(KIND=JWRB) :: FKLAMM1 + REAL(KIND=JWRB) :: GW5 + REAL(KIND=JWRB) :: GW6 + REAL(KIND=JWRB) :: GW7 + REAL(KIND=JWRB) :: GW8 + REAL(KIND=JWRB) :: FKLAMMA + REAL(KIND=JWRB) :: FKLAMMB + REAL(KIND=JWRB) :: FKLAMM2 + REAL(KIND=JWRB) :: FKLAMA2 + REAL(KIND=JWRB) :: FKLAMB2 + REAL(KIND=JWRB) :: FKLAM12 + REAL(KIND=JWRB) :: FKLAM22 + REAL(KIND=JWRB) :: SAP + REAL(KIND=JWRB) :: SAM + REAL(KIND=JWRB) :: FIJ + REAL(KIND=JWRB) :: FAD1 + REAL(KIND=JWRB) :: FAD2 + REAL(KIND=JWRB) :: FCEN + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XNU(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SIG_TH(:, :) + REAL(KIND=JWRB) :: FTEMP + REAL(KIND=JWRB) :: AD + REAL(KIND=JWRB) :: DELAD + REAL(KIND=JWRB) :: DELAP + REAL(KIND=JWRB) :: DELAM + REAL(KIND=JWRB) :: ENHFR + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AF11(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DKMAX + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INLCOEF(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ISNONLIN + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K11W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K1W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K21W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K2W(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KFRH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MFRSTLW + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MLSTHG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNLCOEF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKDMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + + ! ---------------------------------------------------------------------- + + + + !* 1. SHALLOW WATER SCALING + ! --------------------- + + SELECT CASE (ISNONLIN) + CASE (0) + + ENHFR = MAX(0.75_JWRB*DEPTH(IJ, ICHNK)*AKMEAN(IJ), 0.5_JWRB) + ENHFR = 1.0_JWRB + (5.5_JWRB / ENHFR)*(1.0_JWRB - .833_JWRB*ENHFR)*EXP(-1.25_JWRB*ENHFR) + DO MC=1,MLSTHG + ENH(IJ, MC, ICHNK) = ENHFR + END DO + + + CASE (1) + + DO MC=1,NFRE + ENH(IJ, MC, ICHNK) = MAX(MIN(ENH_MAX, TRANSF_FC(WAVNUM(IJ, MC, ICHNK), DEPTH(IJ, ICHNK), DKMAX, G)), ENH_MIN) + END DO + DO MC=NFRE + 1,MLSTHG + XK = GM1*(ZPIFR(NFRE)*FRATIO**(MC - NFRE))**2 + ENH(IJ, MC, ICHNK) = MAX(MIN(ENH_MAX, TRANSF_FC(XK, DEPTH(IJ, ICHNK), DKMAX, G)), ENH_MIN) + END DO + + + CASE (2) + CALL PEAK_ANG_FC(KIJS, KIJL, FL1(:, :, :, :), XNU(:, ICHNK), SIG_TH(:, ICHNK), COSTH(:), DELTH, DFIM(:), DFIMFR(:), & + & DFIMFR2(:), FR(:), FRATIO, NANG, NFRE, SINTH(:), TH(:), WETAIL, WP1TAIL, WP2TAIL, ICHNK, NCHNK, IJ) + + DO MC=1,NFRE + ENH(IJ, MC, ICHNK) = & + & TRANSF_SNL_FC(WAVNUM(IJ, MC, ICHNK), DEPTH(IJ, ICHNK), XNU(IJ, ICHNK), SIG_TH(IJ, ICHNK), BATHYMAX, DKMAX, G, XKDMIN) + END DO + DO MC=NFRE + 1,MLSTHG + XK = GM1*(ZPIFR(NFRE)*FRATIO**(MC - NFRE))**2 + ENH(IJ, MC, ICHNK) = TRANSF_SNL_FC(XK, DEPTH(IJ, ICHNK), XNU(IJ, ICHNK), SIG_TH(IJ, ICHNK), BATHYMAX, DKMAX, G, XKDMIN) + END DO + + END SELECT + + + !* 2. FREQUENCY LOOP. + ! --------------- + + MFR1STFR = -MFRSTLW + 1 + MFRLSTFR = NFRE - KFRH + MFR1STFR + + + DO MC=1,MLSTHG + MP = IKP(MC) + MP1 = IKP1(MC) + MM = IKM(MC) + MM1 = IKM1(MC) + IC = INLCOEF(1, MC) + IP = INLCOEF(2, MC) + IP1 = INLCOEF(3, MC) + IM = INLCOEF(4, MC) + IM1 = INLCOEF(5, MC) + + FTAIL = RNLCOEF(1, MC) + + FKLAMP = FKLAP(MC) + FKLAMP1 = FKLAP1(MC) + GW1 = RNLCOEF(2, MC) + GW2 = RNLCOEF(3, MC) + GW3 = RNLCOEF(4, MC) + GW4 = RNLCOEF(5, MC) + FKLAMPA = RNLCOEF(6, MC) + FKLAMPB = RNLCOEF(7, MC) + FKLAMP2 = RNLCOEF(8, MC) + FKLAMP1 = RNLCOEF(9, MC) + FKLAPA2 = RNLCOEF(10, MC) + FKLAPB2 = RNLCOEF(11, MC) + FKLAP12 = RNLCOEF(12, MC) + FKLAP22 = RNLCOEF(13, MC) + + FKLAMM = FKLAM(MC) + FKLAMM1 = FKLAM1(MC) + GW5 = RNLCOEF(14, MC) + GW6 = RNLCOEF(15, MC) + GW7 = RNLCOEF(16, MC) + GW8 = RNLCOEF(17, MC) + FKLAMMA = RNLCOEF(18, MC) + FKLAMMB = RNLCOEF(19, MC) + FKLAMM2 = RNLCOEF(20, MC) + FKLAMM1 = RNLCOEF(21, MC) + FKLAMA2 = RNLCOEF(22, MC) + FKLAMB2 = RNLCOEF(23, MC) + FKLAM12 = RNLCOEF(24, MC) + FKLAM22 = RNLCOEF(25, MC) + + FTEMP = AF11(MC)*ENH(IJ, MC, ICHNK) + + + IF (MC > MFR1STFR .and. MC < MFRLSTFR) THEN + ! the interactions for MC are all within the fully resolved spectral domain + + DO KH=1,2 + DO K=1,NANG + K1 = K1W(K, KH) + K2 = K2W(K, KH) + K11 = K11W(K, KH) + K21 = K21W(K, KH) + + !* 2.1.1.1 LOOP OVER GRIDPOINTS.. NONLINEAR TRANSFER AND + !* DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE. + ! ---------------------------------------------- + SAP = & + & GW1*FL1(IJ, K1, IP, ICHNK) + GW2*FL1(IJ, K11, IP, ICHNK) + GW3*FL1(IJ, K1, IP1, ICHNK) + GW4*FL1(IJ, K11, IP1, ICHNK) + SAM = & + & GW5*FL1(IJ, K2, IM, ICHNK) + GW6*FL1(IJ, K21, IM, ICHNK) + GW7*FL1(IJ, K2, IM1, ICHNK) + GW8*FL1(IJ, K21, IM1, ICHNK) + !!!! not needed ftail always=1. FIJ = FL1(IJ,K ,IC )*FTAIL + FIJ = FL1(IJ, K, IC, ICHNK) + FAD1 = FIJ*(SAP + SAM) + FAD2 = FAD1 - 2.0_JWRB*SAP*SAM + FAD1 = FAD1 + FAD2 + FCEN = FTEMP*FIJ + AD = FAD2*FCEN + DELAD = FAD1*FTEMP + DELAP = (FIJ - 2.0_JWRB*SAM)*DAL1*FCEN + DELAM = (FIJ - 2.0_JWRB*SAP)*DAL2*FCEN + + SL(IJ, K, MC) = SL(IJ, K, MC) - 2.0_JWRB*AD + FLD(IJ, K, MC) = FLD(IJ, K, MC) - 2.0_JWRB*DELAD + SL(IJ, K2, MM) = SL(IJ, K2, MM) + AD*FKLAMM1 + FLD(IJ, K2, MM) = FLD(IJ, K2, MM) + DELAM*FKLAM12 + SL(IJ, K21, MM) = SL(IJ, K21, MM) + AD*FKLAMM2 + FLD(IJ, K21, MM) = FLD(IJ, K21, MM) + DELAM*FKLAM22 + SL(IJ, K2, MM1) = SL(IJ, K2, MM1) + AD*FKLAMMA + FLD(IJ, K2, MM1) = FLD(IJ, K2, MM1) + DELAM*FKLAMA2 + SL(IJ, K21, MM1) = SL(IJ, K21, MM1) + AD*FKLAMMB + FLD(IJ, K21, MM1) = FLD(IJ, K21, MM1) + DELAM*FKLAMB2 + SL(IJ, K1, MP) = SL(IJ, K1, MP) + AD*FKLAMP1 + FLD(IJ, K1, MP) = FLD(IJ, K1, MP) + DELAP*FKLAP12 + SL(IJ, K11, MP) = SL(IJ, K11, MP) + AD*FKLAMP2 + FLD(IJ, K11, MP) = FLD(IJ, K11, MP) + DELAP*FKLAP22 + SL(IJ, K1, MP1) = SL(IJ, K1, MP1) + AD*FKLAMPA + FLD(IJ, K1, MP1) = FLD(IJ, K1, MP1) + DELAP*FKLAPA2 + SL(IJ, K11, MP1) = SL(IJ, K11, MP1) + AD*FKLAMPB + FLD(IJ, K11, MP1) = FLD(IJ, K11, MP1) + DELAP*FKLAPB2 + END DO + END DO + + ELSE IF (MC >= MFRLSTFR) THEN + DO KH=1,2 + DO K=1,NANG + K1 = K1W(K, KH) + K2 = K2W(K, KH) + K11 = K11W(K, KH) + K21 = K21W(K, KH) + + SAP = & + & GW1*FL1(IJ, K1, IP, ICHNK) + GW2*FL1(IJ, K11, IP, ICHNK) + GW3*FL1(IJ, K1, IP1, ICHNK) + GW4*FL1(IJ, K11, IP1, ICHNK) + SAM = & + & GW5*FL1(IJ, K2, IM, ICHNK) + GW6*FL1(IJ, K21, IM, ICHNK) + GW7*FL1(IJ, K2, IM1, ICHNK) + GW8*FL1(IJ, K21, IM1, ICHNK) + FIJ = FL1(IJ, K, IC, ICHNK)*FTAIL + FAD1 = FIJ*(SAP + SAM) + FAD2 = FAD1 - 2.0_JWRB*SAP*SAM + FAD1 = FAD1 + FAD2 + FCEN = FTEMP*FIJ + AD = FAD2*FCEN + DELAD = FAD1*FTEMP + DELAP = (FIJ - 2.0_JWRB*SAM)*DAL1*FCEN + DELAM = (FIJ - 2.0_JWRB*SAP)*DAL2*FCEN + + SL(IJ, K2, MM) = SL(IJ, K2, MM) + AD*FKLAMM1 + FLD(IJ, K2, MM) = FLD(IJ, K2, MM) + DELAM*FKLAM12 + SL(IJ, K21, MM) = SL(IJ, K21, MM) + AD*FKLAMM2 + FLD(IJ, K21, MM) = FLD(IJ, K21, MM) + DELAM*FKLAM22 + + IF (MM1 <= NFRE) THEN + SL(IJ, K2, MM1) = SL(IJ, K2, MM1) + AD*FKLAMMA + FLD(IJ, K2, MM1) = FLD(IJ, K2, MM1) + DELAM*FKLAMA2 + SL(IJ, K21, MM1) = SL(IJ, K21, MM1) + AD*FKLAMMB + FLD(IJ, K21, MM1) = FLD(IJ, K21, MM1) + DELAM*FKLAMB2 + + IF (MC <= NFRE) THEN + SL(IJ, K, MC) = SL(IJ, K, MC) - 2.0_JWRB*AD + FLD(IJ, K, MC) = FLD(IJ, K, MC) - 2.0_JWRB*DELAD + + IF (MP <= NFRE) THEN + SL(IJ, K1, MP) = SL(IJ, K1, MP) + AD*FKLAMP1 + FLD(IJ, K1, MP) = FLD(IJ, K1, MP) + DELAP*FKLAP12 + SL(IJ, K11, MP) = SL(IJ, K11, MP) + AD*FKLAMP2 + FLD(IJ, K11, MP) = FLD(IJ, K11, MP) + DELAP*FKLAP22 + + IF (MP1 <= NFRE) THEN + SL(IJ, K1, MP1) = SL(IJ, K1, MP1) + AD*FKLAMPA + FLD(IJ, K1, MP1) = FLD(IJ, K1, MP1) + DELAP*FKLAPA2 + SL(IJ, K11, MP1) = SL(IJ, K11, MP1) + AD*FKLAMPB + FLD(IJ, K11, MP1) = FLD(IJ, K11, MP1) + DELAP*FKLAPB2 + END IF + END IF + END IF + END IF + END DO + END DO + + ELSE + + DO KH=1,2 + DO K=1,NANG + K1 = K1W(K, KH) + K2 = K2W(K, KH) + K11 = K11W(K, KH) + K21 = K21W(K, KH) + + SAP = & + & GW1*FL1(IJ, K1, IP, ICHNK) + GW2*FL1(IJ, K11, IP, ICHNK) + GW3*FL1(IJ, K1, IP1, ICHNK) + GW4*FL1(IJ, K11, IP1, ICHNK) + SAM = & + & GW5*FL1(IJ, K2, IM, ICHNK) + GW6*FL1(IJ, K21, IM, ICHNK) + GW7*FL1(IJ, K2, IM1, ICHNK) + GW8*FL1(IJ, K21, IM1, ICHNK) + FIJ = FL1(IJ, K, IC, ICHNK)*FTAIL + FAD1 = FIJ*(SAP + SAM) + FAD2 = FAD1 - 2.0_JWRB*SAP*SAM + FAD1 = FAD1 + FAD2 + FCEN = FTEMP*FIJ + AD = FAD2*FCEN + DELAD = FAD1*FTEMP + DELAP = (FIJ - 2.0_JWRB*SAM)*DAL1*FCEN + DELAM = (FIJ - 2.0_JWRB*SAP)*DAL2*FCEN + + IF (MM1 >= 1) THEN + SL(IJ, K2, MM1) = SL(IJ, K2, MM1) + AD*FKLAMMA + FLD(IJ, K2, MM1) = FLD(IJ, K2, MM1) + DELAM*FKLAMA2 + SL(IJ, K21, MM1) = SL(IJ, K21, MM1) + AD*FKLAMMB + FLD(IJ, K21, MM1) = FLD(IJ, K21, MM1) + DELAM*FKLAMB2 + END IF + + SL(IJ, K, MC) = SL(IJ, K, MC) - 2.0_JWRB*AD + FLD(IJ, K, MC) = FLD(IJ, K, MC) - 2.0_JWRB*DELAD + SL(IJ, K1, MP) = SL(IJ, K1, MP) + AD*FKLAMP1 + FLD(IJ, K1, MP) = FLD(IJ, K1, MP) + DELAP*FKLAP12 + SL(IJ, K11, MP) = SL(IJ, K11, MP) + AD*FKLAMP2 + FLD(IJ, K11, MP) = FLD(IJ, K11, MP) + DELAP*FKLAP22 + SL(IJ, K1, MP1) = SL(IJ, K1, MP1) + AD*FKLAMPA + FLD(IJ, K1, MP1) = FLD(IJ, K1, MP1) + DELAP*FKLAPA2 + SL(IJ, K11, MP1) = SL(IJ, K11, MP1) + AD*FKLAMPB + FLD(IJ, K11, MP1) = FLD(IJ, K11, MP1) + DELAP*FKLAPB2 + END DO + END DO + + END IF + + !* BRANCH BACK TO 2. FOR NEXT FREQUENCY. + + END DO + + + +END SUBROUTINE SNONLIN_FC diff --git a/src/phys-scc-cuda/snonlin_c.c b/src/phys-scc-cuda/snonlin_c.c new file mode 100644 index 00000000..8700b120 --- /dev/null +++ b/src/phys-scc-cuda/snonlin_c.c @@ -0,0 +1,419 @@ +#include +#include +#include +#include +#include +#include +#include "snonlin_c.h" +#include "transf_snl_c.h" +#include "transf_c.h" +#include "peak_ang_c.h" + +__device__ void snonlin_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * wavnum, const double * depth, const double * akmean, + const double * af11, double bathymax, const double * costh, double dal1, double dal2, + double delth, const double * dfim, const double * dfimfr, const double * dfimfr2, + double dkmax, const double * fklam, const double * fklam1, const double * fklap, + const double * fklap1, const double * fr, double fratio, double g, double gm1, + const int * ikm, const int * ikm1, const int * ikp, const int * ikp1, + const int * inlcoef, int isnonlin, const int * k11w, const int * k1w, + const int * k21w, const int * k2w, int kfrh, int mfrstlw, int mlsthg, int nang, + int nfre, const double * rnlcoef, const double * sinth, const double * th, + double wetail, double wp1tail, double wp2tail, double xkdmin, const double * zpifr, + int ichnk, int nchnk, int ij, double * enh, double * xnu, double * sig_th) { + + + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + const int nrnl = 25; + const int ninl = 5; + int k; + int m; + int mc; + int kh; + int k1; + int k2; + int k11; + int k21; + int mp; + int mp1; + int mm; + int mm1; + int ic; + int ip; + int ip1; + int im; + int im1; + int mfr1stfr; + int mfrlstfr; + + double enh_max = (double) 10.0; + double enh_min = (double) 0.1; // to prevent ENH to become too small + double xk; + + double ftail; + double fklamp; + double gw1; + double gw2; + double gw3; + double gw4; + double fklampa; + double fklampb; + double fklamp2; + double fklamp1; + double fklapa2; + double fklapb2; + double fklap12; + double fklap22; + double fklamm; + double fklamm1; + double gw5; + double gw6; + double gw7; + double gw8; + double fklamma; + double fklammb; + double fklamm2; + double fklama2; + double fklamb2; + double fklam12; + double fklam22; + double sap; + double sam; + double fij; + double fad1; + double fad2; + double fcen; + + double ftemp; + double ad; + double delad; + double delap; + double delam; + double enhfr; + switch (isnonlin) { + case 0: + + enhfr = max((double) ((double) 0.75*depth[ij - 1 + kijl*(ichnk - 1)]*akmean[ij - 1]), + (double) ((double) 0.5)); + enhfr = (double) 1.0 + ((double) 5.5 / enhfr)*((double) 1.0 - (double) .833*enhfr) + *exp((double) (-(double) 1.25*enhfr)); + for (mc = 1; mc <= mlsthg; mc += 1) { + enh[ij - 1 + kijl*(mc - 1 + mlsthg*(ichnk - 1))] = enhfr; + } + + + break; + case 1: + + for (mc = 1; mc <= nfre; mc += 1) { + enh[ij - 1 + kijl*(mc - 1 + mlsthg*(ichnk - 1))] = max((double) (min((double) + (enh_max), (double) (transf_c(wavnum[ij - 1 + kijl*(mc - 1 + + nfre_loki_param*(ichnk - 1))], depth[ij - 1 + kijl*(ichnk - 1)], dkmax, g)))), + (double) (enh_min)); + } + for (mc = nfre + 1; mc <= mlsthg; mc += 1) { + xk = gm1*(pow((zpifr[nfre - 1]*(pow(fratio, (mc - nfre)))), 2)); + enh[ij - 1 + kijl*(mc - 1 + mlsthg*(ichnk - 1))] = max((double) (min((double) + (enh_max), (double) (transf_c(xk, depth[ij - 1 + kijl*(ichnk - 1)], dkmax, g)))), + (double) (enh_min)); + } + + + break; + case 2: + peak_ang_c(kijs, kijl, fl1, (&xnu[ + kijl*(ichnk - 1)]), + (&sig_th[ + kijl*(ichnk - 1)]), costh, delth, dfim, dfimfr, dfimfr2, fr, fratio, + nang, nfre, sinth, th, wetail, wp1tail, wp2tail, ichnk, nchnk, ij); + + for (mc = 1; mc <= nfre; mc += 1) { + enh[ij - 1 + kijl*(mc - 1 + mlsthg*(ichnk - 1))] = transf_snl_c(wavnum[ij - 1 + + kijl*(mc - 1 + nfre_loki_param*(ichnk - 1))], depth[ij - 1 + kijl*(ichnk - 1)], + xnu[ij - 1 + kijl*(ichnk - 1)], sig_th[ij - 1 + kijl*(ichnk - 1)], bathymax, + dkmax, g, xkdmin); + } + for (mc = nfre + 1; mc <= mlsthg; mc += 1) { + xk = gm1*(pow((zpifr[nfre - 1]*(pow(fratio, (mc - nfre)))), 2)); + enh[ij - 1 + kijl*(mc - 1 + mlsthg*(ichnk - 1))] = transf_snl_c(xk, depth[ij - 1 + + kijl*(ichnk - 1)], xnu[ij - 1 + kijl*(ichnk - 1)], sig_th[ij - 1 + kijl*(ichnk - + 1)], bathymax, dkmax, g, xkdmin); + } + + break; + } + mfr1stfr = -mfrstlw + 1; + mfrlstfr = nfre - kfrh + mfr1stfr; + + + for (mc = 1; mc <= mlsthg; mc += 1) { + mp = ikp[1 + mc - mfrstlw - 1]; + mp1 = ikp1[1 + mc - mfrstlw - 1]; + mm = ikm[1 + mc - mfrstlw - 1]; + mm1 = ikm1[1 + mc - mfrstlw - 1]; + ic = inlcoef[1 - 1 + ninl*(mc - 1)]; + ip = inlcoef[2 - 1 + ninl*(mc - 1)]; + ip1 = inlcoef[3 - 1 + ninl*(mc - 1)]; + im = inlcoef[4 - 1 + ninl*(mc - 1)]; + im1 = inlcoef[5 - 1 + ninl*(mc - 1)]; + + ftail = rnlcoef[1 - 1 + nrnl*(mc - 1)]; + + fklamp = fklap[1 + mc - mfrstlw - 1]; + fklamp1 = fklap1[1 + mc - mfrstlw - 1]; + gw1 = rnlcoef[2 - 1 + nrnl*(mc - 1)]; + gw2 = rnlcoef[3 - 1 + nrnl*(mc - 1)]; + gw3 = rnlcoef[4 - 1 + nrnl*(mc - 1)]; + gw4 = rnlcoef[5 - 1 + nrnl*(mc - 1)]; + fklampa = rnlcoef[6 - 1 + nrnl*(mc - 1)]; + fklampb = rnlcoef[7 - 1 + nrnl*(mc - 1)]; + fklamp2 = rnlcoef[8 - 1 + nrnl*(mc - 1)]; + fklamp1 = rnlcoef[9 - 1 + nrnl*(mc - 1)]; + fklapa2 = rnlcoef[10 - 1 + nrnl*(mc - 1)]; + fklapb2 = rnlcoef[11 - 1 + nrnl*(mc - 1)]; + fklap12 = rnlcoef[12 - 1 + nrnl*(mc - 1)]; + fklap22 = rnlcoef[13 - 1 + nrnl*(mc - 1)]; + + fklamm = fklam[1 + mc - mfrstlw - 1]; + fklamm1 = fklam1[1 + mc - mfrstlw - 1]; + gw5 = rnlcoef[14 - 1 + nrnl*(mc - 1)]; + gw6 = rnlcoef[15 - 1 + nrnl*(mc - 1)]; + gw7 = rnlcoef[16 - 1 + nrnl*(mc - 1)]; + gw8 = rnlcoef[17 - 1 + nrnl*(mc - 1)]; + fklamma = rnlcoef[18 - 1 + nrnl*(mc - 1)]; + fklammb = rnlcoef[19 - 1 + nrnl*(mc - 1)]; + fklamm2 = rnlcoef[20 - 1 + nrnl*(mc - 1)]; + fklamm1 = rnlcoef[21 - 1 + nrnl*(mc - 1)]; + fklama2 = rnlcoef[22 - 1 + nrnl*(mc - 1)]; + fklamb2 = rnlcoef[23 - 1 + nrnl*(mc - 1)]; + fklam12 = rnlcoef[24 - 1 + nrnl*(mc - 1)]; + fklam22 = rnlcoef[25 - 1 + nrnl*(mc - 1)]; + + ftemp = af11[1 + mc - mfrstlw - 1]*enh[ij - 1 + kijl*(mc - 1 + mlsthg*(ichnk - 1))]; + if (mc > mfr1stfr && mc < mfrlstfr) { + for (kh = 1; kh <= 2; kh += 1) { + for (k = 1; k <= nang; k += 1) { + k1 = k1w[k - 1 + nang_loki_param*(kh - 1)]; + k2 = k2w[k - 1 + nang_loki_param*(kh - 1)]; + k11 = k11w[k - 1 + nang_loki_param*(kh - 1)]; + k21 = k21w[k - 1 + nang_loki_param*(kh - 1)]; + sap = gw1*fl1[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(ip - 1 + + nfre_loki_param*(ichnk - 1)))] + gw2*fl1[ij - 1 + kijl*(k11 - 1 + + nang_loki_param*(ip - 1 + nfre_loki_param*(ichnk - 1)))] + gw3*fl1[ij - 1 + + kijl*(k1 - 1 + nang_loki_param*(ip1 - 1 + nfre_loki_param*(ichnk - 1)))] + + gw4*fl1[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(ip1 - 1 + + nfre_loki_param*(ichnk - 1)))]; + sam = gw5*fl1[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(im - 1 + + nfre_loki_param*(ichnk - 1)))] + gw6*fl1[ij - 1 + kijl*(k21 - 1 + + nang_loki_param*(im - 1 + nfre_loki_param*(ichnk - 1)))] + gw7*fl1[ij - 1 + + kijl*(k2 - 1 + nang_loki_param*(im1 - 1 + nfre_loki_param*(ichnk - 1)))] + + gw8*fl1[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(im1 - 1 + + nfre_loki_param*(ichnk - 1)))]; + //!!! not needed ftail always=1. FIJ = FL1(IJ,K ,IC )*FTAIL + fij = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(ic - 1 + + nfre_loki_param*(ichnk - 1)))]; + fad1 = fij*(sap + sam); + fad2 = fad1 - (double) 2.0*sap*sam; + fad1 = fad1 + fad2; + fcen = ftemp*fij; + ad = fad2*fcen; + delad = fad1*ftemp; + delap = (fij - (double) 2.0*sam)*dal1*fcen; + delam = (fij - (double) 2.0*sap)*dal2*fcen; + + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] = + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] - (double) 2.0*ad; + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] = + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] - (double) 2.0*delad; + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] = + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] + ad*fklamm1; + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] = + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] + delam*fklam12; + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] = + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] + ad*fklamm2; + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] = + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] + delam*fklam22; + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] = + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] + ad*fklamma; + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] = + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] + delam*fklama2; + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] = + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] + ad*fklammb; + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] = + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] + delam*fklamb2; + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] = + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] + ad*fklamp1; + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] = + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] + delap*fklap12; + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] = + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] + ad*fklamp2; + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] = + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] + delap*fklap22; + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] = + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] + ad*fklampa; + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] = + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] + delap*fklapa2; + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] = + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] + ad*fklampb; + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] = + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] + delap*fklapb2; + } + } + + } else if (mc >= mfrlstfr) { + for (kh = 1; kh <= 2; kh += 1) { + for (k = 1; k <= nang; k += 1) { + k1 = k1w[k - 1 + nang_loki_param*(kh - 1)]; + k2 = k2w[k - 1 + nang_loki_param*(kh - 1)]; + k11 = k11w[k - 1 + nang_loki_param*(kh - 1)]; + k21 = k21w[k - 1 + nang_loki_param*(kh - 1)]; + + sap = gw1*fl1[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(ip - 1 + + nfre_loki_param*(ichnk - 1)))] + gw2*fl1[ij - 1 + kijl*(k11 - 1 + + nang_loki_param*(ip - 1 + nfre_loki_param*(ichnk - 1)))] + gw3*fl1[ij - 1 + + kijl*(k1 - 1 + nang_loki_param*(ip1 - 1 + nfre_loki_param*(ichnk - 1)))] + + gw4*fl1[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(ip1 - 1 + + nfre_loki_param*(ichnk - 1)))]; + sam = gw5*fl1[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(im - 1 + + nfre_loki_param*(ichnk - 1)))] + gw6*fl1[ij - 1 + kijl*(k21 - 1 + + nang_loki_param*(im - 1 + nfre_loki_param*(ichnk - 1)))] + gw7*fl1[ij - 1 + + kijl*(k2 - 1 + nang_loki_param*(im1 - 1 + nfre_loki_param*(ichnk - 1)))] + + gw8*fl1[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(im1 - 1 + + nfre_loki_param*(ichnk - 1)))]; + fij = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(ic - 1 + + nfre_loki_param*(ichnk - 1)))]*ftail; + fad1 = fij*(sap + sam); + fad2 = fad1 - (double) 2.0*sap*sam; + fad1 = fad1 + fad2; + fcen = ftemp*fij; + ad = fad2*fcen; + delad = fad1*ftemp; + delap = (fij - (double) 2.0*sam)*dal1*fcen; + delam = (fij - (double) 2.0*sap)*dal2*fcen; + + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] = + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] + ad*fklamm1; + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] = + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm - 1))] + delam*fklam12; + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] = + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] + ad*fklamm2; + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] = + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm - 1))] + delam*fklam22; + + if (mm1 <= nfre) { + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] = + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] + ad*fklamma; + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] = + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] + delam*fklama2; + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] = + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] + ad*fklammb; + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] = + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] + delam*fklamb2; + + if (mc <= nfre) { + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] = + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] - (double) 2.0*ad; + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] = fld[ij - 1 + + kijl*(k - 1 + nang_loki_param*(mc - 1))] - (double) 2.0*delad; + + if (mp <= nfre) { + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] = + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] + ad*fklamp1; + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] = + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] + delap*fklap12; + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] = + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] + ad*fklamp2; + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] = + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] + delap*fklap22 + ; + + if (mp1 <= nfre) { + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] = + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] + ad*fklampa; + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] = fld[ij - 1 + + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] + delap*fklapa2; + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] = + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] + ad*fklampb; + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] = fld[ij - 1 + + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] + delap*fklapb2; + } + } + } + } + } + } + + } else { + + for (kh = 1; kh <= 2; kh += 1) { + for (k = 1; k <= nang; k += 1) { + k1 = k1w[k - 1 + nang_loki_param*(kh - 1)]; + k2 = k2w[k - 1 + nang_loki_param*(kh - 1)]; + k11 = k11w[k - 1 + nang_loki_param*(kh - 1)]; + k21 = k21w[k - 1 + nang_loki_param*(kh - 1)]; + + sap = gw1*fl1[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(ip - 1 + + nfre_loki_param*(ichnk - 1)))] + gw2*fl1[ij - 1 + kijl*(k11 - 1 + + nang_loki_param*(ip - 1 + nfre_loki_param*(ichnk - 1)))] + gw3*fl1[ij - 1 + + kijl*(k1 - 1 + nang_loki_param*(ip1 - 1 + nfre_loki_param*(ichnk - 1)))] + + gw4*fl1[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(ip1 - 1 + + nfre_loki_param*(ichnk - 1)))]; + sam = gw5*fl1[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(im - 1 + + nfre_loki_param*(ichnk - 1)))] + gw6*fl1[ij - 1 + kijl*(k21 - 1 + + nang_loki_param*(im - 1 + nfre_loki_param*(ichnk - 1)))] + gw7*fl1[ij - 1 + + kijl*(k2 - 1 + nang_loki_param*(im1 - 1 + nfre_loki_param*(ichnk - 1)))] + + gw8*fl1[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(im1 - 1 + + nfre_loki_param*(ichnk - 1)))]; + fij = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(ic - 1 + + nfre_loki_param*(ichnk - 1)))]*ftail; + fad1 = fij*(sap + sam); + fad2 = fad1 - (double) 2.0*sap*sam; + fad1 = fad1 + fad2; + fcen = ftemp*fij; + ad = fad2*fcen; + delad = fad1*ftemp; + delap = (fij - (double) 2.0*sam)*dal1*fcen; + delam = (fij - (double) 2.0*sap)*dal2*fcen; + + if (mm1 >= 1) { + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] = + sl[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] + ad*fklamma; + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] = + fld[ij - 1 + kijl*(k2 - 1 + nang_loki_param*(mm1 - 1))] + delam*fklama2; + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] = + sl[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] + ad*fklammb; + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] = + fld[ij - 1 + kijl*(k21 - 1 + nang_loki_param*(mm1 - 1))] + delam*fklamb2; + } + + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] = + sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] - (double) 2.0*ad; + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] = + fld[ij - 1 + kijl*(k - 1 + nang_loki_param*(mc - 1))] - (double) 2.0*delad; + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] = + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] + ad*fklamp1; + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] = + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp - 1))] + delap*fklap12; + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] = + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] + ad*fklamp2; + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] = + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp - 1))] + delap*fklap22; + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] = + sl[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] + ad*fklampa; + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] = + fld[ij - 1 + kijl*(k1 - 1 + nang_loki_param*(mp1 - 1))] + delap*fklapa2; + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] = + sl[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] + ad*fklampb; + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] = + fld[ij - 1 + kijl*(k11 - 1 + nang_loki_param*(mp1 - 1))] + delap*fklapb2; + } + } + + } + } + + + +} diff --git a/src/phys-scc-cuda/snonlin_c.h b/src/phys-scc-cuda/snonlin_c.h new file mode 100644 index 00000000..b9c84f62 --- /dev/null +++ b/src/phys-scc-cuda/snonlin_c.h @@ -0,0 +1,22 @@ +#include +#include +#include +#include +#include +#include +#include "transf_snl_c.h" +#include "transf_c.h" +#include "peak_ang_c.h" + +__device__ void snonlin_c(int kijs, int kijl, const double * fl1, double * fld, + double * sl, const double * wavnum, const double * depth, const double * akmean, + const double * af11, double bathymax, const double * costh, double dal1, double dal2, + double delth, const double * dfim, const double * dfimfr, const double * dfimfr2, + double dkmax, const double * fklam, const double * fklam1, const double * fklap, + const double * fklap1, const double * fr, double fratio, double g, double gm1, + const int * ikm, const int * ikm1, const int * ikp, const int * ikp1, + const int * inlcoef, int isnonlin, const int * k11w, const int * k1w, + const int * k21w, const int * k2w, int kfrh, int mfrstlw, int mlsthg, int nang, + int nfre, const double * rnlcoef, const double * sinth, const double * th, + double wetail, double wp1tail, double wp2tail, double xkdmin, const double * zpifr, + int ichnk, int nchnk, int ij, double * enh, double * xnu, double * sig_th); diff --git a/src/phys-scc-cuda/snonlin_fc.F90 b/src/phys-scc-cuda/snonlin_fc.F90 new file mode 100644 index 00000000..b9f001ff --- /dev/null +++ b/src/phys-scc-cuda/snonlin_fc.F90 @@ -0,0 +1,173 @@ +MODULE SNONLIN_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE SNONLIN_fc (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN, AF11, BATHYMAX, COSTH, DAL1, DAL2, DELTH, DFIM, & + & DFIMFR, DFIMFR2, DKMAX, FKLAM, FKLAM1, FKLAP, FKLAP1, FR, FRATIO, G, GM1, IKM, IKM1, IKP, IKP1, INLCOEF, ISNONLIN, K11W, & + & K1W, K21W, K2W, KFRH, MFRSTLW, MLSTHG, NANG, NFRE, RNLCOEF, SINTH, TH, WETAIL, WP1TAIL, WP2TAIL, XKDMIN, ZPIFR, ICHNK, & + & NCHNK, IJ, ENH, XNU, SIG_TH) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE PEAK_ANG (KIJS, KIJL, FL1, XNU, SIG_TH) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: XNU, SIG_TH + END SUBROUTINE PEAK_ANG + END INTERFACE + INTERFACE + FUNCTION TRANSF (XK, D) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: TRANSF + REAL(KIND=JWRB), INTENT(IN) :: XK, D + END FUNCTION TRANSF + END INTERFACE + INTERFACE + FUNCTION TRANSF_SNL (XK0, D, XNU, SIG_TH) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: TRANSF_SNL + REAL(KIND=JWRB), INTENT(IN) :: XK0, D, XNU, SIG_TH + END FUNCTION TRANSF_SNL + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DKMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ISNONLIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KFRH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MFRSTLW + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MLSTHG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKDMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE SNONLIN_iso_c (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN, AF11, BATHYMAX, COSTH, DAL1, DAL2, DELTH, DFIM, & + & DFIMFR, DFIMFR2, DKMAX, FKLAM, FKLAM1, FKLAP, FKLAP1, FR, FRATIO, G, GM1, IKM, IKM1, IKP, IKP1, INLCOEF, ISNONLIN, K11W, & + & K1W, K21W, K2W, KFRH, MFRSTLW, MLSTHG, NANG, NFRE, RNLCOEF, SINTH, TH, WETAIL, WP1TAIL, WP2TAIL, XKDMIN, ZPIFR, ICHNK, & + & NCHNK, IJ, ENH, XNU, SIG_TH) BIND(c, name="snonlin_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: FLD + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: DEPTH + TYPE(c_ptr), VALUE :: AKMEAN + TYPE(c_ptr), VALUE :: AF11 + REAL, VALUE :: BATHYMAX + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: DAL1 + REAL, VALUE :: DAL2 + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIMFR + TYPE(c_ptr), VALUE :: DFIMFR2 + REAL, VALUE :: DKMAX + TYPE(c_ptr), VALUE :: FKLAM + TYPE(c_ptr), VALUE :: FKLAM1 + TYPE(c_ptr), VALUE :: FKLAP + TYPE(c_ptr), VALUE :: FKLAP1 + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: FRATIO + REAL, VALUE :: G + REAL, VALUE :: GM1 + TYPE(c_ptr), VALUE :: IKM + TYPE(c_ptr), VALUE :: IKM1 + TYPE(c_ptr), VALUE :: IKP + TYPE(c_ptr), VALUE :: IKP1 + TYPE(c_ptr), VALUE :: INLCOEF + INTEGER(KIND=c_int), VALUE :: ISNONLIN + TYPE(c_ptr), VALUE :: K11W + TYPE(c_ptr), VALUE :: K1W + TYPE(c_ptr), VALUE :: K21W + TYPE(c_ptr), VALUE :: K2W + INTEGER(KIND=c_int), VALUE :: KFRH + INTEGER(KIND=c_int), VALUE :: MFRSTLW + INTEGER(KIND=c_int), VALUE :: MLSTHG + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + TYPE(c_ptr), VALUE :: RNLCOEF + TYPE(c_ptr), VALUE :: SINTH + TYPE(c_ptr), VALUE :: TH + REAL, VALUE :: WETAIL + REAL, VALUE :: WP1TAIL + REAL, VALUE :: WP2TAIL + REAL, VALUE :: XKDMIN + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + TYPE(c_ptr), VALUE :: ENH + TYPE(c_ptr), VALUE :: XNU + TYPE(c_ptr), VALUE :: SIG_TH + END SUBROUTINE SNONLIN_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AKMEAN(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AF11(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INLCOEF(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K11W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K1W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K21W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K2W(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNLCOEF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: ENH(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XNU(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SIG_TH(:, :) +!$acc host_data use_device( FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN, AF11, COSTH, DFIM, DFIMFR, DFIMFR2, FKLAM, FKLAM1, FKLAP, & +!$acc & FKLAP1, FR, IKM, IKM1, IKP, IKP1, INLCOEF, K11W, K1W, K21W, K2W, RNLCOEF, SINTH, TH, ZPIFR, ENH, XNU, SIG_TH ) + CALL SNONLIN_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(FLD), c_loc(SL), c_loc(WAVNUM), c_loc(DEPTH), c_loc(AKMEAN), c_loc(AF11), & + & BATHYMAX, c_loc(COSTH), DAL1, DAL2, DELTH, c_loc(DFIM), c_loc(DFIMFR), c_loc(DFIMFR2), DKMAX, c_loc(FKLAM), c_loc(FKLAM1), & + & c_loc(FKLAP), c_loc(FKLAP1), c_loc(FR), FRATIO, G, GM1, c_loc(IKM), c_loc(IKM1), c_loc(IKP), c_loc(IKP1), c_loc(INLCOEF), & + & ISNONLIN, c_loc(K11W), c_loc(K1W), c_loc(K21W), c_loc(K2W), KFRH, MFRSTLW, MLSTHG, NANG, NFRE, c_loc(RNLCOEF), & + & c_loc(SINTH), c_loc(TH), WETAIL, WP1TAIL, WP2TAIL, XKDMIN, c_loc(ZPIFR), ICHNK, NCHNK, IJ, c_loc(ENH), c_loc(XNU), & + & c_loc(SIG_TH)) +!$acc end host_data + END SUBROUTINE SNONLIN_fc +END MODULE SNONLIN_FC_MOD diff --git a/src/phys-scc-cuda/snonlin_fc.intfb.h b/src/phys-scc-cuda/snonlin_fc.intfb.h new file mode 100644 index 00000000..dd0ea792 --- /dev/null +++ b/src/phys-scc-cuda/snonlin_fc.intfb.h @@ -0,0 +1,97 @@ +INTERFACE + SUBROUTINE SNONLIN_FC (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN, AF11, BATHYMAX, COSTH, DAL1, DAL2, DELTH, DFIM, & + & DFIMFR, DFIMFR2, DKMAX, FKLAM, FKLAM1, FKLAP, FKLAP1, FR, FRATIO, G, GM1, IKM, IKM1, IKP, IKP1, INLCOEF, ISNONLIN, K11W, & + & K1W, K21W, K2W, KFRH, MFRSTLW, MLSTHG, NANG, NFRE, RNLCOEF, SINTH, TH, WETAIL, WP1TAIL, WP2TAIL, XKDMIN, ZPIFR, ICHNK, & + & NCHNK, IJ, ENH, XNU, SIG_TH) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE PEAK_ANG_FC (KIJS, KIJL, FL1, XNU, SIG_TH) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: XNU, SIG_TH + END SUBROUTINE PEAK_ANG_FC + END INTERFACE + INTERFACE + FUNCTION TRANSF_FC (XK, D) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: TRANSF + REAL(KIND=JWRB), INTENT(IN) :: XK, D + END FUNCTION TRANSF_FC + END INTERFACE + INTERFACE + FUNCTION TRANSF_SNL_FC (XK0, D, XNU, SIG_TH) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: TRANSF_SNL + REAL(KIND=JWRB), INTENT(IN) :: XK0, D, XNU, SIG_TH + END FUNCTION TRANSF_SNL_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: FLD(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AKMEAN(:) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: ENH(:, :, :) + + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XNU(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: SIG_TH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AF11(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DAL2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIMFR2(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DKMAX + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAM1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FKLAP1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FRATIO + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKM1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: IKP1(:) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: INLCOEF(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ISNONLIN + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K11W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K1W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K21W(:, :) + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: K2W(:, :) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KFRH + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MFRSTLW + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: MLSTHG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNLCOEF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WETAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP1TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: WP2TAIL + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKDMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE SNONLIN_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/stokesdrift.c_hoist.F90 b/src/phys-scc-cuda/stokesdrift.c_hoist.F90 new file mode 100644 index 00000000..a48c49de --- /dev/null +++ b/src/phys-scc-cuda/stokesdrift.c_hoist.F90 @@ -0,0 +1,155 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE STOKESDRIFT_FC (KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES, CITHRSH, & +& COSTH, DELTH, DFIM_SIM, FR, G, LICERUN, LWAMRSETCI, NANG, NFRE_ODD, SINTH, ZPI, ICHNK, NCHNK, IJ) + + ! + !*** *STOKESDRIFT* DETERMINES THE STOKES DRIFT + ! + ! PETER JANSSEN MARCH 2009 + ! + ! PURPOSE. + ! -------- + ! + ! DETERMINATION OF STOKES DRIFT VECTOR + ! + ! INTERFACE. + ! ---------- + ! *CALL* *STOKESDRIFT(KIJS, KIJL, FL1, STOKFAC, WSWAVE,WDWAVE,CICOVER,USTOKES,VSTOKES)* + ! + ! INPUT: + ! *KIJS* - FIRST GRIDPOINT + ! *KIJL* - LAST GRIDPOINT + ! *FL1* - 2-D SPECTRUM + ! *STOKFAC*- FACTOR TO COMPUTE THE STOKES DRIFT + ! Auxilliary fields to specify Stokes when model sea ice cover the blocking threshold + ! as 0.016*WSWAVE, aligned in the wind direction + ! *WSWAVE* - WIND SPEED IN M/S. + ! *WDWAVE* - WIND DIRECTION IN RADIANS. + ! *CICOVER*- SEA ICE COVER. + ! + ! OUTPUT: + ! *USTOKES* - U-COMPONENT STOKES DRIFT + ! *VSTOKES* - V-COMPONENT STOKES DRIFT + ! + ! METHOD. + ! ------- + ! DETERMINE U- AND V-COMPONENT OF STOKES DRIFT FOLLOWING + ! K.E. KENYON, J.G.R., 74, 6991-6994 + ! + ! EXTERNALS. + ! ---------- + ! NONE + ! + ! + !----------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: TH, DFIM, FRATIO + USE YOWPARAM, ONLY: NFRE + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: VSTOKES(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: K + + REAL(KIND=JWRB), PARAMETER :: STMAX = 1.5_JWRB ! maximum magnitude (this is for safety when coupled) + REAL(KIND=JWRB) :: CONST + REAL(KIND=JWRB) :: FAC + REAL(KIND=JWRB) :: FAC1 + REAL(KIND=JWRB) :: FAC2 + REAL(KIND=JWRB) :: FAC3 + REAL(KIND=JWRB) :: STFAC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + + !*** 1. DETERMINE STOKE DRIFT VECTOR. + ! -------------------------------- + + CONST = 2.0_JWRB*DELTH*ZPI**3 / G*FR(NFRE_ODD)**4 + + !*** 1.1 PERFORM INTEGRATION. + ! ------------------------ + + + USTOKES(IJ, ICHNK) = 0.0_JWRB + VSTOKES(IJ, ICHNK) = 0.0_JWRB + + DO M=1,NFRE_ODD + STFAC = STOKFAC(IJ, M, ICHNK)*DFIM_SIM(M) + DO K=1,NANG + FAC3 = STFAC*FL1(IJ, K, M, ICHNK) + USTOKES(IJ, ICHNK) = USTOKES(IJ, ICHNK) + FAC3*SINTH(K) + VSTOKES(IJ, ICHNK) = VSTOKES(IJ, ICHNK) + FAC3*COSTH(K) + END DO + END DO + + !*** 1.2 ADD CONTRIBUTION OF UNRESOLVED WAVES. + ! ----------------------------------------- + + DO K=1,NANG + FAC1 = CONST*SINTH(K) + FAC2 = CONST*COSTH(K) + USTOKES(IJ, ICHNK) = USTOKES(IJ, ICHNK) + FAC1*FL1(IJ, K, NFRE_ODD, ICHNK) + VSTOKES(IJ, ICHNK) = VSTOKES(IJ, ICHNK) + FAC2*FL1(IJ, K, NFRE_ODD, ICHNK) + END DO + + + !*** 1.3 Sea Ice exception + ! --------------------- + IF (LICERUN .and. LWAMRSETCI) THEN + IF (CICOVER(IJ, ICHNK) > CITHRSH) THEN + USTOKES(IJ, ICHNK) = 0.016_JWRB*WSWAVE(IJ, ICHNK)*SIN(WDWAVE(IJ, ICHNK))*(1.0_JWRB - CICOVER(IJ, ICHNK)) + VSTOKES(IJ, ICHNK) = 0.016_JWRB*WSWAVE(IJ, ICHNK)*COS(WDWAVE(IJ, ICHNK))*(1.0_JWRB - CICOVER(IJ, ICHNK)) + END IF + END IF + + !*** 1.4 Protection + ! -------------- + + USTOKES(IJ, ICHNK) = MIN(MAX(USTOKES(IJ, ICHNK), -STMAX), STMAX) + VSTOKES(IJ, ICHNK) = MIN(MAX(VSTOKES(IJ, ICHNK), -STMAX), STMAX) + + + +END SUBROUTINE STOKESDRIFT_FC diff --git a/src/phys-scc-cuda/stokesdrift_c.c b/src/phys-scc-cuda/stokesdrift_c.c new file mode 100644 index 00000000..c5836541 --- /dev/null +++ b/src/phys-scc-cuda/stokesdrift_c.c @@ -0,0 +1,74 @@ +#include +#include +#include +#include +#include +#include +#include "stokesdrift_c.h" + +__device__ void stokesdrift_c(int kijs, int kijl, const double * fl1, + const double * stokfac, const double * wswave, const double * wdwave, + const double * cicover, double * ustokes, double * vstokes, double cithrsh, + const double * costh, double delth, const double * dfim_sim, const double * fr, + double g, int licerun, int lwamrsetci, int nang, int nfre_odd, const double * sinth, + double zpi, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + int m; + int k; + + double stmax = (double) 1.5; // maximum magnitude (this is for safety when coupled) + double const_var; + double fac; + double fac1; + double fac2; + double fac3; + double stfac; + const_var = (double) 2.0*delth*(pow(zpi, 3)) / g*(pow(fr[nfre_odd - 1], 4)); + + ustokes[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + vstokes[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + + for (m = 1; m <= nfre_odd; m += 1) { + stfac = stokfac[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]*dfim_sim[m - 1]; + for (k = 1; k <= nang; k += 1) { + fac3 = stfac*fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + + nfre_loki_param*(ichnk - 1)))]; + ustokes[ij - 1 + kijl*(ichnk - 1)] = + ustokes[ij - 1 + kijl*(ichnk - 1)] + fac3*sinth[k - 1]; + vstokes[ij - 1 + kijl*(ichnk - 1)] = + vstokes[ij - 1 + kijl*(ichnk - 1)] + fac3*costh[k - 1]; + } + } + for (k = 1; k <= nang; k += 1) { + fac1 = const_var*sinth[k - 1]; + fac2 = const_var*costh[k - 1]; + ustokes[ij - 1 + kijl*(ichnk - 1)] = ustokes[ij - 1 + kijl*(ichnk - 1)] + fac1*fl1[ij + - 1 + kijl*(k - 1 + nang_loki_param*(nfre_odd - 1 + nfre_loki_param*(ichnk - 1)))] + ; + vstokes[ij - 1 + kijl*(ichnk - 1)] = vstokes[ij - 1 + kijl*(ichnk - 1)] + fac2*fl1[ij + - 1 + kijl*(k - 1 + nang_loki_param*(nfre_odd - 1 + nfre_loki_param*(ichnk - 1)))] + ; + } + if (licerun && lwamrsetci) { + if (cicover[ij - 1 + kijl*(ichnk - 1)] > cithrsh) { + ustokes[ij - 1 + kijl*(ichnk - 1)] = (double) 0.016*wswave[ij - 1 + kijl*(ichnk - 1 + )]*sin(wdwave[ij - 1 + kijl*(ichnk - 1)])*((double) 1.0 - cicover[ij - 1 + + kijl*(ichnk - 1)]); + vstokes[ij - 1 + kijl*(ichnk - 1)] = (double) 0.016*wswave[ij - 1 + kijl*(ichnk - 1 + )]*cos(wdwave[ij - 1 + kijl*(ichnk - 1)])*((double) 1.0 - cicover[ij - 1 + + kijl*(ichnk - 1)]); + } + } + ustokes[ij - 1 + kijl*(ichnk - 1)] = min((double) (max((double) (ustokes[ij - 1 + + kijl*(ichnk - 1)]), (double) (-stmax))), (double) (stmax)); + vstokes[ij - 1 + kijl*(ichnk - 1)] = min((double) (max((double) (vstokes[ij - 1 + + kijl*(ichnk - 1)]), (double) (-stmax))), (double) (stmax)); + + + +} diff --git a/src/phys-scc-cuda/stokesdrift_c.h b/src/phys-scc-cuda/stokesdrift_c.h new file mode 100644 index 00000000..88b27f2f --- /dev/null +++ b/src/phys-scc-cuda/stokesdrift_c.h @@ -0,0 +1,14 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void stokesdrift_c(int kijs, int kijl, const double * fl1, + const double * stokfac, const double * wswave, const double * wdwave, + const double * cicover, double * ustokes, double * vstokes, double cithrsh, + const double * costh, double delth, const double * dfim_sim, const double * fr, + double g, int licerun, int lwamrsetci, int nang, int nfre_odd, const double * sinth, + double zpi, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/stokesdrift_fc.F90 b/src/phys-scc-cuda/stokesdrift_fc.F90 new file mode 100644 index 00000000..7feeb534 --- /dev/null +++ b/src/phys-scc-cuda/stokesdrift_fc.F90 @@ -0,0 +1,79 @@ +MODULE STOKESDRIFT_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE STOKESDRIFT_fc (KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES, CITHRSH, COSTH, DELTH, & + & DFIM_SIM, FR, G, LICERUN, LWAMRSETCI, NANG, NFRE_ODD, SINTH, ZPI, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE STOKESDRIFT_iso_c (KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES, CITHRSH, COSTH, DELTH, & + & DFIM_SIM, FR, G, LICERUN, LWAMRSETCI, NANG, NFRE_ODD, SINTH, ZPI, ICHNK, NCHNK, IJ) BIND(c, name="stokesdrift_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: STOKFAC + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: USTOKES + TYPE(c_ptr), VALUE :: VSTOKES + REAL, VALUE :: CITHRSH + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM_SIM + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: G + LOGICAL, VALUE :: LICERUN + LOGICAL, VALUE :: LWAMRSETCI + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE_ODD + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: ZPI + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE STOKESDRIFT_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: VSTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) +!$acc host_data use_device( FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES, COSTH, DFIM_SIM, FR, SINTH ) + CALL STOKESDRIFT_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(STOKFAC), c_loc(WSWAVE), c_loc(WDWAVE), c_loc(CICOVER), c_loc(USTOKES), & + & c_loc(VSTOKES), CITHRSH, c_loc(COSTH), DELTH, c_loc(DFIM_SIM), c_loc(FR), G, LICERUN, LWAMRSETCI, NANG, NFRE_ODD, & + & c_loc(SINTH), ZPI, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE STOKESDRIFT_fc +END MODULE STOKESDRIFT_FC_MOD diff --git a/src/phys-scc-cuda/stokesdrift_fc.intfb.h b/src/phys-scc-cuda/stokesdrift_fc.intfb.h new file mode 100644 index 00000000..fe6c025b --- /dev/null +++ b/src/phys-scc-cuda/stokesdrift_fc.intfb.h @@ -0,0 +1,42 @@ +INTERFACE + SUBROUTINE STOKESDRIFT_FC (KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES, CITHRSH, COSTH, DELTH, & + & DFIM_SIM, FR, G, LICERUN, LWAMRSETCI, NANG, NFRE_ODD, SINTH, ZPI, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: TH, DFIM, FRATIO + USE YOWPARAM, ONLY: NFRE + + + ! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: VSTOKES(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE STOKESDRIFT_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/stokestrn.c_hoist.F90 b/src/phys-scc-cuda/stokestrn.c_hoist.F90 new file mode 100644 index 00000000..edb273ae --- /dev/null +++ b/src/phys-scc-cuda/stokestrn.c_hoist.F90 @@ -0,0 +1,142 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE STOKESTRN_FC (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, & +& VSTOKES, STRNMS, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, CITHRSH, COSTH, DELTH, DFIM, DFIM_SIM, FLMIN, FR, G, LICERUN, LWAMRSETCI, & +& LWCOU, LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, NANG, NFRE, NFRE_ODD, ROWATER, SINTH, ZPI, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *STOKESTRN* - WRAPPER TO CALL STOKESDRIFT and CIMSSTRN + + !* PURPOSE. + ! -------- + + !** INTERFACE. + ! ---------- + + ! *CALL* *STOKESTRN (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, FF_NOW, INTFLDS, WAM2NEMO) + + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *FL1* - SPECTRUM(INPUT). + ! *WAVNUM* - WAVE NUMBER. + ! *STOKFAC* - STOKES DRIFT FACTOR. + ! *DEPTH* - WATER DEPTH. + ! *FF_NOW* - FORCING FIELDS AT CURRENT TIME. + ! *INTFLDS* - INTEGRATED/DERIVED PARAMETERS + ! *WAM2NEMO*- WAVE FIELDS PASSED TO NEMO + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRO, JWRB + USE YOWDRVTYPE, ONLY: WAVE2OCEAN, FORCING_FIELDS, INTGT_PARAM_FIELDS + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE CIMSSTRN_FC (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CITHICK + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: STRN + END SUBROUTINE CIMSSTRN_FC + END INTERFACE + INTERFACE + SUBROUTINE STOKESDRIFT_FC (KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: STOKFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSWAVE, WDWAVE, CICOVER + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: USTOKES, VSTOKES + END SUBROUTINE STOKESDRIFT_FC + END INTERFACE + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: VSTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRNMS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOUSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOVSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOSTRN(:, :) + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSEND + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTK + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTRN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + CALL STOKESDRIFT_FC(KIJS, KIJL, FL1(:, :, :, :), STOKFAC(:, :, :), WSWAVE(:, :), WDWAVE(:, :), CICOVER(:, :), USTOKES(:, :), & + & VSTOKES(:, :), CITHRSH, COSTH(:), DELTH, DFIM_SIM(:), FR(:), G, LICERUN, LWAMRSETCI, NANG, NFRE_ODD, SINTH(:), ZPI, ICHNK, & + & NCHNK, IJ) + + IF (LWNEMOCOUSTRN) CALL CIMSSTRN_FC(KIJS, KIJL, FL1(:, :, :, :), WAVNUM(:, :, :), DEPTH(:, :), CITHICK(:, :), STRNMS(:, :), DELTH, DFIM(:), & + & FLMIN, G, NANG, NFRE, ROWATER, ICHNK, NCHNK, IJ) + + + + IF (LWNEMOCOU .and. (LWNEMOCOUSEND .and. LWCOU .or. .not.LWCOU)) THEN + IF (LWNEMOCOUSTK) THEN + NEMOUSTOKES(IJ, ICHNK) = USTOKES(IJ, ICHNK) + NEMOVSTOKES(IJ, ICHNK) = VSTOKES(IJ, ICHNK) + ELSE + NEMOUSTOKES(IJ, ICHNK) = 0.0_JWRO + NEMOVSTOKES(IJ, ICHNK) = 0.0_JWRO + END IF + + IF (LWNEMOCOUSTRN) NEMOSTRN(IJ, ICHNK) = STRNMS(IJ, ICHNK) + END IF + + + + ! ---------------------------------------------------------------------- + +END SUBROUTINE STOKESTRN_FC diff --git a/src/phys-scc-cuda/stokestrn_c.c b/src/phys-scc-cuda/stokestrn_c.c new file mode 100644 index 00000000..85a9bc65 --- /dev/null +++ b/src/phys-scc-cuda/stokestrn_c.c @@ -0,0 +1,53 @@ +#include +#include +#include +#include +#include +#include +#include "stokestrn_c.h" +#include "cimsstrn_c.h" +#include "stokesdrift_c.h" + +__device__ void stokestrn_c(int kijs, int kijl, const double * fl1, + const double * wavnum, const double * stokfac, const double * depth, + const double * wswave, const double * wdwave, const double * cicover, + const double * cithick, double * ustokes, double * vstokes, double * strnms, + double * nemoustokes, double * nemovstokes, double * nemostrn, double cithrsh, + const double * costh, double delth, const double * dfim, const double * dfim_sim, + double flmin, const double * fr, double g, int licerun, int lwamrsetci, int lwcou, + int lwnemocou, int lwnemocousend, int lwnemocoustk, int lwnemocoustrn, int nang, + int nfre, int nfre_odd, double rowater, const double * sinth, double zpi, int ichnk, + int nchnk, int ij) { + + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + + + stokesdrift_c(kijs, kijl, fl1, stokfac, wswave, wdwave, cicover, ustokes, vstokes, + cithrsh, costh, delth, dfim_sim, fr, g, licerun, lwamrsetci, nang, nfre_odd, sinth, + zpi, ichnk, nchnk, ij); + + if (lwnemocoustrn) { + cimsstrn_c(kijs, kijl, fl1, wavnum, depth, cithick, strnms, delth, dfim, flmin, g, + nang, nfre, rowater, ichnk, nchnk, ij); + } + + if (lwnemocou && (lwnemocousend && lwcou || !lwcou)) { + if (lwnemocoustk) { + nemoustokes[ij - 1 + kijl*(ichnk - 1)] = ustokes[ij - 1 + kijl*(ichnk - 1)]; + nemovstokes[ij - 1 + kijl*(ichnk - 1)] = vstokes[ij - 1 + kijl*(ichnk - 1)]; + } else { + nemoustokes[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + nemovstokes[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + } + + if (lwnemocoustrn) { + nemostrn[ij - 1 + kijl*(ichnk - 1)] = strnms[ij - 1 + kijl*(ichnk - 1)]; + } + } + + +} diff --git a/src/phys-scc-cuda/stokestrn_c.h b/src/phys-scc-cuda/stokestrn_c.h new file mode 100644 index 00000000..6865e498 --- /dev/null +++ b/src/phys-scc-cuda/stokestrn_c.h @@ -0,0 +1,19 @@ +#include +#include +#include +#include +#include +#include +#include "cimsstrn_c.h" +#include "stokesdrift_c.h" + +__device__ void stokestrn_c(int kijs, int kijl, const double * fl1, + const double * wavnum, const double * stokfac, const double * depth, + const double * wswave, const double * wdwave, const double * cicover, + const double * cithick, double * ustokes, double * vstokes, double * strnms, + double * nemoustokes, double * nemovstokes, double * nemostrn, double cithrsh, + const double * costh, double delth, const double * dfim, const double * dfim_sim, + double flmin, const double * fr, double g, int licerun, int lwamrsetci, int lwcou, + int lwnemocou, int lwnemocousend, int lwnemocoustk, int lwnemocoustrn, int nang, + int nfre, int nfre_odd, double rowater, const double * sinth, double zpi, int ichnk, + int nchnk, int ij); diff --git a/src/phys-scc-cuda/stokestrn_fc.F90 b/src/phys-scc-cuda/stokestrn_fc.F90 new file mode 100644 index 00000000..23450361 --- /dev/null +++ b/src/phys-scc-cuda/stokestrn_fc.F90 @@ -0,0 +1,139 @@ +MODULE STOKESTRN_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE STOKESTRN_fc (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, VSTOKES, STRNMS, & + & NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, CITHRSH, COSTH, DELTH, DFIM, DFIM_SIM, FLMIN, FR, G, LICERUN, LWAMRSETCI, LWCOU, & + & LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, NANG, NFRE, NFRE_ODD, ROWATER, SINTH, ZPI, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRO, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE CIMSSTRN (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CITHICK + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: STRN + END SUBROUTINE CIMSSTRN + END INTERFACE + INTERFACE + SUBROUTINE STOKESDRIFT (KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: STOKFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSWAVE, WDWAVE, CICOVER + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: USTOKES, VSTOKES + END SUBROUTINE STOKESDRIFT + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSEND + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTK + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTRN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE STOKESTRN_iso_c (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, VSTOKES, & + & STRNMS, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, CITHRSH, COSTH, DELTH, DFIM, DFIM_SIM, FLMIN, FR, G, LICERUN, LWAMRSETCI, & + & LWCOU, LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, NANG, NFRE, NFRE_ODD, ROWATER, SINTH, ZPI, ICHNK, NCHNK, IJ & + & ) BIND(c, name="stokestrn_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: WAVNUM + TYPE(c_ptr), VALUE :: STOKFAC + TYPE(c_ptr), VALUE :: DEPTH + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: CITHICK + TYPE(c_ptr), VALUE :: USTOKES + TYPE(c_ptr), VALUE :: VSTOKES + TYPE(c_ptr), VALUE :: STRNMS + TYPE(c_ptr), VALUE :: NEMOUSTOKES + TYPE(c_ptr), VALUE :: NEMOVSTOKES + TYPE(c_ptr), VALUE :: NEMOSTRN + REAL, VALUE :: CITHRSH + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: DFIM + TYPE(c_ptr), VALUE :: DFIM_SIM + REAL, VALUE :: FLMIN + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: G + LOGICAL, VALUE :: LICERUN + LOGICAL, VALUE :: LWAMRSETCI + LOGICAL, VALUE :: LWCOU + LOGICAL, VALUE :: LWNEMOCOU + LOGICAL, VALUE :: LWNEMOCOUSEND + LOGICAL, VALUE :: LWNEMOCOUSTK + LOGICAL, VALUE :: LWNEMOCOUSTRN + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: NFRE_ODD + REAL, VALUE :: ROWATER + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: ZPI + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE STOKESTRN_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: VSTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRNMS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOUSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOVSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOSTRN(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) +!$acc host_data use_device( FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, VSTOKES, STRNMS, & +!$acc & NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, COSTH, DFIM, DFIM_SIM, FR, SINTH ) + CALL STOKESTRN_iso_c(KIJS, KIJL, c_loc(FL1), c_loc(WAVNUM), c_loc(STOKFAC), c_loc(DEPTH), c_loc(WSWAVE), c_loc(WDWAVE), & + & c_loc(CICOVER), c_loc(CITHICK), c_loc(USTOKES), c_loc(VSTOKES), c_loc(STRNMS), c_loc(NEMOUSTOKES), c_loc(NEMOVSTOKES), & + & c_loc(NEMOSTRN), CITHRSH, c_loc(COSTH), DELTH, c_loc(DFIM), c_loc(DFIM_SIM), FLMIN, c_loc(FR), G, LICERUN, LWAMRSETCI, & + & LWCOU, LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, NANG, NFRE, NFRE_ODD, ROWATER, c_loc(SINTH), ZPI, ICHNK, & + & NCHNK, IJ) +!$acc end host_data + END SUBROUTINE STOKESTRN_fc +END MODULE STOKESTRN_FC_MOD diff --git a/src/phys-scc-cuda/stokestrn_fc.intfb.h b/src/phys-scc-cuda/stokestrn_fc.intfb.h new file mode 100644 index 00000000..86324535 --- /dev/null +++ b/src/phys-scc-cuda/stokestrn_fc.intfb.h @@ -0,0 +1,80 @@ +INTERFACE + SUBROUTINE STOKESTRN_FC (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, USTOKES, VSTOKES, STRNMS, & + & NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, CITHRSH, COSTH, DELTH, DFIM, DFIM_SIM, FLMIN, FR, G, LICERUN, LWAMRSETCI, LWCOU, & + & LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, NANG, NFRE, NFRE_ODD, ROWATER, SINTH, ZPI, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRO, JWRB + USE YOWDRVTYPE, ONLY: WAVE2OCEAN, FORCING_FIELDS, INTGT_PARAM_FIELDS + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + SUBROUTINE CIMSSTRN_FC (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRN) + USE parkind_wave, ONLY: jwim, jwrb + USE YOWPARAM, ONLY: NANG, NFRE + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: CITHICK + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: STRN + END SUBROUTINE CIMSSTRN_FC + END INTERFACE + INTERFACE + SUBROUTINE STOKESDRIFT_FC (KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES, VSTOKES) + USE parkind_wave, ONLY: jwim, jwrb + USE yowparam, ONLY: nang, nfre + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NANG, NFRE) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: STOKFAC + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WSWAVE, WDWAVE, CICOVER + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: USTOKES, VSTOKES + END SUBROUTINE STOKESDRIFT_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WAVNUM(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: STOKFAC(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DEPTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CITHICK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: VSTOKES(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: STRNMS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOUSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOVSTOKES(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOSTRN(:, :) + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DFIM_SIM(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: FLMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSEND + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTK + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOUSTRN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE_ODD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ROWATER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE STOKESTRN_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/stress_gc.c_hoist.F90 b/src/phys-scc-cuda/stress_gc.c_hoist.F90 new file mode 100644 index 00000000..a51a60fb --- /dev/null +++ b/src/phys-scc-cuda/stress_gc.c_hoist.F90 @@ -0,0 +1,144 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) FUNCTION STRESS_GC_FC (ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CM_GC, & +& DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPSUS, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, RN1_RN, SQRTGOSURFT, XKAPPA, & +& XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, ZALP) + + !*** DETERMINE WAVE INDUCED STRESS FOR GRAV-CAP WAVES + + ! AUTHOR: PETER JANSSEN + ! ------ + + ! REFERENCES: + ! ---------- + + ! VIERS PAPER EQ.(29) + ! FOR QUASILINEAR EFFECT SEE PETER A.E.M. JANSSEN,1990. + + !---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: OMEGA_GC + USE YOWPCONS, ONLY: SURFT, G + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION NS_GC_FC (USTAR) + USE parkind_wave, ONLY: jwrb + INTEGER :: NS_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + END FUNCTION NS_GC_FC + END INTERFACE + + REAL(KIND=JWRB) :: STRESS_GC_FC + REAL(KIND=JWRB), INTENT(IN) :: ANG_GC ! factor to account for angular spreading of the input. + REAL(KIND=JWRB), INTENT(IN) :: USTAR ! friction velocity + REAL(KIND=JWRB), INTENT(IN) :: Z0 ! surface roughness + REAL(KIND=JWRB), INTENT(IN) :: Z0MIN ! minimum surface roughness + REAL(KIND=JWRB), INTENT(IN) :: HALP ! 1/2 Phillips parameter + REAL(KIND=JWRB), INTENT(IN) :: RNFAC ! wind dependent factor used in the growth renormalisation + + + INTEGER(KIND=JWIM) :: NS + INTEGER(KIND=JWIM) :: I + + REAL(KIND=JWRB) :: XLAMBDA ! Correction factor in the wave growth for gravity-capillary waves + ! XLAMBDA = 1.0_JWRB + XLAMA * TANH(XLAMB * USTAR**NLAM) + REAL(KIND=JWRB), PARAMETER :: XLAMA = 0.25_JWRB + REAL(KIND=JWRB), PARAMETER :: XLAMB = 4.0_JWRB + INTEGER(KIND=JWIM), PARAMETER :: NLAM = 4 + + REAL(KIND=JWRB) :: TAUWCG_MIN + REAL(KIND=JWRB) :: TAUWCG + REAL(KIND=JWRB) :: ZABHRC + REAL(KIND=JWRB) :: X, XLOG, ZLOG, ZLOG2X + REAL(KIND=JWRB) :: CONST, ZN + REAL(KIND=JWRB) :: GAMNORMA ! RENORMALISATION FACTOR OF THE GROWTH RATE + REAL(KIND=JWRB) :: GAM_W + REAL(KIND=JWRB), INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: EPSUS + LOGICAL, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), INTENT(IN) :: ZALP +!$acc routine seq + + ! INCLUDE FUNCTIONS FROM GRAVITY-CAPILLARY DISPERSION REALTIONS + + ! ---------------------------------------------------------------------- + + + !* 1.0 DETERMINE GRAV_CAP SPECTRUM, TAUWHF. + ! ------------------------------------ + + ! FIND NS: + NS = NS_GC_FC(USTAR, NWAV_GC, SQRTGOSURFT, XKM_GC, XLOGKRATIOM1_GC) + + TAUWCG_MIN = (USTAR*(Z0MIN / Z0))**2 + + XLAMBDA = 1.0_JWRB + XLAMA*TANH(XLAMB*USTAR**NLAM) + + ZABHRC = ANG_GC*BETAMAXOXKAPPA2*HALP*C2OSQRTVG_GC(NS) + IF (LLNORMAGAM) THEN + CONST = RNFAC*BMAXOKAP*HALP*C2OSQRTVG_GC(NS) / MAX(USTAR, EPSUS) + ELSE + CONST = 0.0_JWRB + END IF + + DO I=NS,NWAV_GC + ! GROWTHRATE BY WIND WITHOUT the multiplicative factor representing the ratio of air density to water density (eps) + ! and BETAMAXOXKAPPA2 + X = USTAR*CM_GC(I) + XLOG = LOG(XK_GC(I)*Z0) + XKAPPA / (X + ZALP) + ZLOG = XLOG - LOG(XLAMBDA) + ZLOG = MIN(ZLOG, 0.0_JWRB) + ZLOG2X = ZLOG*ZLOG*X + END DO + + GAM_W = ZLOG2X*ZLOG2X*EXP(XLOG)*OM3GMKM_GC(NS) + ZN = CONST*XKMSQRTVGOC2_GC(NS)*GAM_W + GAMNORMA = (1.0_JWRB + RN1_RN*ZN) / (1.0_JWRB + ZN) + TAUWCG = GAM_W*DELKCC_GC_NS(NS)*OMXKM3_GC(NS)*GAMNORMA + DO I=NS + 1,NWAV_GC + ! ANALYTICAL FORM INERTIAL SUB RANGE F(k) = k**(-4)*BB + ! BB = HALP * C2OSQRTVG_GC(NS)*SQRT(VG_GC(I))/C_GC(I)**2 + ! Tauwcg : (rhow * g /rhoa) * integral of (1/c) * gammma * F(k) k dk + ! with omega=g*k and omega=k*c, then + ! Tauwcg : (rhow /rhoa) * integral of omega * gammma * F(k) k dk + ! but gamma is computed wihtout the rhoa/rhow factor so + ! Tauwcg : integral of omega * gammma_wam * F(k) k dk + ! It should be done in vector form with actual directional spreading information + ! It simplified here by using the ANG_GC factor. + GAM_W = ZLOG2X*ZLOG2X*EXP(XLOG)*OM3GMKM_GC(I) + ZN = CONST*XKMSQRTVGOC2_GC(I)*GAM_W + GAMNORMA = (1.0_JWRB + RN1_RN*ZN) / (1.0_JWRB + ZN) + TAUWCG = TAUWCG + GAM_W*DELKCC_OMXKM3_GC(I)*GAMNORMA + END DO + STRESS_GC_FC = MAX(ZABHRC*TAUWCG, TAUWCG_MIN) + + +END FUNCTION STRESS_GC_FC diff --git a/src/phys-scc-cuda/stress_gc_c.c b/src/phys-scc-cuda/stress_gc_c.c new file mode 100644 index 00000000..e960e608 --- /dev/null +++ b/src/phys-scc-cuda/stress_gc_c.c @@ -0,0 +1,74 @@ +#include +#include +#include +#include +#include +#include +#include "stress_gc_c.h" +#include "ns_gc_c.h" + +__device__ double stress_gc_c(double ang_gc, double ustar, double z0, double z0min, + double halp, double rnfac, double betamaxoxkappa2, double bmaxokap, + const double * c2osqrtvg_gc, const double * cm_gc, const double * delkcc_gc_ns, + const double * delkcc_omxkm3_gc, double epsus, int llnormagam, int nwav_gc, + const double * om3gmkm_gc, const double * omxkm3_gc, double rn1_rn, + double sqrtgosurft, double xkappa, const double * xkmsqrtvgoc2_gc, + const double * xkm_gc, const double * xk_gc, double xlogkratiom1_gc, double zalp) { + + + + + double stress_gc; + int ns; + int i; + + double xlambda; // Correction factor in the wave growth for gravity-capillary waves + // XLAMBDA = 1.0_JWRB + XLAMA * TANH(XLAMB * USTAR**NLAM) + double xlama = (double) 0.25; + double xlamb = (double) 4.0; + const int nlam = 4; + + double tauwcg_min; + double tauwcg; + double zabhrc; + double x, xlog, zlog, zlog2x; + double const_var, zn; + double gamnorma; // RENORMALISATION FACTOR OF THE GROWTH RATE + double gam_w; + // + ns = ns_gc_c(ustar, nwav_gc, sqrtgosurft, xkm_gc, xlogkratiom1_gc); + + tauwcg_min = pow((ustar*(z0min / z0)), 2); + + xlambda = (double) 1.0 + xlama*tanh(xlamb*(pow(ustar, nlam))); + + zabhrc = ang_gc*betamaxoxkappa2*halp*c2osqrtvg_gc[ns - 1]; + if (llnormagam) { + const_var = + rnfac*bmaxokap*halp*c2osqrtvg_gc[ns - 1] / max((double) (ustar), (double) (epsus)); + } else { + const_var = (double) 0.0; + } + + for (i = ns; i <= nwav_gc; i += 1) { + x = ustar*cm_gc[i - 1]; + xlog = log(xk_gc[i - 1]*z0) + xkappa / (x + zalp); + zlog = xlog - log(xlambda); + zlog = min((double) (zlog), (double) ((double) 0.0)); + zlog2x = zlog*zlog*x; + } + + gam_w = zlog2x*zlog2x*exp((double) (xlog))*om3gmkm_gc[ns - 1]; + zn = const_var*xkmsqrtvgoc2_gc[ns - 1]*gam_w; + gamnorma = ((double) 1.0 + rn1_rn*zn) / ((double) 1.0 + zn); + tauwcg = gam_w*delkcc_gc_ns[ns - 1]*omxkm3_gc[ns - 1]*gamnorma; + for (i = ns + 1; i <= nwav_gc; i += 1) { + gam_w = zlog2x*zlog2x*exp((double) (xlog))*om3gmkm_gc[i - 1]; + zn = const_var*xkmsqrtvgoc2_gc[i - 1]*gam_w; + gamnorma = ((double) 1.0 + rn1_rn*zn) / ((double) 1.0 + zn); + tauwcg = tauwcg + gam_w*delkcc_omxkm3_gc[i - 1]*gamnorma; + } + stress_gc = max((double) (zabhrc*tauwcg), (double) (tauwcg_min)); + return stress_gc; + +} diff --git a/src/phys-scc-cuda/stress_gc_c.h b/src/phys-scc-cuda/stress_gc_c.h new file mode 100644 index 00000000..e024d2ae --- /dev/null +++ b/src/phys-scc-cuda/stress_gc_c.h @@ -0,0 +1,15 @@ +#include +#include +#include +#include +#include +#include +#include "ns_gc_c.h" + +__device__ double stress_gc_c(double ang_gc, double ustar, double z0, double z0min, + double halp, double rnfac, double betamaxoxkappa2, double bmaxokap, + const double * c2osqrtvg_gc, const double * cm_gc, const double * delkcc_gc_ns, + const double * delkcc_omxkm3_gc, double epsus, int llnormagam, int nwav_gc, + const double * om3gmkm_gc, const double * omxkm3_gc, double rn1_rn, + double sqrtgosurft, double xkappa, const double * xkmsqrtvgoc2_gc, + const double * xkm_gc, const double * xk_gc, double xlogkratiom1_gc, double zalp); diff --git a/src/phys-scc-cuda/stress_gc_fc.F90 b/src/phys-scc-cuda/stress_gc_fc.F90 new file mode 100644 index 00000000..804e3026 --- /dev/null +++ b/src/phys-scc-cuda/stress_gc_fc.F90 @@ -0,0 +1,95 @@ +MODULE STRESS_GC_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE STRESS_GC_fc (ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CM_GC, DELKCC_GC_NS, & + & DELKCC_OMXKM3_GC, EPSUS, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, RN1_RN, SQRTGOSURFT, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, & + & XK_GC, XLOGKRATIOM1_GC, ZALP) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION NS_GC (USTAR) + USE parkind_wave, ONLY: jwrb + INTEGER :: NS_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + END FUNCTION NS_GC + END INTERFACE + + REAL(KIND=JWRB), INTENT(IN) :: ANG_GC ! factor to account for angular spreading of the input. + REAL(KIND=JWRB), INTENT(IN) :: USTAR ! friction velocity + REAL(KIND=JWRB), INTENT(IN) :: Z0 ! surface roughness + REAL(KIND=JWRB), INTENT(IN) :: Z0MIN ! minimum surface roughness + REAL(KIND=JWRB), INTENT(IN) :: HALP ! 1/2 Phillips parameter + REAL(KIND=JWRB), INTENT(IN) :: RNFAC ! wind dependent factor used in the growth renormalisation + + + + ! XLAMBDA = 1.0_JWRB + XLAMA * TANH(XLAMB * USTAR**NLAM) + + REAL(KIND=JWRB), INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), INTENT(IN) :: EPSUS + LOGICAL, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), INTENT(IN) :: ZALP +!$acc routine seq + INTERFACE + SUBROUTINE STRESS_GC_iso_c (ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CM_GC, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPSUS, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, RN1_RN, SQRTGOSURFT, XKAPPA, & + & XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, ZALP) BIND(c, name="stress_gc_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + REAL, VALUE :: ANG_GC + REAL, VALUE :: USTAR + REAL, VALUE :: Z0 + REAL, VALUE :: Z0MIN + REAL, VALUE :: HALP + REAL, VALUE :: RNFAC + REAL, VALUE :: BETAMAXOXKAPPA2 + REAL, VALUE :: BMAXOKAP + TYPE(c_ptr), VALUE :: C2OSQRTVG_GC + TYPE(c_ptr), VALUE :: CM_GC + TYPE(c_ptr), VALUE :: DELKCC_GC_NS + TYPE(c_ptr), VALUE :: DELKCC_OMXKM3_GC + REAL, VALUE :: EPSUS + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OM3GMKM_GC + TYPE(c_ptr), VALUE :: OMXKM3_GC + REAL, VALUE :: RN1_RN + REAL, VALUE :: SQRTGOSURFT + REAL, VALUE :: XKAPPA + TYPE(c_ptr), VALUE :: XKMSQRTVGOC2_GC + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + REAL, VALUE :: ZALP + END SUBROUTINE STRESS_GC_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) +!$acc host_data use_device( C2OSQRTVG_GC, CM_GC, DELKCC_GC_NS, DELKCC_OMXKM3_GC, OM3GMKM_GC, OMXKM3_GC, XKMSQRTVGOC2_GC, XKM_GC, & +!$acc & XK_GC ) + CALL STRESS_GC_iso_c(ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC, BETAMAXOXKAPPA2, BMAXOKAP, c_loc(C2OSQRTVG_GC), c_loc(CM_GC), & + & c_loc(DELKCC_GC_NS), c_loc(DELKCC_OMXKM3_GC), EPSUS, LLNORMAGAM, NWAV_GC, c_loc(OM3GMKM_GC), c_loc(OMXKM3_GC), RN1_RN, & + & SQRTGOSURFT, XKAPPA, c_loc(XKMSQRTVGOC2_GC), c_loc(XKM_GC), c_loc(XK_GC), XLOGKRATIOM1_GC, ZALP) +!$acc end host_data + END SUBROUTINE STRESS_GC_fc +END MODULE STRESS_GC_FC_MOD diff --git a/src/phys-scc-cuda/stress_gc_fc.intfb.h b/src/phys-scc-cuda/stress_gc_fc.intfb.h new file mode 100644 index 00000000..fdb8c999 --- /dev/null +++ b/src/phys-scc-cuda/stress_gc_fc.intfb.h @@ -0,0 +1,55 @@ +INTERFACE + SUBROUTINE STRESS_GC_FC (ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CM_GC, DELKCC_GC_NS, & + & DELKCC_OMXKM3_GC, EPSUS, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, RN1_RN, SQRTGOSURFT, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, & + & XK_GC, XLOGKRATIOM1_GC, ZALP) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: OMEGA_GC + USE YOWPCONS, ONLY: SURFT, G + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION NS_GC_FC (USTAR) + USE parkind_wave, ONLY: jwrb + INTEGER :: NS_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + END FUNCTION NS_GC_FC + END INTERFACE + + REAL(KIND=JWRB), INTENT(IN) :: ANG_GC ! factor to account for angular spreading of the input. + REAL(KIND=JWRB), INTENT(IN) :: USTAR ! friction velocity + REAL(KIND=JWRB), INTENT(IN) :: Z0 ! surface roughness + REAL(KIND=JWRB), INTENT(IN) :: Z0MIN ! minimum surface roughness + REAL(KIND=JWRB), INTENT(IN) :: HALP ! 1/2 Phillips parameter + REAL(KIND=JWRB), INTENT(IN) :: RNFAC ! wind dependent factor used in the growth renormalisation + + + + ! XLAMBDA = 1.0_JWRB + XLAMA * TANH(XLAMB * USTAR**NLAM) + + REAL(KIND=JWRB), INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: EPSUS + LOGICAL, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), INTENT(IN) :: ZALP +!$acc routine seq + END SUBROUTINE STRESS_GC_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/stresso.c_hoist.F90 b/src/phys-scc-cuda/stresso.c_hoist.F90 new file mode 100644 index 00000000..e2ecc180 --- /dev/null +++ b/src/phys-scc-cuda/stresso.c_hoist.F90 @@ -0,0 +1,262 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE STRESSO_FC (KIJS, KIJL, MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, & +& COSWDIF, SINWDIF2, TAUW, TAUWDIR, PHIWA, LLPHIWA, COSTH, DELTH, EPS1, FR5, G, GAMNCONST, GM1, IPHYS, JTOT_TAUHF, LLGCBZ0, & +& LLNORMAGAM, NANG, NFRE, NWAV_GC, OMEGA_GC, RHOWG_DFIM, SINTH, SQRTGOSURFT, TAUWSHELTER, WTAUHF, X0TAUHF, XKAPPA, XKM_GC, & +& XK_GC, XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ, XSTRESS, YSTRESS, TAUHF, PHIHF, USDIRP, UST) + + ! ---------------------------------------------------------------------- + + !**** *STRESSO* - COMPUTATION OF WAVE STRESS. + + ! H. GUNTHER GKSS/ECMWF NOVEMBER 1989 CODE MOVED FROM SINPUT. + ! P.A.E.M. JANSSEN KNMI AUGUST 1990 + ! J. BIDLOT ECMWF FEBRUARY 1996-97 + ! S. ABDALLA ECMWF OCTOBER 2001 INTRODUCTION OF VARIABLE + ! AIR DENSITY + ! P.A.E.M. JANSSEN ECMWF 2011 ADD FLUX CALULATIONS + + !* PURPOSE. + ! -------- + + ! COMPUTE NORMALIZED WAVE STRESS FROM INPUT SOURCE FUNCTION + + !** INTERFACE. + ! ---------- + + ! *CALL* *STRESSO (KIJS, KIJL, MIJ, RHOWGDFTH, + ! FL1, SL, SPOS, + ! & CINV, + ! & WDWAVE, UFRIC, Z0M, AIRD, RNFAC, + ! & COSWDIF, SINWDIF2, + ! & TAUW, TAUWDIR, PHIWA)* + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *MIJ* - LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE. + ! *RHOWGDFTH - WATER DENSITY * G * DF * DTHETA + ! *FL1* - WAVE SPECTRUM. + ! *SL* - WIND INPUT SOURCE FUNCTION ARRAY (positive and negative contributions). + ! *SPOS* - POSITIVE WIND INPUT SOURCE FUNCTION ARRAY. + ! *CINV* - INVERSE PHASE VELOCITY. + ! *WDWAVE* - WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC + ! NOTATION (POINTING ANGLE OF WIND VECTOR, + ! CLOCKWISE FROM NORTH). + ! *UFRIC* - FRICTION VELOCITY IN M/S. + ! *Z0M* - ROUGHNESS LENGTH IN M. + ! *AIRD* - AIR DENSITY IN KG/M**3. + ! *RNFAC* - WIND DEPENDENT FACTOR USED IN THE GROWTH RENORMALISATION. + ! *COSWDIF* - COS(TH(K)-WDWAVE(IJ)) + ! *SINWDIF2* - SIN(TH(K)-WDWAVE(IJ))**2 + ! *TAUW* - KINEMATIC WAVE STRESS IN (M/S)**2 + ! *TAUWDIR* - KINEMATIC WAVE STRESS DIRECTION + ! *PHIWA* - ENERGY FLUX FROM WIND INTO WAVES INTEGRATED + ! OVER THE FULL FREQUENCY RANGE. + ! *LLPHIWA* - TRUE IF PHIWA NEEDS TO BE COMPUTED + + ! METHOD. + ! ------- + + ! THE INPUT SOURCE FUNCTION IS INTEGRATED OVER FREQUENCY + ! AND DIRECTIONS. + ! BECAUSE ARRAY *SPOS* IS USED, ONLY THE INPUT SOURCE + ! HAS TO BE STORED IN *SPOS* (CALL FIRST SINPUT, THEN + ! STRESSO, AND THEN THE REST OF THE SOURCE FUNCTIONS) + + ! REFERENCE. + ! ---------- + ! P. JANSSEN, + + ! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, TH + + USE TAU_PHI_HF_FC_MOD, ONLY: TAU_PHI_HF_FC + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIWA(:) + LOGICAL, VALUE, INTENT(IN) :: LLPHIWA + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: M + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: I + INTEGER(KIND=JWIM) :: J + INTEGER(KIND=JWIM) :: II + + REAL(KIND=JWRB) :: TAUTOUS2 + REAL(KIND=JWRB) :: COSW + REAL(KIND=JWRB) :: FCOSW2 + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UST(:, :) + + REAL(KIND=JWRB) :: CMRHOWGDFTH + REAL(KIND=JWRB) :: TAUX + REAL(KIND=JWRB) :: TAUY + REAL(KIND=JWRB) :: TAUPX + REAL(KIND=JWRB) :: TAUPY + REAL(KIND=JWRB) :: SUMT + REAL(KIND=JWRB) :: SUMX + REAL(KIND=JWRB) :: SUMY + + LOGICAL :: LTAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + + PHIWA(IJ) = 0.0_JWRB + XSTRESS(IJ, ICHNK) = 0.0_JWRB + YSTRESS(IJ, ICHNK) = 0.0_JWRB + + !* CONTRIBUTION TO THE WAVE STRESS FROM THE NEGATIVE PART OF THE WIND INPUT + ! ------------------------------------------------------------------------ + + IF (LLPHIWA) THEN + ! full energy flux due to negative Sinput (SL-SPOS) + ! we assume that above NFRE, the contibutions can be neglected + DO M=1,NFRE + DO K=1,NANG + PHIWA(IJ) = PHIWA(IJ) + (SL(IJ, K, M) - SPOS(IJ, K, M))*RHOWG_DFIM(M) + END DO + END DO + END IF + + !* CALCULATE LOW-FREQUENCY CONTRIBUTION TO STRESS AND ENERGY FLUX (positive sinput). + ! --------------------------------------------------------------------------------- + DO M=1,NFRE + ! THE INTEGRATION ONLY UP TO FR=MIJ SINCE RHOWGDFTH=0 FOR FR>MIJ + K = 1 + SUMX = SPOS(IJ, K, M)*SINTH(K) + SUMY = SPOS(IJ, K, M)*COSTH(K) + DO K=2,NANG + SUMX = SUMX + SPOS(IJ, K, M)*SINTH(K) + SUMY = SUMY + SPOS(IJ, K, M)*COSTH(K) + END DO + CMRHOWGDFTH = RHOWGDFTH(IJ, M)*CINV(IJ, M, ICHNK) + XSTRESS(IJ, ICHNK) = XSTRESS(IJ, ICHNK) + CMRHOWGDFTH*SUMX + YSTRESS(IJ, ICHNK) = YSTRESS(IJ, ICHNK) + CMRHOWGDFTH*SUMY + END DO + + ! TAUW is the kinematic wave stress ! + XSTRESS(IJ, ICHNK) = XSTRESS(IJ, ICHNK) / MAX(AIRD(IJ, ICHNK), 1.0_JWRB) + YSTRESS(IJ, ICHNK) = YSTRESS(IJ, ICHNK) / MAX(AIRD(IJ, ICHNK), 1.0_JWRB) + + IF (LLPHIWA) THEN + DO M=1,NFRE + ! THE INTEGRATION ONLY UP TO FR=MIJ SINCE RHOWGDFTH=0 FOR FR>MIJ + K = 1 + SUMT = SPOS(IJ, K, M) + DO K=2,NANG + SUMT = SUMT + SPOS(IJ, K, M) + END DO + PHIWA(IJ) = PHIWA(IJ) + RHOWGDFTH(IJ, M)*SUMT + END DO + END IF + + !* CALCULATE HIGH-FREQUENCY CONTRIBUTION TO STRESS and energy flux (positive sinput). + ! ---------------------------------------------------------------------------------- + + IF (IPHYS == 0 .or. TAUWSHELTER == 0.0_JWRB) THEN + LTAUWSHELTER = .false. + USDIRP(IJ, ICHNK) = WDWAVE(IJ, ICHNK) + UST(IJ, ICHNK) = UFRIC(IJ, ICHNK) + ELSE + LTAUWSHELTER = .true. + TAUX = UFRIC(IJ, ICHNK)**2*SIN(WDWAVE(IJ, ICHNK)) + TAUY = UFRIC(IJ, ICHNK)**2*COS(WDWAVE(IJ, ICHNK)) + TAUPX = TAUX - TAUWSHELTER*XSTRESS(IJ, ICHNK) + TAUPY = TAUY - TAUWSHELTER*YSTRESS(IJ, ICHNK) + USDIRP(IJ, ICHNK) = ATAN2(TAUPX, TAUPY) + UST(IJ, ICHNK) = (TAUPX**2 + TAUPY**2)**0.25_JWRB + END IF + + + CALL TAU_PHI_HF_FC(KIJS, KIJL, MIJ(:, :), LTAUWSHELTER, UFRIC(:, :), Z0M(:, :), FL1(:, :, :, :), AIRD(:, :), RNFAC(:), & + & COSWDIF(:, :), SINWDIF2(:, :), UST(:, ICHNK), TAUHF(:, ICHNK), PHIHF(:, ICHNK), LLPHIWA, DELTH, FR5(:), G, GAMNCONST, GM1, & + & JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, NWAV_GC, OMEGA_GC(:), SQRTGOSURFT, TAUWSHELTER, WTAUHF(:), X0TAUHF, XKAPPA, & + & XKM_GC(:), XK_GC(:), XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR(:), ICHNK, NCHNK, IJ) + + + XSTRESS(IJ, ICHNK) = XSTRESS(IJ, ICHNK) + TAUHF(IJ, ICHNK)*SIN(USDIRP(IJ, ICHNK)) + YSTRESS(IJ, ICHNK) = YSTRESS(IJ, ICHNK) + TAUHF(IJ, ICHNK)*COS(USDIRP(IJ, ICHNK)) + TAUW(IJ, ICHNK) = SQRT(XSTRESS(IJ, ICHNK)**2 + YSTRESS(IJ, ICHNK)**2) + TAUW(IJ, ICHNK) = MAX(TAUW(IJ, ICHNK), 0.0_JWRB) + TAUWDIR(IJ, ICHNK) = ATAN2(XSTRESS(IJ, ICHNK), YSTRESS(IJ, ICHNK)) + + IF (.not.LLGCBZ0) THEN + TAUTOUS2 = 1.0_JWRB / (1.0_JWRB + EPS1) + TAUW(IJ, ICHNK) = MIN(TAUW(IJ, ICHNK), UFRIC(IJ, ICHNK)**2*TAUTOUS2) + END IF + + IF (LLPHIWA) THEN + PHIWA(IJ) = PHIWA(IJ) + PHIHF(IJ, ICHNK) + END IF + + + +END SUBROUTINE STRESSO_FC diff --git a/src/phys-scc-cuda/stresso_c.c b/src/phys-scc-cuda/stresso_c.c new file mode 100644 index 00000000..b3d6dd36 --- /dev/null +++ b/src/phys-scc-cuda/stresso_c.c @@ -0,0 +1,142 @@ +#include +#include +#include +#include +#include +#include +#include "stresso_c.h" +#include "tau_phi_hf_c.h" + +__device__ void stresso_c(int kijs, int kijl, const int * mij, const double * rhowgdfth, + const double * fl1, const double * sl, const double * spos, const double * cinv, + const double * wdwave, const double * ufric, const double * z0m, const double * aird, + const double * rnfac, const double * coswdif, const double * sinwdif2, double * tauw, + double * tauwdir, double * phiwa, int llphiwa, const double * costh, double delth, + double eps1, const double * fr5, double g, double gamnconst, double gm1, int iphys, + int jtot_tauhf, int llgcbz0, int llnormagam, int nang, int nfre, int nwav_gc, + const double * omega_gc, const double * rhowg_dfim, const double * sinth, + double sqrtgosurft, double tauwshelter, const double * wtauhf, double x0tauhf, + double xkappa, const double * xkm_gc, const double * xk_gc, double xlogkratiom1_gc, + double zalp, double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk, + int nchnk, int ij, double * xstress, double * ystress, double * tauhf, double * phihf, + double * usdirp, double * ust) { + + + + const int nfre_loki_param = 36; + const int nang_loki_param = 24; + int m; + int k; + int i; + int j; + int ii; + + double tautous2; + double cosw; + double fcosw2; + + double cmrhowgdfth; + double taux; + double tauy; + double taupx; + double taupy; + double sumt; + double sumx; + double sumy; + + int ltauwshelter; + + + phiwa[ij - 1] = (double) 0.0; + xstress[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + ystress[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + if (llphiwa) { + for (m = 1; m <= nfre; m += 1) { + for (k = 1; k <= nang; k += 1) { + phiwa[ij - 1] = phiwa[ij - 1] + (sl[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1 + ))] - spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))])*rhowg_dfim[m - 1]; + } + } + } + for (m = 1; m <= nfre; m += 1) { + // THE INTEGRATION ONLY UP TO FR=MIJ SINCE RHOWGDFTH=0 FOR FR>MIJ + k = 1; + sumx = spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]*sinth[k - 1]; + sumy = spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]*costh[k - 1]; + for (k = 2; k <= nang; k += 1) { + sumx = sumx + spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]*sinth[k - 1]; + sumy = sumy + spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]*costh[k - 1]; + } + cmrhowgdfth = rhowgdfth[ij - 1 + kijl*(m - 1)]*cinv[ij - 1 + kijl*(m - 1 + + nfre_loki_param*(ichnk - 1))]; + xstress[ij - 1 + kijl*(ichnk - 1)] = + xstress[ij - 1 + kijl*(ichnk - 1)] + cmrhowgdfth*sumx; + ystress[ij - 1 + kijl*(ichnk - 1)] = + ystress[ij - 1 + kijl*(ichnk - 1)] + cmrhowgdfth*sumy; + } + xstress[ij - 1 + kijl*(ichnk - 1)] = xstress[ij - 1 + kijl*(ichnk - 1)] / max((double) + (aird[ij - 1 + kijl*(ichnk - 1)]), (double) ((double) 1.0)); + ystress[ij - 1 + kijl*(ichnk - 1)] = ystress[ij - 1 + kijl*(ichnk - 1)] / max((double) + (aird[ij - 1 + kijl*(ichnk - 1)]), (double) ((double) 1.0)); + + if (llphiwa) { + for (m = 1; m <= nfre; m += 1) { + // THE INTEGRATION ONLY UP TO FR=MIJ SINCE RHOWGDFTH=0 FOR FR>MIJ + k = 1; + sumt = spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + for (k = 2; k <= nang; k += 1) { + sumt = sumt + spos[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + } + phiwa[ij - 1] = phiwa[ij - 1] + rhowgdfth[ij - 1 + kijl*(m - 1)]*sumt; + } + } + if (iphys == 0 || tauwshelter == (double) 0.0) { + ltauwshelter = false; + usdirp[ij - 1 + kijl*(ichnk - 1)] = wdwave[ij - 1 + kijl*(ichnk - 1)]; + ust[ij - 1 + kijl*(ichnk - 1)] = ufric[ij - 1 + kijl*(ichnk - 1)]; + } else { + ltauwshelter = true; + taux = + (pow(ufric[ij - 1 + kijl*(ichnk - 1)], 2))*sin(wdwave[ij - 1 + kijl*(ichnk - 1)]); + tauy = + (pow(ufric[ij - 1 + kijl*(ichnk - 1)], 2))*cos(wdwave[ij - 1 + kijl*(ichnk - 1)]); + taupx = taux - tauwshelter*xstress[ij - 1 + kijl*(ichnk - 1)]; + taupy = tauy - tauwshelter*ystress[ij - 1 + kijl*(ichnk - 1)]; + usdirp[ij - 1 + kijl*(ichnk - 1)] = atan2(taupx, taupy); + ust[ij - 1 + kijl*(ichnk - 1)] = + pow(((pow(taupx, 2)) + (pow(taupy, 2))), (double) 0.25); + } + + + tau_phi_hf_c(kijs, kijl, mij, ltauwshelter, ufric, z0m, fl1, aird, rnfac, coswdif, + sinwdif2, (&ust[ + kijl*(ichnk - 1)]), (&tauhf[ + kijl*(ichnk - 1)]), + (&phihf[ + kijl*(ichnk - 1)]), llphiwa, delth, fr5, g, gamnconst, gm1, jtot_tauhf, + llgcbz0, llnormagam, nang, nwav_gc, omega_gc, sqrtgosurft, tauwshelter, wtauhf, + x0tauhf, xkappa, xkm_gc, xk_gc, xlogkratiom1_gc, zalp, zpi4gm1, zpi4gm2, zpifr, + ichnk, nchnk, ij); + + + xstress[ij - 1 + kijl*(ichnk - 1)] = xstress[ij - 1 + kijl*(ichnk - 1)] + tauhf[ij - 1 + + kijl*(ichnk - 1)]*sin(usdirp[ij - 1 + kijl*(ichnk - 1)]); + ystress[ij - 1 + kijl*(ichnk - 1)] = ystress[ij - 1 + kijl*(ichnk - 1)] + tauhf[ij - 1 + + kijl*(ichnk - 1)]*cos(usdirp[ij - 1 + kijl*(ichnk - 1)]); + tauw[ij - 1 + kijl*(ichnk - 1)] = sqrt((double) ((pow(xstress[ij - 1 + kijl*(ichnk - 1) + ], 2)) + (pow(ystress[ij - 1 + kijl*(ichnk - 1)], 2)))); + tauw[ij - 1 + kijl*(ichnk - 1)] = + max((double) (tauw[ij - 1 + kijl*(ichnk - 1)]), (double) ((double) 0.0)); + tauwdir[ij - 1 + kijl*(ichnk - 1)] = + atan2(xstress[ij - 1 + kijl*(ichnk - 1)], ystress[ij - 1 + kijl*(ichnk - 1)]); + + if (!llgcbz0) { + tautous2 = (double) 1.0 / ((double) 1.0 + eps1); + tauw[ij - 1 + kijl*(ichnk - 1)] = min((double) (tauw[ij - 1 + kijl*(ichnk - 1)]), + (double) ((pow(ufric[ij - 1 + kijl*(ichnk - 1)], 2))*tautous2)); + } + + if (llphiwa) { + phiwa[ij - 1] = phiwa[ij - 1] + phihf[ij - 1 + kijl*(ichnk - 1)]; + } + + + +} diff --git a/src/phys-scc-cuda/stresso_c.h b/src/phys-scc-cuda/stresso_c.h new file mode 100644 index 00000000..8fca853e --- /dev/null +++ b/src/phys-scc-cuda/stresso_c.h @@ -0,0 +1,21 @@ +#include +#include +#include +#include +#include +#include +#include "tau_phi_hf_c.h" + +__device__ void stresso_c(int kijs, int kijl, const int * mij, const double * rhowgdfth, + const double * fl1, const double * sl, const double * spos, const double * cinv, + const double * wdwave, const double * ufric, const double * z0m, const double * aird, + const double * rnfac, const double * coswdif, const double * sinwdif2, double * tauw, + double * tauwdir, double * phiwa, int llphiwa, const double * costh, double delth, + double eps1, const double * fr5, double g, double gamnconst, double gm1, int iphys, + int jtot_tauhf, int llgcbz0, int llnormagam, int nang, int nfre, int nwav_gc, + const double * omega_gc, const double * rhowg_dfim, const double * sinth, + double sqrtgosurft, double tauwshelter, const double * wtauhf, double x0tauhf, + double xkappa, const double * xkm_gc, const double * xk_gc, double xlogkratiom1_gc, + double zalp, double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk, + int nchnk, int ij, double * xstress, double * ystress, double * tauhf, double * phihf, + double * usdirp, double * ust); diff --git a/src/phys-scc-cuda/stresso_fc.F90 b/src/phys-scc-cuda/stresso_fc.F90 new file mode 100644 index 00000000..ccf8ee75 --- /dev/null +++ b/src/phys-scc-cuda/stresso_fc.F90 @@ -0,0 +1,157 @@ +MODULE STRESSO_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE STRESSO_fc (KIJS, KIJL, MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, COSWDIF, SINWDIF2, & + & TAUW, TAUWDIR, PHIWA, LLPHIWA, COSTH, DELTH, EPS1, FR5, G, GAMNCONST, GM1, IPHYS, JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, & + & NFRE, NWAV_GC, OMEGA_GC, RHOWG_DFIM, SINTH, SQRTGOSURFT, TAUWSHELTER, WTAUHF, X0TAUHF, XKAPPA, XKM_GC, XK_GC, & + & XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ, XSTRESS, YSTRESS, TAUHF, PHIHF, USDIRP, UST) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + LOGICAL, VALUE, INTENT(IN) :: LLPHIWA + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE STRESSO_iso_c (KIJS, KIJL, MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, COSWDIF, & + & SINWDIF2, TAUW, TAUWDIR, PHIWA, LLPHIWA, COSTH, DELTH, EPS1, FR5, G, GAMNCONST, GM1, IPHYS, JTOT_TAUHF, LLGCBZ0, & + & LLNORMAGAM, NANG, NFRE, NWAV_GC, OMEGA_GC, RHOWG_DFIM, SINTH, SQRTGOSURFT, TAUWSHELTER, WTAUHF, X0TAUHF, XKAPPA, XKM_GC, & + & XK_GC, XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ, XSTRESS, YSTRESS, TAUHF, PHIHF, USDIRP, UST) & + & BIND(c, name="stresso_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: MIJ + TYPE(c_ptr), VALUE :: RHOWGDFTH + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: SL + TYPE(c_ptr), VALUE :: SPOS + TYPE(c_ptr), VALUE :: CINV + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: Z0M + TYPE(c_ptr), VALUE :: AIRD + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: SINWDIF2 + TYPE(c_ptr), VALUE :: TAUW + TYPE(c_ptr), VALUE :: TAUWDIR + TYPE(c_ptr), VALUE :: PHIWA + LOGICAL, VALUE :: LLPHIWA + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: DELTH + REAL, VALUE :: EPS1 + TYPE(c_ptr), VALUE :: FR5 + REAL, VALUE :: G + REAL, VALUE :: GAMNCONST + REAL, VALUE :: GM1 + INTEGER(KIND=c_int), VALUE :: IPHYS + INTEGER(KIND=c_int), VALUE :: JTOT_TAUHF + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OMEGA_GC + TYPE(c_ptr), VALUE :: RHOWG_DFIM + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: SQRTGOSURFT + REAL, VALUE :: TAUWSHELTER + TYPE(c_ptr), VALUE :: WTAUHF + REAL, VALUE :: X0TAUHF + REAL, VALUE :: XKAPPA + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + REAL, VALUE :: ZALP + REAL, VALUE :: ZPI4GM1 + REAL, VALUE :: ZPI4GM2 + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + TYPE(c_ptr), VALUE :: XSTRESS + TYPE(c_ptr), VALUE :: YSTRESS + TYPE(c_ptr), VALUE :: TAUHF + TYPE(c_ptr), VALUE :: PHIHF + TYPE(c_ptr), VALUE :: USDIRP + TYPE(c_ptr), VALUE :: UST + END SUBROUTINE STRESSO_iso_c + END INTERFACE + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIWA(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UST(:, :) +!$acc host_data use_device( MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, COSWDIF, SINWDIF2, TAUW, & +!$acc & TAUWDIR, PHIWA, COSTH, FR5, OMEGA_GC, RHOWG_DFIM, SINTH, WTAUHF, XKM_GC, XK_GC, ZPIFR, XSTRESS, YSTRESS, TAUHF, PHIHF, & +!$acc & USDIRP, UST ) + CALL STRESSO_iso_c(KIJS, KIJL, c_loc(MIJ), c_loc(RHOWGDFTH), c_loc(FL1), c_loc(SL), c_loc(SPOS), c_loc(CINV), c_loc(WDWAVE), & + & c_loc(UFRIC), c_loc(Z0M), c_loc(AIRD), c_loc(RNFAC), c_loc(COSWDIF), c_loc(SINWDIF2), c_loc(TAUW), c_loc(TAUWDIR), & + & c_loc(PHIWA), LLPHIWA, c_loc(COSTH), DELTH, EPS1, c_loc(FR5), G, GAMNCONST, GM1, IPHYS, JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, & + & NANG, NFRE, NWAV_GC, c_loc(OMEGA_GC), c_loc(RHOWG_DFIM), c_loc(SINTH), SQRTGOSURFT, TAUWSHELTER, c_loc(WTAUHF), X0TAUHF, & + & XKAPPA, c_loc(XKM_GC), c_loc(XK_GC), XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, c_loc(ZPIFR), ICHNK, NCHNK, IJ, & + & c_loc(XSTRESS), c_loc(YSTRESS), c_loc(TAUHF), c_loc(PHIHF), c_loc(USDIRP), c_loc(UST)) +!$acc end host_data + END SUBROUTINE STRESSO_fc +END MODULE STRESSO_FC_MOD diff --git a/src/phys-scc-cuda/stresso_fc.intfb.h b/src/phys-scc-cuda/stresso_fc.intfb.h new file mode 100644 index 00000000..3f3934df --- /dev/null +++ b/src/phys-scc-cuda/stresso_fc.intfb.h @@ -0,0 +1,79 @@ +INTERFACE + SUBROUTINE STRESSO_FC (KIJS, KIJL, MIJ, RHOWGDFTH, FL1, SL, SPOS, CINV, WDWAVE, UFRIC, Z0M, AIRD, RNFAC, COSWDIF, SINWDIF2, & + & TAUW, TAUWDIR, PHIWA, LLPHIWA, COSTH, DELTH, EPS1, FR5, G, GAMNCONST, GM1, IPHYS, JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, & + & NFRE, NWAV_GC, OMEGA_GC, RHOWG_DFIM, SINTH, SQRTGOSURFT, TAUWSHELTER, WTAUHF, X0TAUHF, XKAPPA, XKM_GC, XK_GC, & + & XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ, XSTRESS, YSTRESS, TAUHF, PHIHF, USDIRP, UST) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: FR, TH + + USE TAU_PHI_HF_FC_MOD, ONLY: TAU_PHI_HF_FC + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SL(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SPOS(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIWA(:) + LOGICAL, VALUE, INTENT(IN) :: LLPHIWA + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: XSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: YSTRESS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIHF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USDIRP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UST(:, :) + + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IPHYS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWG_DFIM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE STRESSO_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/tau_phi_hf.c_hoist.F90 b/src/phys-scc-cuda/tau_phi_hf.c_hoist.F90 new file mode 100644 index 00000000..7951dc52 --- /dev/null +++ b/src/phys-scc-cuda/tau_phi_hf.c_hoist.F90 @@ -0,0 +1,461 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE TAU_PHI_HF_FC_MOD + !CONTAINED SUBROUTINES: + ! - OMEGAGC + ! - TAU_PHI_HF + CONTAINS + ATTRIBUTES(DEVICE) SUBROUTINE OMEGAGC_FC (UST, NS, XKS, OMS, NWAV_GC, OMEGA_GC, SQRTGOSURFT, XKM_GC, XK_GC, XLOGKRATIOM1_GC) + + !*** DETERMINE THE CUT-OFF ANGULAR FREQUENCY FOR THE GRAV-CAPILLARY WAVES + ! !!!! rounded to the closest index of XK_GC !!!!! + + ! AUTHOR: PETER JANSSEN + ! ------ + + ! REFERENCES: + ! ---------- + + ! VIERS PAPER EQ.(29) + + !---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION NS_GC_FC (USTAR) + USE parkind_wave, ONLY: jwrb + INTEGER :: NS_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + END FUNCTION NS_GC_FC + END INTERFACE + REAL(KIND=JWRB), INTENT(IN) :: UST + INTEGER(KIND=JWIM), INTENT(OUT) :: NS ! index in array XK_GC corresponding to XKS and OMS + REAL(KIND=JWRB), INTENT(OUT) :: XKS ! cut-off wave number + REAL(KIND=JWRB), INTENT(OUT) :: OMS ! cut-off angular frequency + + INTEGER(KIND=JWIM), INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), INTENT(IN) :: XLOGKRATIOM1_GC +!$acc routine seq + + + ! ---------------------------------------------------------------------- + + + NS = NS_GC_FC(UST, NWAV_GC, SQRTGOSURFT, XKM_GC, XLOGKRATIOM1_GC) + XKS = XK_GC(NS) + OMS = OMEGA_GC(NS) + + + END SUBROUTINE OMEGAGC_FC + + ATTRIBUTES(DEVICE) SUBROUTINE TAU_PHI_HF_FC (KIJS, KIJL, MIJ, LTAUWSHELTER, UFRIC, Z0M, FL1, AIRD, RNFAC, COSWDIF, SINWDIF2, & + & UST, TAUHF, PHIHF, LLPHIHF, DELTH, FR5, G, GAMNCONST, GM1, JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, NWAV_GC, OMEGA_GC, & + & SQRTGOSURFT, TAUWSHELTER, WTAUHF, X0TAUHF, XKAPPA, XKM_GC, XK_GC, XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, & + & NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *TAU_PHI_HF* - COMPUTATION OF HIGH-FREQUENCY STRESS. + ! HIGH-FREQUENCY ENERGY FLUX. + + ! PETER A.E.M. JANSSEN KNMI OCTOBER 90 + ! JEAN BIDLOT ECMWF JANUARY 2017 + + !* PURPOSE. + ! --------- + + ! COMPUTE HIGH-FREQUENCY WAVE STRESS AND ENERGY FLUX + + !** INTERFACE. + ! --------- + + ! *CALL* *TAU_PHI_HF(KIJS, KIJL, MIJ, LTAUWSHELTER, UFRIC, UST, Z0M, + ! FL1, AIRD, RNFAC, + ! COSWDIF, SINWDIF2, + ! UST, TAUHF, PHIHF, LLPHIHF) + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *MIJ* - LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE. + ! *LTAUWSHELTER* - if true then TAUWSHELTER + ! *FL1* - WAVE SPECTRUM. + ! *AIRD* - AIR DENSITY IN KG/M**3. + ! *RNFAC* - WIND DEPENDENT FACTOR USED IN THE GROWTH RENORMALISATION. + ! *UFRIC* - FRICTION VELOCITY + ! *COSWDIF* - COS(TH(K)-WDWAVE(IJ)) + ! *SINWDIF2* - SIN(TH(K)-WDWAVE(IJ))**2 + ! *UST* - REDUCED FRICTION VELOCITY DUE TO SHELTERING + ! *Z0M* - ROUGHNESS LENGTH + ! *TAUHF* - HIGH-FREQUENCY STRESS + ! *PHIHF* - HIGH-FREQUENCY ENERGY FLUX INTO OCEAN + ! *LLPHIHF* - TRUE IF PHIHF NEEDS TO COMPUTED + + + ! METHOD. + ! ------- + + ! IT NEEDS A CALL TO INIT_X0TAUHF TO INITIALISE + ! SEE REFERENCE FOR WAVE STRESS CALCULATION. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! FOR QUASILINEAR EFFECT SEE PETER A.E.M. JANSSEN,1990. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWFRED, ONLY: TH + USE YOWPARAM, ONLY: NFRE + USE YOWPCONS, ONLY: ZPI + USE YOWTEST, ONLY: IU06 + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + LOGICAL, VALUE, INTENT(IN) :: LTAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UST(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUHF(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIHF(:) + LOGICAL, VALUE, INTENT(IN) :: LLPHIHF + + + INTEGER(KIND=JWIM) :: J + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: NS + + REAL(KIND=JWRB), PARAMETER :: ZSUPMAX = 0.0_JWRB ! LOG(1.) + REAL(KIND=JWRB) :: OMEGA + REAL(KIND=JWRB) :: OMEGACC + REAL(KIND=JWRB) :: X0G + REAL(KIND=JWRB) :: YC + REAL(KIND=JWRB) :: Y + REAL(KIND=JWRB) :: CM1 + REAL(KIND=JWRB) :: ZX + REAL(KIND=JWRB) :: ZARG + REAL(KIND=JWRB) :: ZLOG + REAL(KIND=JWRB) :: ZBETA + REAL(KIND=JWRB) :: FNC + REAL(KIND=JWRB) :: FNC2 + REAL(KIND=JWRB) :: GAMNORMA ! RENORMALISATION FACTOR OF THE GROWTH RATE + REAL(KIND=JWRB) :: ZNZ + REAL(KIND=JWRB) :: CONFG + REAL(KIND=JWRB) :: COSW + REAL(KIND=JWRB) :: FCOSW2 + + REAL(KIND=JWRB) :: XKS + REAL(KIND=JWRB) :: OMS + REAL(KIND=JWRB) :: SQRTZ0OG + REAL(KIND=JWRB) :: ZSUP + REAL(KIND=JWRB) :: ZINF + REAL(KIND=JWRB) :: DELZ + REAL(KIND=JWRB) :: TAUL + REAL(KIND=JWRB) :: XLOGGZ0 + REAL(KIND=JWRB) :: SQRTGZ0 + REAL(KIND=JWRB) :: USTPH + REAL(KIND=JWRB) :: CONST1 + REAL(KIND=JWRB) :: CONST2 + REAL(KIND=JWRB) :: CONSTTAU + REAL(KIND=JWRB) :: CONSTPHI + REAL(KIND=JWRB) :: F1DCOS2 + REAL(KIND=JWRB) :: F1DCOS3 + REAL(KIND=JWRB) :: F1D + REAL(KIND=JWRB) :: F1DSIN2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + + IF (LLGCBZ0) THEN + CALL OMEGAGC_FC(UFRIC(IJ, ICHNK), NS, XKS, OMS, NWAV_GC, OMEGA_GC(:), SQRTGOSURFT, XKM_GC(:), XK_GC(:), XLOGKRATIOM1_GC) + END IF + + ! See INIT_X0TAUHF + X0G = X0TAUHF*G + + IF (LLPHIHF) USTPH = UST(IJ) + + !* COMPUTE THE INTEGRALS + ! --------------------- + + XLOGGZ0 = LOG(G*Z0M(IJ, ICHNK)) + OMEGACC = MAX(ZPIFR(MIJ(IJ, ICHNK)), X0G / UST(IJ)) + SQRTZ0OG = SQRT(Z0M(IJ, ICHNK)*GM1) + SQRTGZ0 = 1.0_JWRB / SQRTZ0OG + YC = OMEGACC*SQRTZ0OG + ZINF = LOG(YC) + + CONSTTAU = ZPI4GM2*FR5(MIJ(IJ, ICHNK)) + + K = 1 + COSW = MAX(COSWDIF(IJ, K), 0.0_JWRB) + FCOSW2 = FL1(IJ, K, MIJ(IJ, ICHNK), ICHNK)*COSW**2 + F1DCOS3 = FCOSW2*COSW + F1DCOS2 = FCOSW2 + F1DSIN2 = FL1(IJ, K, MIJ(IJ, ICHNK), ICHNK)*SINWDIF2(IJ, K) + F1D = FL1(IJ, K, MIJ(IJ, ICHNK), ICHNK) + DO K=2,NANG + COSW = MAX(COSWDIF(IJ, K), 0.0_JWRB) + FCOSW2 = FL1(IJ, K, MIJ(IJ, ICHNK), ICHNK)*COSW**2 + F1DCOS3 = F1DCOS3 + FCOSW2*COSW + F1DCOS2 = F1DCOS2 + FCOSW2 + F1DSIN2 = F1DSIN2 + FL1(IJ, K, MIJ(IJ, ICHNK), ICHNK)*SINWDIF2(IJ, K) + F1D = F1D + FL1(IJ, K, MIJ(IJ, ICHNK), ICHNK) + END DO + F1DCOS3 = DELTH*F1DCOS3 + F1DCOS2 = DELTH*F1DCOS2 + F1DSIN2 = DELTH*F1DSIN2 + F1D = DELTH*F1D + + IF (LLNORMAGAM) THEN + CONFG = GAMNCONST*FR5(MIJ(IJ, ICHNK))*RNFAC(IJ)*SQRTGZ0 + CONST1 = CONFG*F1DSIN2 + CONST2 = CONFG*F1D + ELSE + CONST1 = 0.0_JWRB + CONST2 = 0.0_JWRB + END IF + + + ! TAUHF : + IF (LLGCBZ0) THEN + ZSUP = MIN(LOG(OMS*SQRTZ0OG), ZSUPMAX) + ELSE + ZSUP = ZSUPMAX + END IF + + TAUL = UST(IJ)**2 + DELZ = MAX((ZSUP - ZINF) / REAL(JTOT_TAUHF - 1, kind=JWRB), 0.0_JWRB) + TAUHF(IJ) = 0.0_JWRB + + ! Intergrals are integrated following a change of variable : Z=LOG(Y) + IF (LTAUWSHELTER) THEN + DO J=1,JTOT_TAUHF + Y = EXP(ZINF + REAL(J - 1, kind=JWRB)*DELZ) + OMEGA = Y*SQRTGZ0 + CM1 = OMEGA*GM1 + ZX = UST(IJ)*CM1 + ZALP + ZARG = XKAPPA / ZX + ZLOG = XLOGGZ0 + 2.0_JWRB*LOG(CM1) + ZARG + ZLOG = MIN(ZLOG, 0.0_JWRB) + ZBETA = ZLOG**4*EXP(ZLOG) + ZNZ = ZBETA*UST(IJ)*Y + GAMNORMA = (1.0_JWRB + CONST1*ZNZ) / (1.0_JWRB + CONST2*ZNZ) + FNC2 = F1DCOS3*CONSTTAU*ZBETA*TAUL*WTAUHF(J)*DELZ*GAMNORMA + TAUL = MAX(TAUL - TAUWSHELTER*FNC2, 0.0_JWRB) + + UST(IJ) = SQRT(TAUL) + TAUHF(IJ) = TAUHF(IJ) + FNC2 + END DO + ELSE + DO J=1,JTOT_TAUHF + Y = EXP(ZINF + REAL(J - 1, kind=JWRB)*DELZ) + OMEGA = Y*SQRTGZ0 + CM1 = OMEGA*GM1 + ZX = UST(IJ)*CM1 + ZALP + ZARG = XKAPPA / ZX + ZLOG = XLOGGZ0 + 2.0_JWRB*LOG(CM1) + ZARG + ZLOG = MIN(ZLOG, 0.0_JWRB) + ZBETA = ZLOG**4*EXP(ZLOG) + FNC2 = ZBETA*WTAUHF(J) + ZNZ = ZBETA*UST(IJ)*Y + GAMNORMA = (1.0_JWRB + CONST1*ZNZ) / (1.0_JWRB + CONST2*ZNZ) + TAUHF(IJ) = TAUHF(IJ) + FNC2*GAMNORMA + END DO + TAUHF(IJ) = F1DCOS3*CONSTTAU*TAUL*TAUHF(IJ)*DELZ + END IF + + + PHIHF(IJ) = 0.0_JWRB + IF (LLPHIHF) THEN + ! PHIHF: + ! We are neglecting the gravity-capillary contribution + ! Recompute DELZ over the full interval + TAUL = USTPH**2 + ZSUP = ZSUPMAX + DELZ = MAX((ZSUP - ZINF) / REAL(JTOT_TAUHF - 1, kind=JWRB), 0.0_JWRB) + + CONSTPHI = AIRD(IJ, ICHNK)*ZPI4GM1*FR5(MIJ(IJ, ICHNK)) + + ! Intergrals are integrated following a change of variable : Z=LOG(Y) + IF (LTAUWSHELTER) THEN + DO J=1,JTOT_TAUHF + Y = EXP(ZINF + REAL(J - 1, kind=JWRB)*DELZ) + OMEGA = Y*SQRTGZ0 + CM1 = OMEGA*GM1 + ZX = USTPH*CM1 + ZALP + ZARG = XKAPPA / ZX + ZLOG = XLOGGZ0 + 2.0_JWRB*LOG(CM1) + ZARG + ZLOG = MIN(ZLOG, 0.0_JWRB) + ZBETA = ZLOG**4*EXP(ZLOG) + ZNZ = ZBETA*UST(IJ)*Y + GAMNORMA = (1.0_JWRB + CONST1*ZNZ) / (1.0_JWRB + CONST2*ZNZ) + FNC2 = ZBETA*TAUL*WTAUHF(J)*DELZ*GAMNORMA + TAUL = MAX(TAUL - TAUWSHELTER*F1DCOS3*CONSTTAU*FNC2, 0.0_JWRB) + USTPH = SQRT(TAUL) + PHIHF(IJ) = PHIHF(IJ) + FNC2 / Y + END DO + PHIHF(IJ) = F1DCOS2*CONSTPHI*SQRTZ0OG*PHIHF(IJ) + ELSE + DO J=1,JTOT_TAUHF + Y = EXP(ZINF + REAL(J - 1, kind=JWRB)*DELZ) + OMEGA = Y*SQRTGZ0 + CM1 = OMEGA*GM1 + ZX = USTPH*CM1 + ZALP + ZARG = XKAPPA / ZX + ZLOG = XLOGGZ0 + 2.0_JWRB*LOG(CM1) + ZARG + ZLOG = MIN(ZLOG, 0.0_JWRB) + ZBETA = ZLOG**4*EXP(ZLOG) + ZNZ = ZBETA*UST(IJ)*Y + GAMNORMA = (1.0_JWRB + CONST1*ZNZ) / (1.0_JWRB + CONST2*ZNZ) + FNC2 = ZBETA*WTAUHF(J)*GAMNORMA + PHIHF(IJ) = PHIHF(IJ) + FNC2 / Y + END DO + PHIHF(IJ) = F1DCOS2*CONSTPHI*SQRTZ0OG*TAUL*PHIHF(IJ)*DELZ + END IF + END IF + + + + END SUBROUTINE TAU_PHI_HF_FC +END MODULE TAU_PHI_HF_FC_MOD +MODULE MEANSQS_GC_FC_MOD + !CONTAINED SUBROUTINES: + ! - MEANSQS_GC + CONTAINS + SUBROUTINE MEANSQS_GC (XKMSS, KIJS, KIJL, HALP, USTAR, XMSSCG, FRGC) + + !*** DETERMINE MSS FOR GRAV-CAP WAVES UP TO WAVE NUMBER XKMSS + + ! AUTHOR: PETER JANSSEN + ! ------ + + ! REFERENCES: + ! ---------- + + ! VIERS PAPER EQ.(29) + + !---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + USE YOWFRED, ONLY: NWAV_GC, XLOGKRATIOM1_GC, XKM_GC, VG_GC, C2OSQRTVG_GC, DELKCC_GC, DELKCC_GC_NS + USE YOWPCONS, ONLY: G, ZPI, SURFT + + USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK + USE TAU_PHI_HF_MOD, ONLY: OMEGAGC + + !---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + + REAL(KIND=JWRB), INTENT(IN) :: XKMSS ! WAVE NUMBER CUT-OFF + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: HALP ! 1/2 Phillips parameter + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: USTAR ! friction velocity + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: XMSSCG ! mean square slope for gravity-capillary waves + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL) :: FRGC ! Frequency from which the gravity-capillary spectrum is approximated + + + INTEGER(KIND=JWIM) :: IJ, I, NE + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: NS + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + REAL(KIND=JWRB), DIMENSION(KIJL) :: XKS, OMS, COEF + + ! INCLUDE FUNCTIONS FROM GRAVITY-CAPILLARY DISPERSION REALTIONS +#include "gc_dispersion.h" + + ! ---------------------------------------------------------------------- + + IF (LHOOK) CALL DR_HOOK('MEANSQS_GC', 0, ZHOOK_HANDLE) + + NE = MIN(MAX(NINT(LOG(XKMSS*XKM_GC(1))*XLOGKRATIOM1_GC), 1), NWAV_GC) + + DO IJ=KIJS,KIJL + CALL OMEGAGC(USTAR(IJ), NS(IJ), XKS(IJ), OMS(IJ)) + FRGC(IJ) = OMS(IJ) / ZPI + IF (XKS(IJ) > XKMSS) THEN + NS(IJ) = NE + XMSSCG(IJ) = 0.0_JWRB + ELSE + XMSSCG(IJ) = DELKCC_GC_NS(NS(IJ))*XKM_GC(NS(IJ)) + END IF + END DO + + DO IJ=KIJS,KIJL + DO I=NS(IJ) + 1,NE + ! ANALYTICAL FORM INERTIAL SUB RANGE F(k) = k**(-4)*BB + ! BB = COEF(IJ)*SQRT(VG_GC(I))/C_GC(I)**2 + ! mss : integral of k**2 F(k) k dk + XMSSCG(IJ) = XMSSCG(IJ) + DELKCC_GC(I)*XKM_GC(I) + END DO + COEF(IJ) = C2OSQRTVG_GC(NS(IJ))*HALP(IJ) + XMSSCG(IJ) = XMSSCG(IJ)*COEF(IJ) + END DO + + IF (LHOOK) CALL DR_HOOK('MEANSQS_GC', 1, ZHOOK_HANDLE) + + END SUBROUTINE MEANSQS_GC +END MODULE MEANSQS_GC_FC_MOD diff --git a/src/phys-scc-cuda/tau_phi_hf_c.c b/src/phys-scc-cuda/tau_phi_hf_c.c new file mode 100644 index 00000000..c36c28f4 --- /dev/null +++ b/src/phys-scc-cuda/tau_phi_hf_c.c @@ -0,0 +1,215 @@ +#include +#include +#include +#include +#include +#include +#include "tau_phi_hf_c.h" +#include "omegagc_c.c" + +__device__ void tau_phi_hf_c(int kijs, int kijl, const int * mij, int ltauwshelter, + const double * ufric, const double * z0m, const double * fl1, const double * aird, + const double * rnfac, const double * coswdif, const double * sinwdif2, double * ust, + double * tauhf, double * phihf, int llphihf, double delth, const double * fr5, + double g, double gamnconst, double gm1, int jtot_tauhf, int llgcbz0, int llnormagam, + int nang, int nwav_gc, const double * omega_gc, double sqrtgosurft, + double tauwshelter, const double * wtauhf, double x0tauhf, double xkappa, + const double * xkm_gc, const double * xk_gc, double xlogkratiom1_gc, double zalp, + double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk, int nchnk, int ij) { + + + + const int nang_loki_param = 24; + const int nfre_loki_param = 36; + int j; + int k; + int ns; + + double zsupmax = (double) 0.0; // LOG(1.) + double omega; + double omegacc; + double x0g; + double yc; + double y; + double cm1; + double zx; + double zarg; + double zlog; + double zbeta; + double fnc; + double fnc2; + double gamnorma; // RENORMALISATION FACTOR OF THE GROWTH RATE + double znz; + double confg; + double cosw; + double fcosw2; + + double xks; + double oms; + double sqrtz0og; + double zsup; + double zinf; + double delz; + double taul; + double xloggz0; + double sqrtgz0; + double ustph; + double const1; + double const2; + double consttau; + double constphi; + double f1dcos2; + double f1dcos3; + double f1d; + double f1dsin2; + + + if (llgcbz0) { + omegagc_c(ufric[ij - 1 + kijl*(ichnk - 1)], (&ns), (&xks), (&oms), nwav_gc, + omega_gc, sqrtgosurft, xkm_gc, xk_gc, xlogkratiom1_gc); + } + x0g = x0tauhf*g; + + if (llphihf) { + ustph = ust[ij - 1]; + } + xloggz0 = log(g*z0m[ij - 1 + kijl*(ichnk - 1)]); + omegacc = max((double) (zpifr[mij[ij - 1 + kijl*(ichnk - 1)] - 1]), (double) (x0g / + ust[ij - 1])); + sqrtz0og = sqrt((double) (z0m[ij - 1 + kijl*(ichnk - 1)]*gm1)); + sqrtgz0 = (double) 1.0 / sqrtz0og; + yc = omegacc*sqrtz0og; + zinf = log(yc); + + consttau = zpi4gm2*fr5[mij[ij - 1 + kijl*(ichnk - 1)] - 1]; + + k = 1; + cosw = max((double) (coswdif[ij - 1 + kijl*(k - 1)]), (double) ((double) 0.0)); + fcosw2 = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(mij[ij - 1 + kijl*(ichnk - 1)] - 1 + + nfre_loki_param*(ichnk - 1)))]*(pow(cosw, 2)); + f1dcos3 = fcosw2*cosw; + f1dcos2 = fcosw2; + f1dsin2 = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(mij[ij - 1 + kijl*(ichnk - 1)] - + 1 + nfre_loki_param*(ichnk - 1)))]*sinwdif2[ij - 1 + kijl*(k - 1)]; + f1d = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(mij[ij - 1 + kijl*(ichnk - 1)] - 1 + + nfre_loki_param*(ichnk - 1)))]; + for (k = 2; k <= nang; k += 1) { + cosw = max((double) (coswdif[ij - 1 + kijl*(k - 1)]), (double) ((double) 0.0)); + fcosw2 = fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(mij[ij - 1 + kijl*(ichnk - 1)] - + 1 + nfre_loki_param*(ichnk - 1)))]*(pow(cosw, 2)); + f1dcos3 = f1dcos3 + fcosw2*cosw; + f1dcos2 = f1dcos2 + fcosw2; + f1dsin2 = f1dsin2 + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(mij[ij - 1 + + kijl*(ichnk - 1)] - 1 + nfre_loki_param*(ichnk - 1)))]*sinwdif2[ij - 1 + kijl*(k - + 1)]; + f1d = f1d + fl1[ij - 1 + kijl*(k - 1 + nang_loki_param*(mij[ij - 1 + kijl*(ichnk - 1) + ] - 1 + nfre_loki_param*(ichnk - 1)))]; + } + f1dcos3 = delth*f1dcos3; + f1dcos2 = delth*f1dcos2; + f1dsin2 = delth*f1dsin2; + f1d = delth*f1d; + + if (llnormagam) { + confg = gamnconst*fr5[mij[ij - 1 + kijl*(ichnk - 1)] - 1]*rnfac[ij - 1]*sqrtgz0; + const1 = confg*f1dsin2; + const2 = confg*f1d; + } else { + const1 = (double) 0.0; + const2 = (double) 0.0; + } + if (llgcbz0) { + zsup = min((double) (log(oms*sqrtz0og)), (double) (zsupmax)); + } else { + zsup = zsupmax; + } + + taul = pow(ust[ij - 1], 2); + delz = + max((double) ((zsup - zinf) / (double) (jtot_tauhf - 1)), (double) ((double) 0.0)); + tauhf[ij - 1] = (double) 0.0; + if (ltauwshelter) { + for (j = 1; j <= jtot_tauhf; j += 1) { + y = exp((double) (zinf + (double) (j - 1)*delz)); + omega = y*sqrtgz0; + cm1 = omega*gm1; + zx = ust[ij - 1]*cm1 + zalp; + zarg = xkappa / zx; + zlog = xloggz0 + (double) 2.0*log(cm1) + zarg; + zlog = min((double) (zlog), (double) ((double) 0.0)); + zbeta = (pow(zlog, 4))*exp((double) (zlog)); + znz = zbeta*ust[ij - 1]*y; + gamnorma = ((double) 1.0 + const1*znz) / ((double) 1.0 + const2*znz); + fnc2 = f1dcos3*consttau*zbeta*taul*wtauhf[j - 1]*delz*gamnorma; + taul = max((double) (taul - tauwshelter*fnc2), (double) ((double) 0.0)); + + ust[ij - 1] = sqrt((double) (taul)); + tauhf[ij - 1] = tauhf[ij - 1] + fnc2; + } + } else { + for (j = 1; j <= jtot_tauhf; j += 1) { + y = exp((double) (zinf + (double) (j - 1)*delz)); + omega = y*sqrtgz0; + cm1 = omega*gm1; + zx = ust[ij - 1]*cm1 + zalp; + zarg = xkappa / zx; + zlog = xloggz0 + (double) 2.0*log(cm1) + zarg; + zlog = min((double) (zlog), (double) ((double) 0.0)); + zbeta = (pow(zlog, 4))*exp((double) (zlog)); + fnc2 = zbeta*wtauhf[j - 1]; + znz = zbeta*ust[ij - 1]*y; + gamnorma = ((double) 1.0 + const1*znz) / ((double) 1.0 + const2*znz); + tauhf[ij - 1] = tauhf[ij - 1] + fnc2*gamnorma; + } + tauhf[ij - 1] = f1dcos3*consttau*taul*tauhf[ij - 1]*delz; + } + phihf[ij - 1] = (double) 0.0; + if (llphihf) { + taul = pow(ustph, 2); + zsup = zsupmax; + delz = + max((double) ((zsup - zinf) / (double) (jtot_tauhf - 1)), (double) ((double) 0.0)); + + constphi = + aird[ij - 1 + kijl*(ichnk - 1)]*zpi4gm1*fr5[mij[ij - 1 + kijl*(ichnk - 1)] - 1]; + if (ltauwshelter) { + for (j = 1; j <= jtot_tauhf; j += 1) { + y = exp((double) (zinf + (double) (j - 1)*delz)); + omega = y*sqrtgz0; + cm1 = omega*gm1; + zx = ustph*cm1 + zalp; + zarg = xkappa / zx; + zlog = xloggz0 + (double) 2.0*log(cm1) + zarg; + zlog = min((double) (zlog), (double) ((double) 0.0)); + zbeta = (pow(zlog, 4))*exp((double) (zlog)); + znz = zbeta*ust[ij - 1]*y; + gamnorma = ((double) 1.0 + const1*znz) / ((double) 1.0 + const2*znz); + fnc2 = zbeta*taul*wtauhf[j - 1]*delz*gamnorma; + taul = max((double) (taul - tauwshelter*f1dcos3*consttau*fnc2), (double) ((double + ) 0.0)); + ustph = sqrt((double) (taul)); + phihf[ij - 1] = phihf[ij - 1] + fnc2 / y; + } + phihf[ij - 1] = f1dcos2*constphi*sqrtz0og*phihf[ij - 1]; + } else { + for (j = 1; j <= jtot_tauhf; j += 1) { + y = exp((double) (zinf + (double) (j - 1)*delz)); + omega = y*sqrtgz0; + cm1 = omega*gm1; + zx = ustph*cm1 + zalp; + zarg = xkappa / zx; + zlog = xloggz0 + (double) 2.0*log(cm1) + zarg; + zlog = min((double) (zlog), (double) ((double) 0.0)); + zbeta = (pow(zlog, 4))*exp((double) (zlog)); + znz = zbeta*ust[ij - 1]*y; + gamnorma = ((double) 1.0 + const1*znz) / ((double) 1.0 + const2*znz); + fnc2 = zbeta*wtauhf[j - 1]*gamnorma; + phihf[ij - 1] = phihf[ij - 1] + fnc2 / y; + } + phihf[ij - 1] = f1dcos2*constphi*sqrtz0og*taul*phihf[ij - 1]*delz; + } + } + + + +} diff --git a/src/phys-scc-cuda/tau_phi_hf_c.h b/src/phys-scc-cuda/tau_phi_hf_c.h new file mode 100644 index 00000000..3d5987db --- /dev/null +++ b/src/phys-scc-cuda/tau_phi_hf_c.h @@ -0,0 +1,17 @@ +#include +#include +#include +#include +#include +#include +#include "omegagc_c.h" + +__device__ void tau_phi_hf_c(int kijs, int kijl, const int * mij, int ltauwshelter, + const double * ufric, const double * z0m, const double * fl1, const double * aird, + const double * rnfac, const double * coswdif, const double * sinwdif2, double * ust, + double * tauhf, double * phihf, int llphihf, double delth, const double * fr5, + double g, double gamnconst, double gm1, int jtot_tauhf, int llgcbz0, int llnormagam, + int nang, int nwav_gc, const double * omega_gc, double sqrtgosurft, + double tauwshelter, const double * wtauhf, double x0tauhf, double xkappa, + const double * xkm_gc, const double * xk_gc, double xlogkratiom1_gc, double zalp, + double zpi4gm1, double zpi4gm2, const double * zpifr, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/tau_phi_hf_fc.F90 b/src/phys-scc-cuda/tau_phi_hf_fc.F90 new file mode 100644 index 00000000..c7bf60fe --- /dev/null +++ b/src/phys-scc-cuda/tau_phi_hf_fc.F90 @@ -0,0 +1,119 @@ +MODULE TAU_PHI_HF_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE TAU_PHI_HF_fc (KIJS, KIJL, MIJ, LTAUWSHELTER, UFRIC, Z0M, FL1, AIRD, RNFAC, COSWDIF, SINWDIF2, UST, TAUHF, PHIHF, & + & LLPHIHF, DELTH, FR5, G, GAMNCONST, GM1, JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, NWAV_GC, OMEGA_GC, SQRTGOSURFT, TAUWSHELTER, & + & WTAUHF, X0TAUHF, XKAPPA, XKM_GC, XK_GC, XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + LOGICAL, VALUE, INTENT(IN) :: LTAUWSHELTER + LOGICAL, VALUE, INTENT(IN) :: LLPHIHF + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: DELTH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GAMNCONST + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: JTOT_TAUHF + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUWSHELTER + REAL(KIND=JWRB), VALUE, INTENT(IN) :: X0TAUHF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZPI4GM2 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE TAU_PHI_HF_iso_c (KIJS, KIJL, MIJ, LTAUWSHELTER, UFRIC, Z0M, FL1, AIRD, RNFAC, COSWDIF, SINWDIF2, UST, TAUHF, & + & PHIHF, LLPHIHF, DELTH, FR5, G, GAMNCONST, GM1, JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, NWAV_GC, OMEGA_GC, SQRTGOSURFT, & + & TAUWSHELTER, WTAUHF, X0TAUHF, XKAPPA, XKM_GC, XK_GC, XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, ZPIFR, ICHNK, NCHNK, IJ) & + & BIND(c, name="tau_phi_hf_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: MIJ + LOGICAL, VALUE :: LTAUWSHELTER + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: Z0M + TYPE(c_ptr), VALUE :: FL1 + TYPE(c_ptr), VALUE :: AIRD + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: COSWDIF + TYPE(c_ptr), VALUE :: SINWDIF2 + TYPE(c_ptr), VALUE :: UST + TYPE(c_ptr), VALUE :: TAUHF + TYPE(c_ptr), VALUE :: PHIHF + LOGICAL, VALUE :: LLPHIHF + REAL, VALUE :: DELTH + TYPE(c_ptr), VALUE :: FR5 + REAL, VALUE :: G + REAL, VALUE :: GAMNCONST + REAL, VALUE :: GM1 + INTEGER(KIND=c_int), VALUE :: JTOT_TAUHF + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OMEGA_GC + REAL, VALUE :: SQRTGOSURFT + REAL, VALUE :: TAUWSHELTER + TYPE(c_ptr), VALUE :: WTAUHF + REAL, VALUE :: X0TAUHF + REAL, VALUE :: XKAPPA + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + REAL, VALUE :: ZALP + REAL, VALUE :: ZPI4GM1 + REAL, VALUE :: ZPI4GM2 + TYPE(c_ptr), VALUE :: ZPIFR + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE TAU_PHI_HF_iso_c + END INTERFACE + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: Z0M(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FL1(:, :, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSWDIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINWDIF2(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: UST(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: TAUHF(:) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: PHIHF(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR5(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMEGA_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WTAUHF(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: ZPIFR(:) +!$acc host_data use_device( MIJ, UFRIC, Z0M, FL1, AIRD, RNFAC, COSWDIF, SINWDIF2, UST, TAUHF, PHIHF, FR5, OMEGA_GC, WTAUHF, & +!$acc & XKM_GC, XK_GC, ZPIFR ) + CALL TAU_PHI_HF_iso_c(KIJS, KIJL, c_loc(MIJ), LTAUWSHELTER, c_loc(UFRIC), c_loc(Z0M), c_loc(FL1), c_loc(AIRD), c_loc(RNFAC), & + & c_loc(COSWDIF), c_loc(SINWDIF2), c_loc(UST), c_loc(TAUHF), c_loc(PHIHF), LLPHIHF, DELTH, c_loc(FR5), G, GAMNCONST, GM1, & + & JTOT_TAUHF, LLGCBZ0, LLNORMAGAM, NANG, NWAV_GC, c_loc(OMEGA_GC), SQRTGOSURFT, TAUWSHELTER, c_loc(WTAUHF), X0TAUHF, XKAPPA, & + & c_loc(XKM_GC), c_loc(XK_GC), XLOGKRATIOM1_GC, ZALP, ZPI4GM1, ZPI4GM2, c_loc(ZPIFR), ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE TAU_PHI_HF_fc +END MODULE TAU_PHI_HF_FC_MOD diff --git a/src/phys-scc-cuda/taut_z0.c_hoist.F90 b/src/phys-scc-cuda/taut_z0.c_hoist.F90 new file mode 100644 index 00000000..a25705a9 --- /dev/null +++ b/src/phys-scc-cuda/taut_z0.c_hoist.F90 @@ -0,0 +1,409 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE TAUT_Z0_FC (KIJS, KIJL, IUSFG, HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK, & +& ACD, ALPHA, ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, & +& CM_GC, DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, & +& OMXKM3_GC, RN1_RN, RNU, RNUM, SQRTGOSURFT, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, & +& IJ) + + ! ---------------------------------------------------------------------- + + !**** *TAUT_Z0* - COMPUTATION OF TOTAL STRESS AND ROUGHNESS LENGTH SCALE. + + + !** INTERFACE. + ! ---------- + + ! *CALL* *TAUT_Z0(KIJS, KIJL, IUSFG, FL1, WAVNUM, + ! UTOP, UDIR, TAUW, TAUWDIR, RNFAC, + ! USTAR, Z0, Z0B, CHRNCK) + ! *KIJS* - INDEX OF FIRST GRIDPOINT + ! *KIJL* - INDEX OF LAST GRIDPOINT + ! *IUSFG* - IF = 1 THEN USE THE FRICTION VELOCITY (US) AS FIRST GUESS in TAUT_Z0 + ! 0 DO NOT USE THE FIELD USTAR + ! *FL1* - 2D-SPECTRA + ! *WAVNUM* - WAVE NUMBER + ! *HALP* - 1/2 PHILLIPS PARAMETER + ! *UTOP* - WIND SPEED AT REFERENCE LEVEL XNLEV + ! *UDIR* - WIND SPEED DIRECTION AT REFERENCE LEVEL XNLEV + ! *TAUW* - WAVE STRESS. + ! *TAUWDIR* - WAVE STRESS DIRECTION. + ! *RNFAC* - WIND DEPENDENT FACTOR USED IN THE GROWTH RENORMALISATION. + ! *USTAR* - FRICTION VELOCITY + ! *Z0* - ROUGHNESS LENGTH + ! *Z0B* - BACKGROUND ROUGHNESS LENGTH + ! *CHRNCK* - CHARNOCK COEFFICIENT + + ! METHOD. + ! ------- + + ! A STEADY STATE WIND PROFILE IS ASSUMED. + ! THE WIND STRESS IS COMPUTED USING THE ROUGHNESS LENGTH + + ! Z1=Z0/SQRT(1-TAUW/TAU) + + ! WHERE Z0 IS THE CHARNOCK RELATION , TAUW IS THE WAVE- + ! INDUCED STRESS AND TAU IS THE TOTAL STRESS. + ! WE SEARCH FOR STEADY-STATE SOLUTIONS FOR WHICH TAUW/TAU < 1. + + ! IT WAS EXTENDED TO INCLUDE THE GRAVITY-CAPILLARY MODEL FOR THE CALCULATION + ! OF THE BACKGROUND ROUGHNESS. + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! ---------- + + ! FOR QUASILINEAR EFFECT SEE PETER A.E.M. JANSSEN,1990. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE, NANG + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION CHNKMIN_FC (U10) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: CHNKMIN + REAL(KIND=JWRB), INTENT(IN) :: U10 + END FUNCTION CHNKMIN_FC + END INTERFACE + INTERFACE + FUNCTION STRESS_GC_FC (ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: STRESS_GC + REAL(KIND=JWRB), INTENT(IN) :: ANG_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + REAL(KIND=JWRB), INTENT(IN) :: Z0 + REAL(KIND=JWRB), INTENT(IN) :: Z0MIN + REAL(KIND=JWRB), INTENT(IN) :: HALP + REAL(KIND=JWRB), INTENT(IN) :: RNFAC + END FUNCTION STRESS_GC_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IUSFG + REAL(KIND=JWRB), TARGET, INTENT(IN) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UTOP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + + + INTEGER(KIND=JWIM), PARAMETER :: NITER = 17 + + REAL(KIND=JWRB), PARAMETER :: TWOXMP1 = 3.0_JWRB + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: ITER + INTEGER(KIND=JWIM) :: IFRPH + + ! Cd and Z0 from Hersbach 2010, ECMWF Tech Memo (without the viscous part) + ! CD = ACDLIN + BCDLIN*SQRT(PCHAR) * U10 + REAL(KIND=JWRB), PARAMETER :: ACDLIN = 0.0008_JWRB + REAL(KIND=JWRB), PARAMETER :: BCDLIN = 0.00047_JWRB + REAL(KIND=JWRB) :: ALPHAGM1 + + REAL(KIND=JWRB), PARAMETER :: Z0MIN = 0.000001_JWRB + REAL(KIND=JWRB) :: PCE_GC + REAL(KIND=JWRB) :: Z0MINRST + REAL(KIND=JWRB) :: CHARNOCK_MIN + REAL(KIND=JWRB) :: COSDIFF + REAL(KIND=JWRB) :: ZCHAR + REAL(KIND=JWRB) :: US2TOTAUW + REAL(KIND=JWRB) :: USMAX + REAL(KIND=JWRB) :: XLOGXL + REAL(KIND=JWRB) :: XKUTOP + REAL(KIND=JWRB) :: XOLOGZ0 + REAL(KIND=JWRB) :: USTOLD + REAL(KIND=JWRB) :: USTNEW + REAL(KIND=JWRB) :: TAUOLD + REAL(KIND=JWRB) :: TAUNEW + REAL(KIND=JWRB) :: X + REAL(KIND=JWRB) :: F + REAL(KIND=JWRB) :: DELF + REAL(KIND=JWRB) :: CDFG + REAL(KIND=JWRB) :: USTM1 + REAL(KIND=JWRB) :: Z0TOT + REAL(KIND=JWRB) :: Z0CH + REAL(KIND=JWRB) :: Z0VIS + REAL(KIND=JWRB) :: HZ0VISO1MX + REAL(KIND=JWRB) :: ZZ + REAL(KIND=JWRB) :: CONST + REAL(KIND=JWRB) :: TAUV + REAL(KIND=JWRB) :: DEL + REAL(KIND=JWRB) :: RNUEFF + REAL(KIND=JWRB) :: RNUKAPPAM1 + REAL(KIND=JWRB) :: ALPHAOG + REAL(KIND=JWRB) :: XMIN + REAL(KIND=JWRB) :: W1 + REAL(KIND=JWRB) :: TAUWACT + REAL(KIND=JWRB) :: TAUWEFF + REAL(KIND=JWRB) :: ANG_GC + REAL(KIND=JWRB) :: TAUUNR + + LOGICAL :: LLCOSDIFF + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + XLOGXL = LOG(XNLEV) + US2TOTAUW = 1.0_JWRB + EPS1 + + ! ONLY take the contribution of TAUW that is in the wind direction + + COSDIFF = COS(UDIR(IJ, ICHNK) - TAUWDIR(IJ, ICHNK)) + TAUWACT = MAX(TAUW(IJ, ICHNK)*COSDIFF, EPSMIN) + LLCOSDIFF = COSDIFF > 0.9_JWRB + + ! USING THE CG MODEL: + IF (LLGCBZ0) THEN + + IF (LLCAPCHNK) THEN + CHARNOCK_MIN = CHNKMIN_FC(UTOP(IJ, ICHNK), ALPHA, ALPHAMIN, CHNKMIN_U) + ALPHAOG = CHARNOCK_MIN*GM1 + ELSE + ALPHAOG = 0.0_JWRB + END IF + + USMAX = MAX(-0.21339_JWRB + 0.093698_JWRB*UTOP(IJ, ICHNK) - 0.0020944_JWRB*UTOP(IJ, ICHNK)**2 + 5.5091E-5_JWRB*UTOP(IJ, ICHNK & + & )**3, 0.03_JWRB) + TAUWEFF = MIN(TAUWACT*US2TOTAUW, USMAX**2) + + RNUEFF = 0.04_JWRB*RNU + + RNUKAPPAM1 = RNUEFF / XKAPPA + + PCE_GC = 0.001_JWRB*IUSFG + (1 - IUSFG)*0.005_JWRB + + IF (IUSFG == 0) THEN + ALPHAGM1 = ALPHA*GM1 + IF (UTOP(IJ, ICHNK) < 1.0_JWRB) THEN + CDFG = 0.002_JWRB + ELSE IF (LLCOSDIFF) THEN + X = MIN(TAUWACT / MAX(USTAR(IJ, ICHNK), EPSUS)**2, 0.99_JWRB) + ZCHAR = MIN(ALPHAGM1*USTAR(IJ, ICHNK)**2 / SQRT(1.0_JWRB - X), 0.05_JWRB*EXP(-0.05_JWRB*(UTOP(IJ, ICHNK) - 35._JWRB))) + ZCHAR = MIN(ZCHAR, ALPHAMAX) + CDFG = ACDLIN + BCDLIN*SQRT(ZCHAR)*UTOP(IJ, ICHNK) + ELSE + ! CDFG = CDM(UTOP(IJ)) ! TODO: revert and automate + CDFG = MAX(MIN(0.0006_JWRB + 0.00008_JWRB*UTOP(IJ, ICHNK), 0.001_JWRB + 0.0018_JWRB*EXP(-0.05_JWRB*(UTOP(IJ, ICHNK) - & + & 33._JWRB))), 0.001_JWRB) + END IF + USTAR(IJ, ICHNK) = UTOP(IJ, ICHNK)*SQRT(CDFG) + END IF + + W1 = 0.85_JWRB - 0.05_JWRB*(TANH(10.0_JWRB*(UTOP(IJ, ICHNK) - 5.0_JWRB)) + 1.0_JWRB) + + XKUTOP = XKAPPA*UTOP(IJ, ICHNK) + + USTOLD = USTAR(IJ, ICHNK) + TAUOLD = USTOLD**2 + + DO ITER=1,NITER + ! Z0 IS DERIVED FROM THE NEUTRAL LOG PROFILE: UTOP = (USTAR/XKAPPA)*LOG((XNLEV+Z0)/Z0) + Z0(IJ, ICHNK) = MAX(XNLEV / (EXP(MIN(XKUTOP / USTOLD, 50.0_JWRB)) - 1.0_JWRB), Z0MIN) + ! Viscous kinematic stress nu_air * dU/dz at z=0 of the neutral log profile reduced by factor 25 (0.04) + TAUV = RNUKAPPAM1*USTOLD / Z0(IJ, ICHNK) + + ANG_GC = ANG_GC_A + ANG_GC_B*TANH(ANG_GC_C*TAUOLD) + + TAUUNR = STRESS_GC_FC(ANG_GC, USTAR(IJ, ICHNK), Z0(IJ, ICHNK), Z0MIN, HALP(IJ), RNFAC(IJ), BETAMAXOXKAPPA2, BMAXOKAP, & + & C2OSQRTVG_GC, CM_GC, DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPSUS, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, RN1_RN, & + & SQRTGOSURFT, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, ZALP) + + ! TOTAL kinematic STRESS: + TAUNEW = TAUWEFF + TAUV + TAUUNR + USTNEW = SQRT(TAUNEW) + USTAR(IJ, ICHNK) = W1*USTOLD + (1.0_JWRB - W1)*USTNEW + + ! CONVERGENCE ? + DEL = USTAR(IJ, ICHNK) - USTOLD + IF (ABS(DEL) < PCE_GC*USTAR(IJ, ICHNK)) EXIT + TAUOLD = USTAR(IJ, ICHNK)**2 + USTOLD = USTAR(IJ, ICHNK) + END DO + ! protection just in case there is no convergence + IF (ITER > NITER) THEN + ! CDFG = CDM(UTOP(IJ)) + CDFG = MAX(MIN(0.0006_JWRB + 0.00008_JWRB*UTOP(IJ, ICHNK), 0.001_JWRB + 0.0018_JWRB*EXP(-0.05_JWRB*(UTOP(IJ, ICHNK) - & + & 33._JWRB))), 0.001_JWRB) + USTAR(IJ, ICHNK) = UTOP(IJ, ICHNK)*SQRT(CDFG) + Z0MINRST = USTAR(IJ, ICHNK)**2*ALPHA*GM1 + Z0(IJ, ICHNK) = MAX(XNLEV / (EXP(XKUTOP / USTAR(IJ, ICHNK)) - 1.0_JWRB), Z0MINRST) + Z0B(IJ, ICHNK) = Z0MINRST + ELSE + Z0(IJ, ICHNK) = MAX(XNLEV / (EXP(XKUTOP / USTAR(IJ, ICHNK)) - 1.0_JWRB), Z0MIN) + Z0B(IJ, ICHNK) = Z0(IJ, ICHNK)*SQRT(TAUUNR / TAUOLD) + END IF + + ! Refine solution + X = TAUWEFF / TAUOLD + + IF (X < 0.99_JWRB) THEN + USTOLD = USTAR(IJ, ICHNK) + TAUOLD = MAX(USTOLD**2, TAUWEFF) + + DO ITER=1,NITER + X = MIN(TAUWEFF / TAUOLD, 0.99_JWRB) + USTM1 = 1.0_JWRB / MAX(USTOLD, EPSUS) + !!!! Limit how small z0 could become + !!!! This is a bit of a compromise to limit very low Charnock for intermediate high winds (15 -25 m/s) + !!!! It is not ideal !!! + Z0(IJ, ICHNK) = MAX(XNLEV / (EXP(MIN(XKUTOP / USTOLD, 50.0_JWRB)) - 1.0_JWRB), Z0MIN) + + TAUUNR = STRESS_GC_FC(ANG_GC, USTOLD, Z0(IJ, ICHNK), Z0MIN, HALP(IJ), RNFAC(IJ), BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, & + & CM_GC, DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPSUS, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, RN1_RN, SQRTGOSURFT, XKAPPA, & + & XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, ZALP) + + Z0B(IJ, ICHNK) = MAX(Z0(IJ, ICHNK)*SQRT(TAUUNR / TAUOLD), ALPHAOG*TAUOLD) + Z0VIS = RNUM*USTM1 + HZ0VISO1MX = 0.5_JWRB*Z0VIS / (1.0_JWRB - X) + Z0(IJ, ICHNK) = HZ0VISO1MX + SQRT(HZ0VISO1MX**2 + Z0B(IJ, ICHNK)**2 / (1.0_JWRB - X)) + + XOLOGZ0 = 1.0_JWRB / (XLOGXL - LOG(Z0(IJ, ICHNK))) + F = USTOLD - XKUTOP*XOLOGZ0 + ZZ = 2.0_JWRB*USTM1*(3.0_JWRB*Z0B(IJ, ICHNK)**2 + 0.5_JWRB*Z0VIS*Z0(IJ, ICHNK) - Z0(IJ, ICHNK)**2) / (2.0_JWRB*Z0(IJ, & + & ICHNK)**2*(1.0_JWRB - X) - Z0VIS*Z0(IJ, ICHNK)) + + DELF = 1.0_JWRB - XKUTOP*XOLOGZ0**2*ZZ + IF (DELF /= 0.0_JWRB) USTAR(IJ, ICHNK) = USTOLD - F / DELF + + ! CONVERGENCE ? + DEL = USTAR(IJ, ICHNK) - USTOLD + + IF (ABS(DEL) < PCE_GC*USTAR(IJ, ICHNK)) EXIT + USTOLD = USTAR(IJ, ICHNK) + TAUOLD = MAX(USTOLD**2, TAUWEFF) + END DO + ! protection just in case there is no convergence + IF (ITER > NITER) THEN + ! CDFG = CDM(UTOP(IJ)) + CDFG = MAX(MIN(0.0006_JWRB + 0.00008_JWRB*UTOP(IJ, ICHNK), 0.001_JWRB + 0.0018_JWRB*EXP(-0.05_JWRB*(UTOP(IJ, ICHNK) - & + & 33._JWRB))), 0.001_JWRB) + USTAR(IJ, ICHNK) = UTOP(IJ, ICHNK)*SQRT(CDFG) + Z0MINRST = USTAR(IJ, ICHNK)**2*ALPHA*GM1 + Z0(IJ, ICHNK) = MAX(XNLEV / (EXP(XKUTOP / USTAR(IJ, ICHNK)) - 1.0_JWRB), Z0MINRST) + Z0B(IJ, ICHNK) = Z0MINRST + CHRNCK(IJ, ICHNK) = MAX(G*Z0(IJ, ICHNK) / USTAR(IJ, ICHNK)**2, ALPHAMIN) + ELSE + CHRNCK(IJ, ICHNK) = MAX(G*(Z0B(IJ, ICHNK) / SQRT(1.0_JWRB - X)) / MAX(USTAR(IJ, ICHNK), EPSUS)**2, ALPHAMIN) + END IF + + ELSE + USTM1 = 1.0_JWRB / MAX(USTAR(IJ, ICHNK), EPSUS) + Z0VIS = RNUM*USTM1 + CHRNCK(IJ, ICHNK) = MAX(G*(Z0(IJ, ICHNK) - Z0VIS)*USTM1**2, ALPHAMIN) + END IF + + + + ELSE + + TAUWEFF = TAUWACT*US2TOTAUW + + IF (LLCAPCHNK) THEN + CHARNOCK_MIN = CHNKMIN_FC(UTOP(IJ, ICHNK), ALPHA, ALPHAMIN, CHNKMIN_U) + XMIN = 0.15_JWRB*(ALPHA - CHARNOCK_MIN) + ALPHAOG = CHARNOCK_MIN*GM1 + ELSE + XMIN = 0.0_JWRB + ALPHAOG = ALPHA*GM1 + END IF + + XKUTOP = XKAPPA*UTOP(IJ, ICHNK) + + USTOLD = (1 - IUSFG)*UTOP(IJ, ICHNK)*SQRT(MIN(ACD + BCD*UTOP(IJ, ICHNK), CDMAX)) + IUSFG*USTAR(IJ, ICHNK) + TAUOLD = MAX(USTOLD**2, TAUWEFF) + USTAR(IJ, ICHNK) = SQRT(TAUOLD) + USTM1 = 1.0_JWRB / MAX(USTAR(IJ, ICHNK), EPSUS) + + DO ITER=1,NITER + X = MAX(TAUWACT / TAUOLD, XMIN) + Z0CH = ALPHAOG*TAUOLD / SQRT(1.0_JWRB - X) + Z0VIS = RNUM*USTM1 + Z0TOT = Z0CH + Z0VIS + + XOLOGZ0 = 1.0_JWRB / (XLOGXL - LOG(Z0TOT)) + F = USTAR(IJ, ICHNK) - XKUTOP*XOLOGZ0 + ZZ = USTM1*(Z0CH*(2.0_JWRB - TWOXMP1*X) / (1.0_JWRB - X) - Z0VIS) / Z0TOT + DELF = 1.0_JWRB - XKUTOP*XOLOGZ0**2*ZZ + + IF (DELF /= 0.0_JWRB) USTAR(IJ, ICHNK) = USTAR(IJ, ICHNK) - F / DELF + TAUNEW = MAX(USTAR(IJ, ICHNK)**2, TAUWEFF) + USTAR(IJ, ICHNK) = SQRT(TAUNEW) + IF (TAUNEW == TAUOLD) EXIT + USTM1 = 1.0_JWRB / MAX(USTAR(IJ, ICHNK), EPSUS) + TAUOLD = TAUNEW + END DO + + Z0(IJ, ICHNK) = Z0CH + Z0B(IJ, ICHNK) = ALPHAOG*TAUOLD + CHRNCK(IJ, ICHNK) = MAX(G*Z0(IJ, ICHNK)*USTM1**2, ALPHAMIN) + + + END IF + + + + +END SUBROUTINE TAUT_Z0_FC diff --git a/src/phys-scc-cuda/taut_z0_c.c b/src/phys-scc-cuda/taut_z0_c.c new file mode 100644 index 00000000..bedd2f7d --- /dev/null +++ b/src/phys-scc-cuda/taut_z0_c.c @@ -0,0 +1,313 @@ +#include +#include +#include +#include +#include +#include +#include "taut_z0_c.h" +#include "stress_gc_c.h" +#include "chnkmin_c.h" + +__device__ void taut_z0_c(int kijs, int kijl, int iusfg, const double * halp, + const double * utop, const double * udir, const double * tauw, const double * tauwdir, + const double * rnfac, double * ustar, double * z0, double * z0b, double * chrnck, + double acd, double alpha, double alphamax, double alphamin, double ang_gc_a, + double ang_gc_b, double ang_gc_c, double bcd, double betamaxoxkappa2, double bmaxokap, + const double * c2osqrtvg_gc, double cdmax, double chnkmin_u, const double * cm_gc, + const double * delkcc_gc_ns, const double * delkcc_omxkm3_gc, double eps1, + double epsmin, double epsus, double g, double gm1, int llcapchnk, int llgcbz0, + int llnormagam, int nwav_gc, const double * om3gmkm_gc, const double * omxkm3_gc, + double rn1_rn, double rnu, double rnum, double sqrtgosurft, double xkappa, + const double * xkmsqrtvgoc2_gc, const double * xkm_gc, const double * xk_gc, + double xlogkratiom1_gc, double xnlev, double zalp, int ichnk, int nchnk, int ij) { + + + + + const int niter = 17; + + double twoxmp1 = (double) 3.0; + + int iter; + int ifrph; + double acdlin = (double) 0.0008; + double bcdlin = (double) 0.00047; + double alphagm1; + + double z0min = (double) 0.000001; + double pce_gc; + double z0minrst; + double charnock_min; + double cosdiff; + double zchar; + double us2totauw; + double usmax; + double xlogxl; + double xkutop; + double xologz0; + double ustold; + double ustnew; + double tauold; + double taunew; + double x; + double f; + double delf; + double cdfg; + double ustm1; + double z0tot; + double z0ch; + double z0vis; + double hz0viso1mx; + double zz; + double const_var; + double tauv; + double del; + double rnueff; + double rnukappam1; + double alphaog; + double xmin; + double w1; + double tauwact; + double tauweff; + double ang_gc; + double tauunr; + + int llcosdiff; + + xlogxl = log(xnlev); + us2totauw = (double) 1.0 + eps1; + + cosdiff = cos(udir[ij - 1 + kijl*(ichnk - 1)] - tauwdir[ij - 1 + kijl*(ichnk - 1)]); + tauwact = max((double) (tauw[ij - 1 + kijl*(ichnk - 1)]*cosdiff), (double) (epsmin)); + llcosdiff = cosdiff > (double) 0.9; + if (llgcbz0) { + + if (llcapchnk) { + charnock_min = + chnkmin_c(utop[ij - 1 + kijl*(ichnk - 1)], alpha, alphamin, chnkmin_u); + alphaog = charnock_min*gm1; + } else { + alphaog = (double) 0.0; + } + + usmax = max((double) (-(double) 0.21339 + (double) 0.093698*utop[ij - 1 + kijl*(ichnk + - 1)] - (double) 0.0020944*(pow(utop[ij - 1 + kijl*(ichnk - 1)], 2)) + (double) + 5.5091E-5*(pow(utop[ij - 1 + kijl*(ichnk - 1)], 3))), (double) ((double) 0.03)); + tauweff = min((double) (tauwact*us2totauw), (double) (pow(usmax, 2))); + + rnueff = (double) 0.04*rnu; + + rnukappam1 = rnueff / xkappa; + + pce_gc = (double) 0.001*iusfg + (1 - iusfg)*(double) 0.005; + + if (iusfg == 0) { + alphagm1 = alpha*gm1; + if (utop[ij - 1 + kijl*(ichnk - 1)] < (double) 1.0) { + cdfg = (double) 0.002; + } else if (llcosdiff) { + x = min((double) (tauwact / (pow(max((double) (ustar[ij - 1 + kijl*(ichnk - 1)]), + (double) (epsus)), 2))), (double) ((double) 0.99)); + zchar = min((double) (alphagm1*(pow(ustar[ij - 1 + kijl*(ichnk - 1)], 2)) / + sqrt((double) ((double) 1.0 - x))), (double) ((double) 0.05*exp((double) + (-(double) 0.05*(utop[ij - 1 + kijl*(ichnk - 1)] - (double) 35.))))); + zchar = min((double) (zchar), (double) (alphamax)); + cdfg = acdlin + bcdlin*sqrt((double) (zchar))*utop[ij - 1 + kijl*(ichnk - 1)]; + } else { + // CDFG = CDM(UTOP(IJ)) ! TODO: revert and automate + cdfg = max((double) (min((double) ((double) 0.0006 + (double) 0.00008*utop[ij - 1 + + kijl*(ichnk - 1)]), (double) ((double) 0.001 + (double) 0.0018*exp((double) + (-(double) 0.05*(utop[ij - 1 + kijl*(ichnk - 1)] - (double) 33.)))))), (double) + ((double) 0.001)); + } + ustar[ij - 1 + kijl*(ichnk - 1)] = + utop[ij - 1 + kijl*(ichnk - 1)]*sqrt((double) (cdfg)); + } + + w1 = (double) 0.85 - (double) 0.05*(tanh((double) 10.0*(utop[ij - 1 + kijl*(ichnk - 1 + )] - (double) 5.0)) + (double) 1.0); + + xkutop = xkappa*utop[ij - 1 + kijl*(ichnk - 1)]; + + ustold = ustar[ij - 1 + kijl*(ichnk - 1)]; + tauold = pow(ustold, 2); + + for (iter = 1; iter <= niter; iter += 1) { + // Z0 IS DERIVED FROM THE NEUTRAL LOG PROFILE: UTOP = (USTAR/XKAPPA)*LOG((XNLEV+Z0)/Z0) + z0[ij - 1 + kijl*(ichnk - 1)] = max((double) (xnlev / (exp((double) (min((double) + (xkutop / ustold), (double) ((double) 50.0)))) - (double) 1.0)), (double) (z0min) + ); + // Viscous kinematic stress nu_air * dU/dz at z=0 of the neutral log profile reduced by factor 25 (0.04) + tauv = rnukappam1*ustold / z0[ij - 1 + kijl*(ichnk - 1)]; + + ang_gc = ang_gc_a + ang_gc_b*tanh(ang_gc_c*tauold); + + tauunr = stress_gc_c(ang_gc, ustar[ij - 1 + kijl*(ichnk - 1)], z0[ij - 1 + + kijl*(ichnk - 1)], z0min, halp[ij - 1], rnfac[ij - 1], betamaxoxkappa2, bmaxokap, + c2osqrtvg_gc, cm_gc, delkcc_gc_ns, delkcc_omxkm3_gc, epsus, + llnormagam, nwav_gc, om3gmkm_gc, omxkm3_gc, rn1_rn, sqrtgosurft, xkappa, + xkmsqrtvgoc2_gc, xkm_gc, xk_gc, xlogkratiom1_gc, zalp); + taunew = tauweff + tauv + tauunr; + ustnew = sqrt((double) (taunew)); + ustar[ij - 1 + kijl*(ichnk - 1)] = w1*ustold + ((double) 1.0 - w1)*ustnew; + del = ustar[ij - 1 + kijl*(ichnk - 1)] - ustold; + if (abs((double) (del)) < pce_gc*ustar[ij - 1 + kijl*(ichnk - 1)]) { + // EXIT + } + tauold = pow(ustar[ij - 1 + kijl*(ichnk - 1)], 2); + ustold = ustar[ij - 1 + kijl*(ichnk - 1)]; + } + // protection just in case there is no convergence + if (iter > niter) { + // CDFG = CDM(UTOP(IJ)) + cdfg = max((double) (min((double) ((double) 0.0006 + (double) 0.00008*utop[ij - 1 + + kijl*(ichnk - 1)]), (double) ((double) 0.001 + (double) 0.0018*exp((double) + (-(double) 0.05*(utop[ij - 1 + kijl*(ichnk - 1)] - (double) 33.)))))), (double) + ((double) 0.001)); + ustar[ij - 1 + kijl*(ichnk - 1)] = + utop[ij - 1 + kijl*(ichnk - 1)]*sqrt((double) (cdfg)); + z0minrst = (pow(ustar[ij - 1 + kijl*(ichnk - 1)], 2))*alpha*gm1; + z0[ij - 1 + kijl*(ichnk - 1)] = max((double) (xnlev / (exp((double) (xkutop / + ustar[ij - 1 + kijl*(ichnk - 1)])) - (double) 1.0)), (double) (z0minrst)); + z0b[ij - 1 + kijl*(ichnk - 1)] = z0minrst; + } else { + z0[ij - 1 + kijl*(ichnk - 1)] = max((double) (xnlev / (exp((double) (xkutop / + ustar[ij - 1 + kijl*(ichnk - 1)])) - (double) 1.0)), (double) (z0min)); + z0b[ij - 1 + kijl*(ichnk - 1)] = + z0[ij - 1 + kijl*(ichnk - 1)]*sqrt((double) (tauunr / tauold)); + } + x = tauweff / tauold; + + if (x < (double) 0.99) { + ustold = ustar[ij - 1 + kijl*(ichnk - 1)]; + tauold = max((double) (pow(ustold, 2)), (double) (tauweff)); + + for (iter = 1; iter <= niter; iter += 1) { + x = min((double) (tauweff / tauold), (double) ((double) 0.99)); + ustm1 = (double) 1.0 / max((double) (ustold), (double) (epsus)); + z0[ij - 1 + kijl*(ichnk - 1)] = max((double) (xnlev / (exp((double) (min((double) + (xkutop / ustold), (double) ((double) 50.0)))) - (double) 1.0)), (double) + (z0min)); + + tauunr = stress_gc_c(ang_gc, ustold, z0[ij - 1 + kijl*(ichnk - 1)], z0min, + halp[ij - 1], rnfac[ij - 1], betamaxoxkappa2, bmaxokap, c2osqrtvg_gc, + cm_gc, delkcc_gc_ns, delkcc_omxkm3_gc, epsus, llnormagam, nwav_gc, + om3gmkm_gc, omxkm3_gc, rn1_rn, sqrtgosurft, xkappa, xkmsqrtvgoc2_gc, + xkm_gc, xk_gc, xlogkratiom1_gc, zalp); + + z0b[ij - 1 + kijl*(ichnk - 1)] = max((double) (z0[ij - 1 + kijl*(ichnk - 1) + ]*sqrt((double) (tauunr / tauold))), (double) (alphaog*tauold)); + z0vis = rnum*ustm1; + hz0viso1mx = (double) 0.5*z0vis / ((double) 1.0 - x); + z0[ij - 1 + kijl*(ichnk - 1)] = hz0viso1mx + sqrt((double) ((pow(hz0viso1mx, 2)) + + (pow(z0b[ij - 1 + kijl*(ichnk - 1)], 2)) / ((double) 1.0 - x))); + + xologz0 = (double) 1.0 / (xlogxl - log(z0[ij - 1 + kijl*(ichnk - 1)])); + f = ustold - xkutop*xologz0; + zz = (double) 2.0*ustm1*((double) 3.0*(pow(z0b[ij - 1 + kijl*(ichnk - 1)], 2)) + + (double) 0.5*z0vis*z0[ij - 1 + kijl*(ichnk - 1)] - (pow(z0[ij - 1 + kijl*(ichnk + - 1)], 2))) / ((double) 2.0*(pow(z0[ij - 1 + kijl*(ichnk - 1)], 2))*((double) + 1.0 - x) - z0vis*z0[ij - 1 + kijl*(ichnk - 1)]); + + delf = (double) 1.0 - xkutop*(pow(xologz0, 2))*zz; + if (delf != (double) 0.0) { + ustar[ij - 1 + kijl*(ichnk - 1)] = ustold - f / delf; + } + del = ustar[ij - 1 + kijl*(ichnk - 1)] - ustold; + + if (abs((double) (del)) < pce_gc*ustar[ij - 1 + kijl*(ichnk - 1)]) { + // EXIT + } + ustold = ustar[ij - 1 + kijl*(ichnk - 1)]; + tauold = max((double) (pow(ustold, 2)), (double) (tauweff)); + } + // protection just in case there is no convergence + if (iter > niter) { + // CDFG = CDM(UTOP(IJ)) + cdfg = max((double) (min((double) ((double) 0.0006 + (double) 0.00008*utop[ij - 1 + + kijl*(ichnk - 1)]), (double) ((double) 0.001 + (double) 0.0018*exp((double) + (-(double) 0.05*(utop[ij - 1 + kijl*(ichnk - 1)] - (double) 33.)))))), (double) + ((double) 0.001)); + ustar[ij - 1 + kijl*(ichnk - 1)] = + utop[ij - 1 + kijl*(ichnk - 1)]*sqrt((double) (cdfg)); + z0minrst = (pow(ustar[ij - 1 + kijl*(ichnk - 1)], 2))*alpha*gm1; + z0[ij - 1 + kijl*(ichnk - 1)] = max((double) (xnlev / (exp((double) (xkutop / + ustar[ij - 1 + kijl*(ichnk - 1)])) - (double) 1.0)), (double) (z0minrst)); + z0b[ij - 1 + kijl*(ichnk - 1)] = z0minrst; + chrnck[ij - 1 + kijl*(ichnk - 1)] = max((double) (g*z0[ij - 1 + kijl*(ichnk - 1)] + / (pow(ustar[ij - 1 + kijl*(ichnk - 1)], 2))), (double) (alphamin)); + } else { + chrnck[ij - 1 + kijl*(ichnk - 1)] = max((double) (g*(z0b[ij - 1 + kijl*(ichnk - 1 + )] / sqrt((double) ((double) 1.0 - x))) / (pow(max((double) (ustar[ij - 1 + + kijl*(ichnk - 1)]), (double) (epsus)), 2))), (double) (alphamin)); + } + + } else { + ustm1 = + (double) 1.0 / max((double) (ustar[ij - 1 + kijl*(ichnk - 1)]), (double) (epsus)) + ; + z0vis = rnum*ustm1; + chrnck[ij - 1 + kijl*(ichnk - 1)] = max((double) (g*(z0[ij - 1 + kijl*(ichnk - 1)] + - z0vis)*(pow(ustm1, 2))), (double) (alphamin)); + } + + } else { + + tauweff = tauwact*us2totauw; + + if (llcapchnk) { + charnock_min = + chnkmin_c(utop[ij - 1 + kijl*(ichnk - 1)], alpha, alphamin, chnkmin_u); + xmin = (double) 0.15*(alpha - charnock_min); + alphaog = charnock_min*gm1; + } else { + xmin = (double) 0.0; + alphaog = alpha*gm1; + } + + xkutop = xkappa*utop[ij - 1 + kijl*(ichnk - 1)]; + + ustold = (1 - iusfg)*utop[ij - 1 + kijl*(ichnk - 1)]*sqrt((double) (min((double) (acd + + bcd*utop[ij - 1 + kijl*(ichnk - 1)]), (double) (cdmax)))) + iusfg*ustar[ij - 1 + + kijl*(ichnk - 1)]; + tauold = max((double) (pow(ustold, 2)), (double) (tauweff)); + ustar[ij - 1 + kijl*(ichnk - 1)] = sqrt((double) (tauold)); + ustm1 = + (double) 1.0 / max((double) (ustar[ij - 1 + kijl*(ichnk - 1)]), (double) (epsus)); + + for (iter = 1; iter <= niter; iter += 1) { + x = max((double) (tauwact / tauold), (double) (xmin)); + z0ch = alphaog*tauold / sqrt((double) ((double) 1.0 - x)); + z0vis = rnum*ustm1; + z0tot = z0ch + z0vis; + + xologz0 = (double) 1.0 / (xlogxl - log(z0tot)); + f = ustar[ij - 1 + kijl*(ichnk - 1)] - xkutop*xologz0; + zz = ustm1*(z0ch*((double) 2.0 - twoxmp1*x) / ((double) 1.0 - x) - z0vis) / z0tot; + delf = (double) 1.0 - xkutop*(pow(xologz0, 2))*zz; + + if (delf != (double) 0.0) { + ustar[ij - 1 + kijl*(ichnk - 1)] = ustar[ij - 1 + kijl*(ichnk - 1)] - f / delf; + } + taunew = + max((double) (pow(ustar[ij - 1 + kijl*(ichnk - 1)], 2)), (double) (tauweff)); + ustar[ij - 1 + kijl*(ichnk - 1)] = sqrt((double) (taunew)); + if (taunew == tauold) { + // EXIT + } + ustm1 = + (double) 1.0 / max((double) (ustar[ij - 1 + kijl*(ichnk - 1)]), (double) (epsus)) + ; + tauold = taunew; + } + + z0[ij - 1 + kijl*(ichnk - 1)] = z0ch; + z0b[ij - 1 + kijl*(ichnk - 1)] = alphaog*tauold; + chrnck[ij - 1 + kijl*(ichnk - 1)] = max((double) (g*z0[ij - 1 + kijl*(ichnk - 1) + ]*(pow(ustm1, 2))), (double) (alphamin)); + + + } + + +} diff --git a/src/phys-scc-cuda/taut_z0_c.h b/src/phys-scc-cuda/taut_z0_c.h new file mode 100644 index 00000000..9fb304c7 --- /dev/null +++ b/src/phys-scc-cuda/taut_z0_c.h @@ -0,0 +1,21 @@ +#include +#include +#include +#include +#include +#include +#include "stress_gc_c.h" +#include "chnkmin_c.h" + +__device__ void taut_z0_c(int kijs, int kijl, int iusfg, const double * halp, + const double * utop, const double * udir, const double * tauw, const double * tauwdir, + const double * rnfac, double * ustar, double * z0, double * z0b, double * chrnck, + double acd, double alpha, double alphamax, double alphamin, double ang_gc_a, + double ang_gc_b, double ang_gc_c, double bcd, double betamaxoxkappa2, double bmaxokap, + const double * c2osqrtvg_gc, double cdmax, double chnkmin_u, const double * cm_gc, + const double * delkcc_gc_ns, const double * delkcc_omxkm3_gc, double eps1, + double epsmin, double epsus, double g, double gm1, int llcapchnk, int llgcbz0, + int llnormagam, int nwav_gc, const double * om3gmkm_gc, const double * omxkm3_gc, + double rn1_rn, double rnu, double rnum, double sqrtgosurft, double xkappa, + const double * xkmsqrtvgoc2_gc, const double * xkm_gc, const double * xk_gc, + double xlogkratiom1_gc, double xnlev, double zalp, int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/taut_z0_fc.F90 b/src/phys-scc-cuda/taut_z0_fc.F90 new file mode 100644 index 00000000..5b67ff2e --- /dev/null +++ b/src/phys-scc-cuda/taut_z0_fc.F90 @@ -0,0 +1,172 @@ +MODULE TAUT_Z0_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE TAUT_Z0_fc (KIJS, KIJL, IUSFG, HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK, ACD, ALPHA, & + & ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CM_GC, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, & + & RN1_RN, RNU, RNUM, SQRTGOSURFT, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION CHNKMIN (U10) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: CHNKMIN + REAL(KIND=JWRB), INTENT(IN) :: U10 + END FUNCTION CHNKMIN + END INTERFACE + INTERFACE + FUNCTION STRESS_GC (ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: STRESS_GC + REAL(KIND=JWRB), INTENT(IN) :: ANG_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + REAL(KIND=JWRB), INTENT(IN) :: Z0 + REAL(KIND=JWRB), INTENT(IN) :: Z0MIN + REAL(KIND=JWRB), INTENT(IN) :: HALP + REAL(KIND=JWRB), INTENT(IN) :: RNFAC + END FUNCTION STRESS_GC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IUSFG + + + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + ! Cd and Z0 from Hersbach 2010, ECMWF Tech Memo (without the viscous part) + ! CD = ACDLIN + BCDLIN*SQRT(PCHAR) * U10 + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE TAUT_Z0_iso_c (KIJS, KIJL, IUSFG, HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK, ACD, ALPHA, & + & ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CM_GC, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, & + & OMXKM3_GC, RN1_RN, RNU, RNUM, SQRTGOSURFT, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, & + & NCHNK, IJ) BIND(c, name="taut_z0_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + INTEGER(KIND=c_int), VALUE :: IUSFG + TYPE(c_ptr), VALUE :: HALP + TYPE(c_ptr), VALUE :: UTOP + TYPE(c_ptr), VALUE :: UDIR + TYPE(c_ptr), VALUE :: TAUW + TYPE(c_ptr), VALUE :: TAUWDIR + TYPE(c_ptr), VALUE :: RNFAC + TYPE(c_ptr), VALUE :: USTAR + TYPE(c_ptr), VALUE :: Z0 + TYPE(c_ptr), VALUE :: Z0B + TYPE(c_ptr), VALUE :: CHRNCK + REAL, VALUE :: ACD + REAL, VALUE :: ALPHA + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: ANG_GC_A + REAL, VALUE :: ANG_GC_B + REAL, VALUE :: ANG_GC_C + REAL, VALUE :: BCD + REAL, VALUE :: BETAMAXOXKAPPA2 + REAL, VALUE :: BMAXOKAP + TYPE(c_ptr), VALUE :: C2OSQRTVG_GC + REAL, VALUE :: CDMAX + REAL, VALUE :: CHNKMIN_U + TYPE(c_ptr), VALUE :: CM_GC + TYPE(c_ptr), VALUE :: DELKCC_GC_NS + TYPE(c_ptr), VALUE :: DELKCC_OMXKM3_GC + REAL, VALUE :: EPS1 + REAL, VALUE :: EPSMIN + REAL, VALUE :: EPSUS + REAL, VALUE :: G + REAL, VALUE :: GM1 + LOGICAL, VALUE :: LLCAPCHNK + LOGICAL, VALUE :: LLGCBZ0 + LOGICAL, VALUE :: LLNORMAGAM + INTEGER(KIND=c_int), VALUE :: NWAV_GC + TYPE(c_ptr), VALUE :: OM3GMKM_GC + TYPE(c_ptr), VALUE :: OMXKM3_GC + REAL, VALUE :: RN1_RN + REAL, VALUE :: RNU + REAL, VALUE :: RNUM + REAL, VALUE :: SQRTGOSURFT + REAL, VALUE :: XKAPPA + TYPE(c_ptr), VALUE :: XKMSQRTVGOC2_GC + TYPE(c_ptr), VALUE :: XKM_GC + TYPE(c_ptr), VALUE :: XK_GC + REAL, VALUE :: XLOGKRATIOM1_GC + REAL, VALUE :: XNLEV + REAL, VALUE :: ZALP + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE TAUT_Z0_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UTOP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) +!$acc host_data use_device( HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK, C2OSQRTVG_GC, CM_GC, DELKCC_GC_NS, & +!$acc & DELKCC_OMXKM3_GC, OM3GMKM_GC, OMXKM3_GC, XKMSQRTVGOC2_GC, XKM_GC, XK_GC ) + CALL TAUT_Z0_iso_c(KIJS, KIJL, IUSFG, c_loc(HALP), c_loc(UTOP), c_loc(UDIR), c_loc(TAUW), c_loc(TAUWDIR), c_loc(RNFAC), & + & c_loc(USTAR), c_loc(Z0), c_loc(Z0B), c_loc(CHRNCK), ACD, ALPHA, ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, & + & BETAMAXOXKAPPA2, BMAXOKAP, c_loc(C2OSQRTVG_GC), CDMAX, CHNKMIN_U, c_loc(CM_GC), c_loc(DELKCC_GC_NS), & + & c_loc(DELKCC_OMXKM3_GC), EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, c_loc(OM3GMKM_GC), & + & c_loc(OMXKM3_GC), RN1_RN, RNU, RNUM, SQRTGOSURFT, XKAPPA, c_loc(XKMSQRTVGOC2_GC), c_loc(XKM_GC), c_loc(XK_GC), & + & XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE TAUT_Z0_fc +END MODULE TAUT_Z0_FC_MOD diff --git a/src/phys-scc-cuda/taut_z0_fc.intfb.h b/src/phys-scc-cuda/taut_z0_fc.intfb.h new file mode 100644 index 00000000..584eef7a --- /dev/null +++ b/src/phys-scc-cuda/taut_z0_fc.intfb.h @@ -0,0 +1,97 @@ +INTERFACE + SUBROUTINE TAUT_Z0_FC (KIJS, KIJL, IUSFG, HALP, UTOP, UDIR, TAUW, TAUWDIR, RNFAC, USTAR, Z0, Z0B, CHRNCK, ACD, ALPHA, & + & ALPHAMAX, ALPHAMIN, ANG_GC_A, ANG_GC_B, ANG_GC_C, BCD, BETAMAXOXKAPPA2, BMAXOKAP, C2OSQRTVG_GC, CDMAX, CHNKMIN_U, CM_GC, & + & DELKCC_GC_NS, DELKCC_OMXKM3_GC, EPS1, EPSMIN, EPSUS, G, GM1, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, NWAV_GC, OM3GMKM_GC, OMXKM3_GC, & + & RN1_RN, RNU, RNUM, SQRTGOSURFT, XKAPPA, XKMSQRTVGOC2_GC, XKM_GC, XK_GC, XLOGKRATIOM1_GC, XNLEV, ZALP, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + USE YOWPARAM, ONLY: NFRE, NANG + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION CHNKMIN_FC (U10) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: CHNKMIN + REAL(KIND=JWRB), INTENT(IN) :: U10 + END FUNCTION CHNKMIN_FC + END INTERFACE + INTERFACE + FUNCTION STRESS_GC_FC (ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: STRESS_GC + REAL(KIND=JWRB), INTENT(IN) :: ANG_GC + REAL(KIND=JWRB), INTENT(IN) :: USTAR + REAL(KIND=JWRB), INTENT(IN) :: Z0 + REAL(KIND=JWRB), INTENT(IN) :: Z0MIN + REAL(KIND=JWRB), INTENT(IN) :: HALP + REAL(KIND=JWRB), INTENT(IN) :: RNFAC + END FUNCTION STRESS_GC_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IUSFG + REAL(KIND=JWRB), TARGET, INTENT(IN) :: HALP(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RNFAC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UTOP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUWDIR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: USTAR(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + + + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + ! Cd and Z0 from Hersbach 2010, ECMWF Tech Memo (without the viscous part) + ! CD = ACDLIN + BCDLIN*SQRT(PCHAR) * U10 + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ACD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_A + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_B + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ANG_GC_C + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BCD + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BETAMAXOXKAPPA2 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BMAXOKAP + REAL(KIND=JWRB), TARGET, INTENT(IN) :: C2OSQRTVG_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CDMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_GC_NS(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: DELKCC_OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + LOGICAL, VALUE, INTENT(IN) :: LLGCBZ0 + LOGICAL, VALUE, INTENT(IN) :: LLNORMAGAM + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NWAV_GC + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OM3GMKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: OMXKM3_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RN1_RN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNU + REAL(KIND=JWRB), VALUE, INTENT(IN) :: RNUM + REAL(KIND=JWRB), VALUE, INTENT(IN) :: SQRTGOSURFT + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XKAPPA + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKMSQRTVGOC2_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XKM_GC(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: XK_GC(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XLOGKRATIOM1_GC + REAL(KIND=JWRB), VALUE, INTENT(IN) :: XNLEV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ZALP + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE TAUT_Z0_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/transf.c_hoist.F90 b/src/phys-scc-cuda/transf.c_hoist.F90 new file mode 100644 index 00000000..d5f4d8ba --- /dev/null +++ b/src/phys-scc-cuda/transf.c_hoist.F90 @@ -0,0 +1,71 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) FUNCTION TRANSF_FC (XK, D, DKMAX, G) + ! + !*** DETERMINE NARROW BAND LIMIT NONLINEAR TRANSFER FUNCTION + ! BASED ON TECH MEMO 464 BY P. JANSSEN AND M. ONORATO + ! + ! + ! AUTHOR: P.A.E.M. JANSSEN ECMWF JUNE 2005 + ! ------ + ! + ! VARIABLE TYPE PURPOSE + ! -------- ---- ------- + ! + ! XK REAL WAVE NUMBER + ! D REAL DEPTH + ! + !---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB) :: TRANSF_FC + REAL(KIND=JWRB), INTENT(IN) :: XK, D + REAL(KIND=JWRB) :: EPS, X, T_0, OM, C_0, V_G, DV_G, XNL_1, XNL_2, XNL + REAL(KIND=JWRB), INTENT(IN) :: DKMAX + REAL(KIND=JWRB), INTENT(IN) :: G +!$acc routine seq + + EPS = 0.0001_JWRB + ! + !* 1. DETERMINE TRANSFER FUNCTION. + ! ------------------------------ + ! + IF (D < 999.0_JWRB .and. D > 0.0_JWRB) THEN + X = XK*D + IF (X > DKMAX) THEN + TRANSF_FC = 1.0_JWRB + ELSE + T_0 = TANH(X) + OM = SQRT(G*XK*T_0) + C_0 = OM / XK + IF (X < EPS) THEN + V_G = 0.5_JWRB*C_0 + V_G = C_0 + ELSE + V_G = 0.5_JWRB*C_0*(1.0_JWRB + 2.0_JWRB*X / SINH(2.0_JWRB*X)) + END IF + DV_G = (T_0 - X*(1.0_JWRB - T_0**2))**2 + 4.0_JWRB*X**2*T_0**2*(1.0_JWRB - T_0**2) + + XNL_1 = (9.0_JWRB*T_0**4 - 10.0_JWRB*T_0**2 + 9.0_JWRB) / (8.0_JWRB*T_0**3) + XNL_2 = ((2.0_JWRB*V_G - 0.5_JWRB*C_0)**2 / (G*D - V_G**2) + 1.0_JWRB) / X + + XNL = XNL_1 - XNL_2 + TRANSF_FC = XNL**2 / (DV_G*T_0**8) + END IF + ELSE + TRANSF_FC = 1.0_JWRB + END IF + ! +END FUNCTION TRANSF_FC diff --git a/src/phys-scc-cuda/transf_c.c b/src/phys-scc-cuda/transf_c.c new file mode 100644 index 00000000..0362c40a --- /dev/null +++ b/src/phys-scc-cuda/transf_c.c @@ -0,0 +1,47 @@ +#include +#include +#include +#include +#include +#include +#include "transf_c.h" + +__device__ double transf_c(double xk, double d, double dkmax, double g) { + + + double transf; + double eps, x, t_0, om, c_0, v_g, dv_g, xnl_1, xnl_2, xnl; + // + + eps = (double) 0.0001; + if (d < (double) 999.0 && d > (double) 0.0) { + x = xk*d; + if (x > dkmax) { + transf = (double) 1.0; + } else { + t_0 = tanh(x); + om = sqrt((double) (g*xk*t_0)); + c_0 = om / xk; + if (x < eps) { + v_g = (double) 0.5*c_0; + v_g = c_0; + } else { + v_g = (double) 0.5*c_0*((double) 1.0 + (double) 2.0*x / sinh((double) 2.0*x)); + } + dv_g = (pow((t_0 - x*((double) 1.0 - (pow(t_0, 2)))), 2)) + (double) 4.0*(pow(x, 2) + )*(pow(t_0, 2))*((double) 1.0 - (pow(t_0, 2))); + + xnl_1 = ((double) 9.0*(pow(t_0, 4)) - (double) 10.0*(pow(t_0, 2)) + (double) 9.0) / + ((double) 8.0*(pow(t_0, 3))); + xnl_2 = ((pow(((double) 2.0*v_g - (double) 0.5*c_0), 2)) / (g*d - (pow(v_g, 2))) + + (double) 1.0) / x; + + xnl = xnl_1 - xnl_2; + transf = (pow(xnl, 2)) / (dv_g*(pow(t_0, 8))); + } + } else { + transf = (double) 1.0; + } + return transf; + // +} diff --git a/src/phys-scc-cuda/transf_c.h b/src/phys-scc-cuda/transf_c.h new file mode 100644 index 00000000..593af419 --- /dev/null +++ b/src/phys-scc-cuda/transf_c.h @@ -0,0 +1,9 @@ +#include +#include +#include +#include +#include +#include + + +__device__ double transf_c(double xk, double d, double dkmax, double g); diff --git a/src/phys-scc-cuda/transf_fc.F90 b/src/phys-scc-cuda/transf_fc.F90 new file mode 100644 index 00000000..0761ce47 --- /dev/null +++ b/src/phys-scc-cuda/transf_fc.F90 @@ -0,0 +1,29 @@ +MODULE TRANSF_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE TRANSF_fc (XK, D, DKMAX, G) + USE PARKIND_WAVE, ONLY: JWRB + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: XK, D + REAL(KIND=JWRB), INTENT(IN) :: DKMAX + REAL(KIND=JWRB), INTENT(IN) :: G +!$acc routine seq + INTERFACE + SUBROUTINE TRANSF_iso_c (XK, D, DKMAX, G) BIND(c, name="transf_c_launch") + implicit none + REAL, VALUE :: XK + REAL, VALUE :: D + REAL, VALUE :: DKMAX + REAL, VALUE :: G + END SUBROUTINE TRANSF_iso_c + END INTERFACE +!$acc host_data use_device + CALL TRANSF_iso_c(XK, D, DKMAX, G) +!$acc end host_data + END SUBROUTINE TRANSF_fc +END MODULE TRANSF_FC_MOD diff --git a/src/phys-scc-cuda/transf_fc.intfb.h b/src/phys-scc-cuda/transf_fc.intfb.h new file mode 100644 index 00000000..a884107a --- /dev/null +++ b/src/phys-scc-cuda/transf_fc.intfb.h @@ -0,0 +1,15 @@ +INTERFACE + SUBROUTINE TRANSF_FC (XK, D, DKMAX, G) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: XK, D + REAL(KIND=JWRB), INTENT(IN) :: DKMAX + REAL(KIND=JWRB), INTENT(IN) :: G +!$acc routine seq + END SUBROUTINE TRANSF_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/transf_snl.c_hoist.F90 b/src/phys-scc-cuda/transf_snl.c_hoist.F90 new file mode 100644 index 00000000..ab6379fc --- /dev/null +++ b/src/phys-scc-cuda/transf_snl.c_hoist.F90 @@ -0,0 +1,90 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) FUNCTION TRANSF_SNL_FC (XK0, D, XNU, SIG_TH, BATHYMAX, DKMAX, G, XKDMIN) + + !*** DETERMINE NARROW BAND LIMIT NONLINEAR TRANSFER FUNCTION + + ! VARIABLE TYPE PURPOSE + ! -------- ---- ------- + + ! XK0 REAL WAVE NUMBER + ! D REAL DEPTH + ! XNU REAL RELATIVE SPECTRAL WIDTH + ! SIG_TH REAL RELATIVE WIDTH in DIRECTION + + !---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB) :: TRANSF_SNL_FC + REAL(KIND=JWRB), INTENT(IN) :: XK0, D, XNU, SIG_TH + + REAL(KIND=JWRB), PARAMETER :: EPS = 0.0001_JWRB + REAL(KIND=JWRB), PARAMETER :: TRANSF_SNL_MIN = 0.1_JWRB + REAL(KIND=JWRB), PARAMETER :: TRANSF_SNL_MAX = 10._JWRB + + REAL(KIND=JWRB) :: X, XK, T_0, T_0_SQ, OM, C_0, V_G, V_G_SQ, DV_G + REAL(KIND=JWRB) :: XNL_1, XNL_2, XNL_3, XNL_4, XNL + REAL(KIND=JWRB) :: C_S_SQ, ALP, ZFAC + REAL(KIND=JWRB), INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), INTENT(IN) :: DKMAX + REAL(KIND=JWRB), INTENT(IN) :: G + REAL(KIND=JWRB), INTENT(IN) :: XKDMIN +!$acc routine seq + + !---------------------------------------------------------------------- + + + !* 1. DETERMINE TRANSFER FUNCTION. + ! ------------------------------ + + IF (D < BATHYMAX .and. D > 0._JWRB) THEN + X = XK0*D + IF (X > DKMAX) THEN + TRANSF_SNL_FC = 1._JWRB + ELSE + XK = MAX(XK0, XKDMIN / D) + X = XK*D + T_0 = TANH(X) + T_0_SQ = T_0**2 + OM = SQRT(G*XK*T_0) + C_0 = OM / XK + C_S_SQ = G*D + IF (X < EPS) THEN + V_G = C_0 + ELSE + V_G = 0.5_JWRB*C_0*(1._JWRB + 2._JWRB*X / SINH(2._JWRB*X)) + END IF + V_G_SQ = V_G**2 + DV_G = (T_0 - X*(1. - T_0_SQ))**2 + 4._JWRB*X**2*T_0_SQ*(1._JWRB - T_0_SQ) + + XNL_1 = (9._JWRB*T_0_SQ**2 - 10._JWRB*T_0_SQ + 9._JWRB) / (8._JWRB*T_0_SQ*T_0) + XNL_2 = ((2._JWRB*V_G - 0.5_JWRB*C_0)**2 / (G*D - V_G_SQ) + 1._JWRB) / X + XNL_4 = 1. / (4._JWRB*T_0)*(2._JWRB*C_0 + V_G*(1._JWRB - T_0_SQ))**2 / (C_S_SQ - V_G_SQ) + ALP = (1. - V_G_SQ / C_S_SQ)*C_0**2 / V_G_SQ + ZFAC = SIG_TH**2 / (SIG_TH**2 + ALP*XNU**2) + XNL_3 = ZFAC*XNL_4 + + XNL = XNL_1 - XNL_2 + XNL_3 + TRANSF_SNL_FC = XNL**2 / (DV_G*T_0_SQ**4) + TRANSF_SNL_FC = MAX(MIN(TRANSF_SNL_MAX, TRANSF_SNL_FC), TRANSF_SNL_MIN) + END IF + ELSE + TRANSF_SNL_FC = 1._JWRB + END IF + + + +END FUNCTION TRANSF_SNL_FC diff --git a/src/phys-scc-cuda/transf_snl_c.c b/src/phys-scc-cuda/transf_snl_c.c new file mode 100644 index 00000000..8c098258 --- /dev/null +++ b/src/phys-scc-cuda/transf_snl_c.c @@ -0,0 +1,64 @@ +#include +#include +#include +#include +#include +#include +#include "transf_snl_c.h" + +__device__ double transf_snl_c(double xk0, double d, double xnu, double sig_th, + double bathymax, double dkmax, double g, double xkdmin) { + + + + double transf_snl; + + double eps = (double) 0.0001; + double transf_snl_min = (double) 0.1; + double transf_snl_max = (double) 10.; + + double x, xk, t_0, t_0_sq, om, c_0, v_g, v_g_sq, dv_g; + double xnl_1, xnl_2, xnl_3, xnl_4, xnl; + double c_s_sq, alp, zfac; + // + if (d < bathymax && d > (double) 0.) { + x = xk0*d; + if (x > dkmax) { + transf_snl = (double) 1.; + } else { + xk = max((double) (xk0), (double) (xkdmin / d)); + x = xk*d; + t_0 = tanh(x); + t_0_sq = pow(t_0, 2); + om = sqrt((double) (g*xk*t_0)); + c_0 = om / xk; + c_s_sq = g*d; + if (x < eps) { + v_g = c_0; + } else { + v_g = (double) 0.5*c_0*((double) 1. + (double) 2.*x / sinh((double) 2.*x)); + } + v_g_sq = pow(v_g, 2); + dv_g = (pow((t_0 - x*(1. - t_0_sq)), 2)) + (double) 4.*(pow(x, 2))*t_0_sq*((double) + 1. - t_0_sq); + + xnl_1 = ((double) 9.*(pow(t_0_sq, 2)) - (double) 10.*t_0_sq + (double) 9.) / + ((double) 8.*t_0_sq*t_0); + xnl_2 = ((pow(((double) 2.*v_g - (double) 0.5*c_0), 2)) / (g*d - v_g_sq) + (double) + 1.) / x; + xnl_4 = 1. / ((double) 4.*t_0)*(pow(((double) 2.*c_0 + v_g*((double) 1. - t_0_sq)), + 2)) / (c_s_sq - v_g_sq); + alp = (1. - v_g_sq / c_s_sq)*(pow(c_0, 2)) / v_g_sq; + zfac = (pow(sig_th, 2)) / ((pow(sig_th, 2)) + alp*(pow(xnu, 2))); + xnl_3 = zfac*xnl_4; + + xnl = xnl_1 - xnl_2 + xnl_3; + transf_snl = (pow(xnl, 2)) / (dv_g*(pow(t_0_sq, 4))); + transf_snl = max((double) (min((double) (transf_snl_max), (double) (transf_snl))), + (double) (transf_snl_min)); + } + } else { + transf_snl = (double) 1.; + } + return transf_snl; +} diff --git a/src/phys-scc-cuda/transf_snl_c.h b/src/phys-scc-cuda/transf_snl_c.h new file mode 100644 index 00000000..f6adf790 --- /dev/null +++ b/src/phys-scc-cuda/transf_snl_c.h @@ -0,0 +1,10 @@ +#include +#include +#include +#include +#include +#include + + +__device__ double transf_snl_c(double xk0, double d, double xnu, double sig_th, + double bathymax, double dkmax, double g, double xkdmin); diff --git a/src/phys-scc-cuda/transf_snl_fc.F90 b/src/phys-scc-cuda/transf_snl_fc.F90 new file mode 100644 index 00000000..ea1adf45 --- /dev/null +++ b/src/phys-scc-cuda/transf_snl_fc.F90 @@ -0,0 +1,38 @@ +MODULE TRANSF_SNL_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE TRANSF_SNL_fc (XK0, D, XNU, SIG_TH, BATHYMAX, DKMAX, G, XKDMIN) + USE PARKIND_WAVE, ONLY: JWRB + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: XK0, D, XNU, SIG_TH + + + REAL(KIND=JWRB), INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), INTENT(IN) :: DKMAX + REAL(KIND=JWRB), INTENT(IN) :: G + REAL(KIND=JWRB), INTENT(IN) :: XKDMIN +!$acc routine seq + INTERFACE + SUBROUTINE TRANSF_SNL_iso_c (XK0, D, XNU, SIG_TH, BATHYMAX, DKMAX, G, XKDMIN) BIND(c, name="transf_snl_c_launch") + implicit none + REAL, VALUE :: XK0 + REAL, VALUE :: D + REAL, VALUE :: XNU + REAL, VALUE :: SIG_TH + REAL, VALUE :: BATHYMAX + REAL, VALUE :: DKMAX + REAL, VALUE :: G + REAL, VALUE :: XKDMIN + END SUBROUTINE TRANSF_SNL_iso_c + END INTERFACE +!$acc host_data use_device + CALL TRANSF_SNL_iso_c(XK0, D, XNU, SIG_TH, BATHYMAX, DKMAX, G, XKDMIN) +!$acc end host_data + END SUBROUTINE TRANSF_SNL_fc +END MODULE TRANSF_SNL_FC_MOD diff --git a/src/phys-scc-cuda/transf_snl_fc.intfb.h b/src/phys-scc-cuda/transf_snl_fc.intfb.h new file mode 100644 index 00000000..58ae79a4 --- /dev/null +++ b/src/phys-scc-cuda/transf_snl_fc.intfb.h @@ -0,0 +1,20 @@ +INTERFACE + SUBROUTINE TRANSF_SNL_FC (XK0, D, XNU, SIG_TH, BATHYMAX, DKMAX, G, XKDMIN) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + !---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: XK0, D, XNU, SIG_TH + + + REAL(KIND=JWRB), INTENT(IN) :: BATHYMAX + REAL(KIND=JWRB), INTENT(IN) :: DKMAX + REAL(KIND=JWRB), INTENT(IN) :: G + REAL(KIND=JWRB), INTENT(IN) :: XKDMIN +!$acc routine seq + END SUBROUTINE TRANSF_SNL_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/wamintgr_loki_gpu.c_hoist.F90 b/src/phys-scc-cuda/wamintgr_loki_gpu.c_hoist.F90 new file mode 100644 index 00000000..f52cb86a --- /dev/null +++ b/src/phys-scc-cuda/wamintgr_loki_gpu.c_hoist.F90 @@ -0,0 +1,462 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +SUBROUTINE WAMINTGR_LOKI_GPU (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, BLK2GLO, WVENVI, WVPRPT, FF_NOW, FF_NEXT, INTFLDS, & +& WAM2NEMO, MIJ, FL1, XLLWS, TIME1) + + + ! ---------------------------------------------------------------------- + + !**** *WAMINTGR* - 3-G WAM MODEL - TIME INTEGRATION OF WAVE FIELDS. + + !* PURPOSE. + ! -------- + + ! COMPUTATION OF THE 2-D FREQUENCY-DIRECTION WAVE SPECTRUM AT ALL + ! GRID POINTS FOR A GIVEN INITIAL SPECTRUM AND FORCING SURFACE + ! STRESS FIELD. + + ! REFERENCE. + ! ---------- + + ! IFS DOCUMENTATION, part VII + + ! ------------------------------------------------------------------- + + USE IMPLSCH_FC_MOD, ONLY: IMPLSCH_FC + + ![Loki::GlobalVarHoistTransformation] -------- Added global variable imports for offload directives ----------- + USE yowstat, ONLY: IPHYS, ISNONLIN, IDAMPING, LBIWBK + USE yowwndg, ONLY: ICODE, ICODE_CPL + USE yowparam, ONLY: NFRE_RED, NFRE_ODD, LLUNSTR + USE yowcout, ONLY: LWFLUXOUT + USE yowtabl, ONLY: SWELLFT, IAB, EPS1 + USE yowaltas, ONLY: BFCRV, AFCRV, EGRCRV + USE yowwind, ONLY: WSPMIN + USE yowindn, ONLY: MFRSTLW, KFRH, IKP1, RNLCOEF, IKP, FKLAM1, K2W, INLCOEF, K21W, FKLAP, FKLAM, AF11, K1W, IKM, MLSTHG, DAL1, & + & FKLAP1, DAL2, K11W, IKM1 + USE yowice, ONLY: LCIWABR, LWAMRSETCI, CIBLOCK, CDICWA, CITHRSH, LICERUN, CITHRSH_TAIL, LMASKICE, FLMIN + USE yowcoup, ONLY: JTOT_TAUHF, LWVFLX_SNL, LWNEMOCOUSTRN, WTAUHF, LWCOU, LWNEMOTAUOC, X0TAUHF, LLCAPCHNK, LLGCBZ0, & + & LWNEMOCOUSTK, LWNEMOCOUSEND, LLNORMAGAM, LWFLUX + USE yowfred, ONLY: WETAIL, COFRM4, FRATIO, C2OSQRTVG_GC, FLOGSPRDM1, DELKCC_OMXKM3_GC, TH, OMXKM3_GC, FRIC, ZPIFR, FR5, & + & DFIM_SIM, DELKCC_GC_NS, DFIMOFR, OMEGA_GC, DFIM, DELTH, COSTH, WP1TAIL, DFIMFR, FR, XLOGKRATIOM1_GC, FRTAIL, CM_GC, & + & XKMSQRTVGOC2_GC, SINTH, XKM_GC, NWAV_GC, FLMAX, OM3GMKM_GC, DFIMFR2, XK_GC, RHOWG_DFIM, WP2TAIL + USE yowpcons, ONLY: ROWATER, GM1, WSEMEAN_MIN, EPSUS, ZPI, ZPI4GM2, PHIEPSMAX, DKMAX, ACD, SQRTGOSURFT, ZPI4GM1, EPSU10, & + & TAUOCMAX, PHIEPSMIN, CDMAX, G, ACDLIN, TAUOCMIN, ROWATERM1, BCD, BCDLIN + USE yowphys, ONLY: ZALP, INDICESSAT, CHNKMIN_U, DTHRN_A, RNU, NDIKCUMUL, SSDSC3, ALPHAMAX, ANG_GC_C, SWELLF3, SWELLF5, IPSAT, & + & SWELLF7M1, RNUM, CDIS, ANG_GC_B, Z0RAT, SWELLF2, MICHE, ABMIN, BETAMAXOXKAPPA2, GAMNCONST, NSDSNTH, ALPHA, ABMAX, & + & DELTA_SDIS, ANG_GC_A, SSDSC5, DTHRN_U, ALPHAMIN, XNLEV, CDISVIS, TAILFACTOR, SSDSC4, SATWEIGHTS, TAILFACTOR_PM, SSDSC2, & + & SSDSC6, RN1_RN, SWELLF7, SDSBR, BMAXOKAP, XKAPPA, TAUWSHELTER, ALPHAPMAX, SWELLF, CUMULW, SWELLF6, Z0TUBMAX, SWELLF4 + USE yowshal, ONLY: NDEPTH, BATHYMAX, XKDMIN + ![Loki::GlobalVarHoistTransformation] --------------------------------------- + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + USE YOWDRVTYPE, ONLY: WVGRIDGLO, ENVIRONMENT, FREQUENCY, FORCING_FIELDS, INTGT_PARAM_FIELDS, WAVE2OCEAN + + USE YOWCOUP, ONLY: LWNEMOCOU, NEMONTAU + USE YOWGRID, ONLY: NPROMA_WAM, NCHNK + USE YOWPARAM, ONLY: NIBLO, NANG, NFRE + USE YOWPCONS, ONLY: EPSMIN + USE YOWSTAT, ONLY: CDTPRO, IDELPRO, IDELT, IDELWI, LLSOURCE + USE YOWWIND, ONLY: CDAWIFL, CDATEWO, CDATEFL + USE YOWFIELD_MOD, ONLY: FREQUENCY_FIELD, ENVIRONMENT_FIELD, FORCING_FIELDS_FIELD, WAVE2OCEAN_FIELD, INTGT_PARAM_FIELDS_FIELD, & + & SOURCE_CONTRIBS_FIELD + + USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + ! INTERFACE + ! SUBROUTINE IMPLSCH_FC (KIJS, KIJL, FL1, WAVNUM, CGROUP, CIWA, CINV, XK2CG, STOKFAC, EMAXDPT, INDEP, DEPTH, IOBND, IODP, & + ! & AIRD, WDWAVE, CICOVER, WSWAVE, WSTAR, UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, CITHICK, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN, & + ! & NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, WSEMEAN, WSFMEAN, USTOKES, VSTOKES, STRNMS, TAUXD, & + ! & TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, MIJ, XLLWS) + ! USE parkind_wave, ONLY: jwim, jwrb, jwro + ! USE yowparam, ONLY: nang, nfre + ! INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL + ! REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL, NANG, NFRE) :: FL1 + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: WAVNUM + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CGROUP + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CIWA + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: CINV + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: XK2CG + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL, NFRE) :: STOKFAC + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: EMAXDPT + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: DEPTH + ! INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: INDEP + ! INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: IODP + ! INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: IOBND + ! REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: WDWAVE, CICOVER, AIRD, WSTAR, CITHICK + ! REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: UFRIC, TAUW, TAUWDIR, Z0M, Z0B, CHRNCK, WSWAVE + ! REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: WSEMEAN, WSFMEAN, USTOKES, VSTOKES, STRNMS + ! REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD + ! REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(KIJL) :: PHIEPS, PHIAW + ! REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN + ! REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX + ! REAL(KIND=JWRO), INTENT(INOUT), DIMENSION(KIJL) :: NEMOTAUY, NEMOWSWAVE, NEMOPHIF + ! INTEGER(KIND=JWIM), INTENT(OUT), DIMENSION(KIJL) :: MIJ + ! REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL, NANG, NFRE) :: XLLWS + ! END SUBROUTINE IMPLSCH_FC + ! END INTERFACE + INTERFACE + SUBROUTINE INCDATE (CDATE, ISHIFT) + USE parkind_wave, ONLY: jwim + INTEGER(KIND=JWIM), INTENT(IN) :: ISHIFT + CHARACTER(LEN=*), INTENT(INOUT) :: CDATE + END SUBROUTINE INCDATE + END INTERFACE + INTERFACE + SUBROUTINE NEWWIND (CDATE, CDATEWH, LLNEWFILE, WVPRPT, FF_NOW, FF_NEXT) + USE YOWDRVTYPE, ONLY: FREQUENCY, FORCING_FIELDS + CHARACTER(LEN=14), INTENT(IN) :: CDATE + CHARACTER(LEN=14), INTENT(INOUT) :: CDATEWH + LOGICAL, INTENT(INOUT) :: LLNEWFILE + TYPE(FREQUENCY), INTENT(INOUT) :: WVPRPT + TYPE(FORCING_FIELDS), INTENT(INOUT) :: FF_NOW + TYPE(FORCING_FIELDS), INTENT(IN) :: FF_NEXT + END SUBROUTINE NEWWIND + END INTERFACE + INTERFACE + SUBROUTINE PROPAG_WAM (BLK2GLO, WAVNUM, CGROUP, OMOSNH2KD, FL1, DEPTH, DELLAM1, COSPHM1, UCUR, VCUR) + USE parkind_wave, ONLY: jwrb + USE yowdrvtype, ONLY: wvgridglo + USE yowgrid, ONLY: nproma_wam, nchnk + USE yowparam, ONLY: nang, nfre + TYPE(WVGRIDGLO), INTENT(IN) :: BLK2GLO + REAL(KIND=JWRB), INTENT(INOUT), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK) :: FL1 + REAL(KIND=JWRB), INTENT(IN), DIMENSION(NPROMA_WAM, NFRE, NCHNK) :: WAVNUM, CGROUP, OMOSNH2KD + REAL(KIND=JWRB), INTENT(IN), DIMENSION(NPROMA_WAM, NCHNK) :: DEPTH, DELLAM1, COSPHM1, UCUR, VCUR + END SUBROUTINE PROPAG_WAM + END INTERFACE + INTERFACE + FUNCTION WAM_USER_CLOCK () + USE parkind_wave, ONLY: jwru + REAL(KIND=JWRU) :: WAM_USER_CLOCK + END FUNCTION WAM_USER_CLOCK + END INTERFACE + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + CHARACTER(LEN=14), INTENT(IN) :: CDTPRA ! DATE FOR CALL PROPAGATION + CHARACTER(LEN=14), INTENT(INOUT) :: CDATE ! CURRENT DATE + CHARACTER(LEN=14), INTENT(INOUT) :: CDATEWH ! DATE OF THE NEXT FORCING FIELDS + CHARACTER(LEN=14), INTENT(INOUT) :: CDTIMP ! START DATE OF SOURCE FUNCTION INTEGRATION + CHARACTER(LEN=14), INTENT(INOUT) :: CDTIMPNEXT ! NEXT START DATE OF SOURCE FUNCTION INTEGRATION + TYPE(WVGRIDGLO), INTENT(IN) :: BLK2GLO ! BLOCK TO GRID TRANSFORMATION + TYPE(ENVIRONMENT), INTENT(INOUT) :: WVENVI ! WAVE ENVIRONMENT FIELDS + TYPE(FREQUENCY), INTENT(INOUT) :: WVPRPT ! WAVE PROPERTIES FIELDS + TYPE(FORCING_FIELDS), INTENT(INOUT) :: FF_NOW ! FORCING FIELDS AT CURRENT TIME + TYPE(FORCING_FIELDS), INTENT(IN) :: FF_NEXT ! DATA STRUCTURE WITH THE NEXT FORCING FIELDS + TYPE(INTGT_PARAM_FIELDS), INTENT(INOUT) :: INTFLDS ! INTEGRATED/DERIVED PARAMETERS + TYPE(WAVE2OCEAN), INTENT(INOUT) :: WAM2NEMO ! WAVE FIELDS PASSED TO NEMO + INTEGER(KIND=JWIM), INTENT(INOUT) :: MIJ(NPROMA_WAM, NCHNK) ! LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE + REAL(KIND=JWRB), INTENT(INOUT) :: FL1(NPROMA_WAM, NANG_loki_param, NFRE_loki_param, NCHNK) + REAL(KIND=JWRB), INTENT(INOUT) :: XLLWS(NPROMA_WAM, NANG_loki_param, NFRE_loki_param, NCHNK) ! TOTAL WINDSEA MASK FROM INPUT SOURCE TERM + + REAL(KIND=JWRB), INTENT(INOUT) :: TIME1(3) + REAL(KIND=JWRB) :: TIME0, TIME2 + + + INTEGER(KIND=JWIM) :: IJ, K, M + INTEGER(KIND=JWIM) :: ICHNK + INTEGER(KIND=JWIM) :: IDELWH + + ! Objects to store fields + TYPE(FREQUENCY_FIELD) :: WVPRPT_FIELD + TYPE(ENVIRONMENT_FIELD) :: WVENVI_FIELD + TYPE(FORCING_FIELDS_FIELD) :: FF_NOW_FIELD + TYPE(WAVE2OCEAN_FIELD) :: WAM2NEMO_FIELD + TYPE(INTGT_PARAM_FIELDS_FIELD) :: INTFLDS_FIELD + TYPE(SOURCE_CONTRIBS_FIELD) :: SRC_CONTRIBS + + ! DEVICE POINTERS + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: FL1_DPTR(:, :, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: XLLWS_DPTR(:, :, :, :) => NULL() + INTEGER(KIND=JWIM), POINTER, CONTIGUOUS :: MIJ_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WAVNUM_DPTR(:, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CGROUP_DPTR(:, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: OMOSNH2KD_DPTR(:, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CIWA_DPTR(:, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CINV_DPTR(:, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: XK2CG_DPTR(:, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: STOKFAC_DPTR(:, :, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: EMAXDPT_DPTR(:, :) => NULL() + INTEGER(KIND=JWIM), POINTER, CONTIGUOUS :: INDEP_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: DEPTH_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: DELLAM1_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: COSPHM1_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: UCUR_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: VCUR_DPTR(:, :) => NULL() + INTEGER(KIND=JWIM), POINTER, CONTIGUOUS :: IOBND_DPTR(:, :) => NULL() + INTEGER(KIND=JWIM), POINTER, CONTIGUOUS :: IODP_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CICOVER_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSWAVE_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WDWAVE_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: AIRD_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSTAR_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: UFRIC_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUW_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUWDIR_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: Z0M_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: Z0B_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CHRNCK_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CITHICK_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NEMOUSTOKES_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NEMOVSTOKES_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NEMOSTRN_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NPHIEPS_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NTAUOC_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NSWH_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NMWP_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NEMOTAUX_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NEMOTAUY_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NEMOWSWAVE_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: NEMOPHIF_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSEMEAN_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSFMEAN_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: USTOKES_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: VSTOKES_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: STRNMS_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUXD_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUYD_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUOCXD_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUOCYD_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUOC_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: PHIOCD_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: PHIEPS_DPTR(:, :) => NULL() + REAL(KIND=JWRB), POINTER, CONTIGUOUS :: PHIAW_DPTR(:, :) => NULL() + + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + + LOGICAL, SAVE :: LLNEWFILE + + DATA LLNEWFILE / .false. / + INTEGER :: istat + REAL(KIND=JWRB) :: IMPLSCH_RAORW(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_EMEAN(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_FMEAN(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_HALP(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_EMEANWS(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_FMEANWS(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_F1MEAN(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_AKMEAN(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_XKMEAN(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_PHIWA(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_FLM(NPROMA_WAM, NANG_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_COSWDIF(NPROMA_WAM, NANG_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_SINWDIF2(NPROMA_WAM, NANG_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_RHOWGDFTH(NPROMA_WAM, NFRE_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_FLD(NPROMA_WAM, NANG_loki_param, NFRE_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_SL(NPROMA_WAM, NANG_loki_param, NFRE_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_SPOS(NPROMA_WAM, NANG_loki_param, NFRE_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_CIREDUC(NPROMA_WAM, NANG_loki_param, NFRE_loki_param, NCHNK) + REAL(KIND=JWRB) :: IMPLSCH_SSOURCE(NPROMA_WAM, NANG_loki_param, NFRE_loki_param, NCHNK) + REAL(KIND=JWRB) :: SINFLX_RNFAC(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: SINFLX_TMP_EM(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: STRESSO_XSTRESS(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: STRESSO_YSTRESS(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: STRESSO_TAUHF(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: STRESSO_PHIHF(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: STRESSO_USDIRP(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: STRESSO_UST(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: SNONLIN_ENH(NPROMA_WAM, MLSTHG, NCHNK) + REAL(KIND=JWRB) :: SNONLIN_XNU(NPROMA_WAM, NCHNK) + REAL(KIND=JWRB) :: SNONLIN_SIG_TH(NPROMA_WAM, NCHNK) + +!$acc enter data create( IMPLSCH_RAORW, IMPLSCH_EMEAN, IMPLSCH_FMEAN, IMPLSCH_HALP, IMPLSCH_EMEANWS, IMPLSCH_FMEANWS, & +!$acc & IMPLSCH_F1MEAN, IMPLSCH_AKMEAN, IMPLSCH_XKMEAN, IMPLSCH_PHIWA, IMPLSCH_FLM, IMPLSCH_COSWDIF, IMPLSCH_SINWDIF2, & +!$acc & IMPLSCH_RHOWGDFTH, IMPLSCH_FLD, IMPLSCH_SL, IMPLSCH_SPOS, IMPLSCH_CIREDUC, IMPLSCH_SSOURCE, SINFLX_RNFAC, SINFLX_TMP_EM, & +!$acc & STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST, SNONLIN_ENH, SNONLIN_XNU, & +!$acc & SNONLIN_SIG_TH ) + + + ! ---------------------------------------------------------------------- + + IF (LHOOK) CALL DR_HOOK('WAMINTGR', 0, ZHOOK_HANDLE) + + !* PROPAGATION TIME + ! ---------------- + + CALL SRC_CONTRIBS%INIT(FL1=FL1(:, :, :, :)) + CALL SRC_CONTRIBS%UPDATE_DEVICE(FL1=FL1_DPTR) + CALL WVPRPT_FIELD%INIT(WAVNUM=WVPRPT%WAVNUM, CGROUP=WVPRPT%CGROUP, OMOSNH2KD=WVPRPT%OMOSNH2KD) + CALL WVPRPT_FIELD%UPDATE_DEVICE(WAVNUM=WAVNUM_DPTR, CGROUP=CGROUP_DPTR, OMOSNH2KD=OMOSNH2KD_DPTR) + CALL WVENVI_FIELD%INIT(DEPTH=WVENVI%DEPTH, DELLAM1=WVENVI%DELLAM1, COSPHM1=WVENVI%COSPHM1, UCUR=WVENVI%UCUR, VCUR=WVENVI%VCUR) + CALL WVENVI_FIELD%UPDATE_DEVICE(DEPTH=DEPTH_DPTR, DELLAM1=DELLAM1_DPTR, COSPHM1=COSPHM1_DPTR, UCUR=UCUR_DPTR, VCUR=VCUR_DPTR) +!$acc data present( FL1_DPTR, WAVNUM_DPTR, CGROUP_DPTR, OMOSNH2KD_DPTR, DEPTH_DPTR, DELLAM1_DPTR, COSPHM1_DPTR, UCUR_DPTR, & +!$acc & VCUR_DPTR ) + + IF (CDATE == CDTPRA) THEN + TIME0 = -WAM_USER_CLOCK() + CALL PROPAG_WAM(BLK2GLO, WAVNUM_DPTR(:, :, :), CGROUP_DPTR(:, :, :), OMOSNH2KD_DPTR(:, :, :), FL1_DPTR(:, :, :, :), & + & DEPTH_DPTR(:, :), DELLAM1_DPTR(:, :), COSPHM1_DPTR(:, :), UCUR_DPTR(:, :), VCUR_DPTR(:, :)) + TIME1(1) = TIME1(1) + (TIME0 + WAM_USER_CLOCK())*1.E-06 + CDATE = CDTPRO + END IF +!$acc end data + + !* RETRIEVING NEW FORCING FIELDS IF NEEDED. + ! ---------------------------------------- + CALL NEWWIND(CDTIMP, CDATEWH, LLNEWFILE, WVPRPT, FF_NOW, FF_NEXT) + + ! IT IS TIME TO INTEGRATE THE SOURCE TERMS + ! ---------------------------------------- + IF (CDATE >= CDTIMPNEXT) THEN + ! COMPUTE UPDATE DUE TO SOURCE TERMS + CALL GSTATS(1431, 0) + IF (LLSOURCE) THEN + + TIME2 = -WAM_USER_CLOCK() + CALL WVPRPT_FIELD%INIT(CIWA=WVPRPT%CIWA, CINV=WVPRPT%CINV, XK2CG=WVPRPT%XK2CG, STOKFAC=WVPRPT%STOKFAC) + CALL WVENVI_FIELD%INIT(EMAXDPT=WVENVI%EMAXDPT, INDEP=WVENVI%INDEP, IOBND=WVENVI%IOBND, IODP=WVENVI%IODP) + CALL FF_NOW_FIELD%INIT(AIRD=FF_NOW%AIRD, WDWAVE=FF_NOW%WDWAVE, CICOVER=FF_NOW%CICOVER, WSWAVE=FF_NOW%WSWAVE, & + & WSTAR=FF_NOW%WSTAR, UFRIC=FF_NOW%UFRIC, TAUW=FF_NOW%TAUW, TAUWDIR=FF_NOW%TAUWDIR, Z0M=FF_NOW%Z0M, Z0B=FF_NOW%Z0B, & + & CHRNCK=FF_NOW%CHRNCK, CITHICK=FF_NOW%CITHICK) + CALL WAM2NEMO_FIELD%INIT(NEMOUSTOKES=WAM2NEMO%NEMOUSTOKES, NEMOVSTOKES=WAM2NEMO%NEMOVSTOKES, NEMOSTRN=WAM2NEMO%NEMOSTRN, & + & NPHIEPS=WAM2NEMO%NPHIEPS, NTAUOC=WAM2NEMO%NTAUOC, NSWH=WAM2NEMO%NSWH, NMWP=WAM2NEMO%NMWP, NEMOTAUX=WAM2NEMO%NEMOTAUX, & + & NEMOTAUY=WAM2NEMO%NEMOTAUY, NEMOWSWAVE=WAM2NEMO%NEMOWSWAVE, NEMOPHIF=WAM2NEMO%NEMOPHIF) + CALL INTFLDS_FIELD%INIT(WSEMEAN=INTFLDS%WSEMEAN, WSFMEAN=INTFLDS%WSFMEAN, USTOKES=INTFLDS%USTOKES, & + & VSTOKES=INTFLDS%VSTOKES, STRNMS=INTFLDS%STRNMS, TAUXD=INTFLDS%TAUXD, TAUYD=INTFLDS%TAUYD, TAUOCXD=INTFLDS%TAUOCXD, & + & TAUOCYD=INTFLDS%TAUOCYD, TAUOC=INTFLDS%TAUOC, PHIOCD=INTFLDS%PHIOCD, PHIEPS=INTFLDS%PHIEPS, PHIAW=INTFLDS%PHIAW) + CALL SRC_CONTRIBS%INIT(XLLWS=XLLWS(:, :, :, :), MIJ=MIJ(:, :)) + + + CALL WVPRPT_FIELD%UPDATE_DEVICE(CIWA=CIWA_DPTR, CINV=CINV_DPTR, XK2CG=XK2CG_DPTR, STOKFAC=STOKFAC_DPTR) + CALL WVENVI_FIELD%UPDATE_DEVICE(EMAXDPT=EMAXDPT_DPTR, INDEP=INDEP_DPTR, IOBND=IOBND_DPTR, IODP=IODP_DPTR) + CALL FF_NOW_FIELD%UPDATE_DEVICE(AIRD=AIRD_DPTR, WDWAVE=WDWAVE_DPTR, CICOVER=CICOVER_DPTR, WSWAVE=WSWAVE_DPTR, & + & WSTAR=WSTAR_DPTR, UFRIC=UFRIC_DPTR, TAUW=TAUW_DPTR, TAUWDIR=TAUWDIR_DPTR, Z0M=Z0M_DPTR, Z0B=Z0B_DPTR, & + & CHRNCK=CHRNCK_DPTR, CITHICK=CITHICK_DPTR) + CALL WAM2NEMO_FIELD%UPDATE_DEVICE(NEMOUSTOKES=NEMOUSTOKES_DPTR, NEMOVSTOKES=NEMOVSTOKES_DPTR, NEMOSTRN=NEMOSTRN_DPTR, & + & NPHIEPS=NPHIEPS_DPTR, NTAUOC=NTAUOC_DPTR, NSWH=NSWH_DPTR, NMWP=NMWP_DPTR, NEMOTAUX=NEMOTAUX_DPTR, & + & NEMOTAUY=NEMOTAUY_DPTR, NEMOWSWAVE=NEMOWSWAVE_DPTR, NEMOPHIF=NEMOPHIF_DPTR) + CALL INTFLDS_FIELD%UPDATE_DEVICE(WSEMEAN=WSEMEAN_DPTR, WSFMEAN=WSFMEAN_DPTR, USTOKES=USTOKES_DPTR, VSTOKES=VSTOKES_DPTR, & + & STRNMS=STRNMS_DPTR, TAUXD=TAUXD_DPTR, TAUYD=TAUYD_DPTR, TAUOCXD=TAUOCXD_DPTR, TAUOCYD=TAUOCYD_DPTR, TAUOC=TAUOC_DPTR, & + & PHIOCD=PHIOCD_DPTR, PHIEPS=PHIEPS_DPTR, PHIAW=PHIAW_DPTR) + CALL SRC_CONTRIBS%UPDATE_DEVICE(XLLWS=XLLWS_DPTR, MIJ=MIJ_DPTR) + +! $ acc data copyin( af11, c2osqrtvg_gc, cm_gc, cofrm4, costh, cumulw, delkcc_gc_ns, delkcc_omxkm3_gc, dfim, dfimfr, dfimfr2, & +! $ acc & dfimofr, dfim_sim, fklam, fklam1, fklap, fklap1, flmax, fr, fr5, ikm, ikm1, ikp, ikp1, indicessat, inlcoef, k11w, k1w, & +! $ acc & k21w, k2w, om3gmkm_gc, omega_gc, omxkm3_gc, rhowg_dfim, rnlcoef, satweights, sinth, swellft, th, wtauhf, & +! $ acc & xkmsqrtvgoc2_gc, xkm_gc, xk_gc, zpifr ) + +!$acc update device( af11, c2osqrtvg_gc, cm_gc, cofrm4, costh, cumulw, delkcc_gc_ns, delkcc_omxkm3_gc, dfim, dfimfr, dfimfr2, & +!$acc & dfimofr, dfim_sim, fklam, fklam1, fklap, fklap1, flmax, fr, fr5, ikm, ikm1, ikp, ikp1, indicessat, inlcoef, k11w, k1w, & +!$acc & k21w, k2w, om3gmkm_gc, omega_gc, omxkm3_gc, rhowg_dfim, rnlcoef, satweights, sinth, swellft, th, wtauhf, & +!$acc & xkmsqrtvgoc2_gc, xkm_gc, xk_gc, zpifr ) + +!$acc data present( FL1_DPTR,XLLWS_DPTR,MIJ_DPTR,WAVNUM_DPTR,CGROUP_DPTR,CIWA_DPTR,CINV_DPTR,XK2CG_DPTR,STOKFAC_DPTR, & +!$acc & EMAXDPT_DPTR,INDEP_DPTR,DEPTH_DPTR,IOBND_DPTR,IODP_DPTR,CICOVER_DPTR,WSWAVE_DPTR,WDWAVE_DPTR,AIRD_DPTR, & +!$acc & WSTAR_DPTR,UFRIC_DPTR,TAUW_DPTR,TAUWDIR_DPTR,Z0M_DPTR,Z0B_DPTR,CHRNCK_DPTR,CITHICK_DPTR,NEMOUSTOKES_DPTR, & +!$acc & NEMOVSTOKES_DPTR,NEMOSTRN_DPTR,NPHIEPS_DPTR,NTAUOC_DPTR,NSWH_DPTR,NMWP_DPTR,NEMOTAUX_DPTR,NEMOTAUY_DPTR, & +!$acc & NEMOWSWAVE_DPTR,NEMOPHIF_DPTR,WSEMEAN_DPTR,WSFMEAN_DPTR,USTOKES_DPTR,VSTOKES_DPTR,STRNMS_DPTR,TAUXD_DPTR, & +!$acc & TAUYD_DPTR,TAUOCXD_DPTR,TAUOCYD_DPTR,TAUOC_DPTR,PHIOCD_DPTR,PHIEPS_DPTR,PHIAW_DPTR ) + TIME0 = -WAM_USER_CLOCK() + +!$loki start removed loop + + CALL IMPLSCH_FC(1, NPROMA_WAM, FL1_DPTR(:, :, :, :), WAVNUM_DPTR(:, :, :), CGROUP_DPTR(:, :, :), CIWA_DPTR(:, :, :), & + & CINV_DPTR(:, :, :), XK2CG_DPTR(:, :, :), STOKFAC_DPTR(:, :, :), EMAXDPT_DPTR(:, :), INDEP_DPTR(:, :), DEPTH_DPTR(:, :), & + & IOBND_DPTR(:, :), IODP_DPTR(:, :), AIRD_DPTR(:, :), WDWAVE_DPTR(:, :), CICOVER_DPTR(:, :), WSWAVE_DPTR(:, :), & + & WSTAR_DPTR(:, :), UFRIC_DPTR(:, :), TAUW_DPTR(:, :), TAUWDIR_DPTR(:, :), Z0M_DPTR(:, :), Z0B_DPTR(:, :), & + & CHRNCK_DPTR(:, :), CITHICK_DPTR(:, :), NEMOUSTOKES_DPTR(:, :), NEMOVSTOKES_DPTR(:, :), NEMOSTRN_DPTR(:, :), & + & NPHIEPS_DPTR(:, :), NTAUOC_DPTR(:, :), NSWH_DPTR(:, :), NMWP_DPTR(:, :), NEMOTAUX_DPTR(:, :), NEMOTAUY_DPTR(:, :), & + & NEMOWSWAVE_DPTR(:, :), NEMOPHIF_DPTR(:, :), WSEMEAN_DPTR(:, :), WSFMEAN_DPTR(:, :), USTOKES_DPTR(:, :), & + & VSTOKES_DPTR(:, :), STRNMS_DPTR(:, :), TAUXD_DPTR(:, :), TAUYD_DPTR(:, :), TAUOCXD_DPTR(:, :), TAUOCYD_DPTR(:, :), & + & TAUOC_DPTR(:, :), PHIOCD_DPTR(:, :), PHIEPS_DPTR(:, :), PHIAW_DPTR(:, :), MIJ_DPTR(:, :), XLLWS_DPTR(:, :, :, :), ABMAX, & + & ABMIN, ACD, ACDLIN, AF11(:), AFCRV, ALPHA, ALPHAMAX, ALPHAMIN, ALPHAPMAX, ANG_GC_A, ANG_GC_B, ANG_GC_C, BATHYMAX, BCD, & + & BCDLIN, BETAMAXOXKAPPA2, BFCRV, BMAXOKAP, C2OSQRTVG_GC(:), CDICWA, CDIS, CDISVIS, CDMAX, CHNKMIN_U, CIBLOCK, CITHRSH, & + & CITHRSH_TAIL, CM_GC(:), COFRM4(:), COSTH(:), CUMULW(:, :, :, :), DAL1, DAL2, DELKCC_GC_NS(:), DELKCC_OMXKM3_GC(:), & + & DELTA_SDIS, DELTH, DFIM(:), DFIMFR(:), DFIMFR2(:), DFIMOFR(:), DFIM_SIM(:), DKMAX, DTHRN_A, DTHRN_U, EGRCRV, EPS1, & + & EPSMIN, EPSU10, EPSUS, FKLAM(:), FKLAM1(:), FKLAP(:), FKLAP1(:), FLMAX(:), FLMIN, FLOGSPRDM1, FR(:), FR5(:), FRATIO, & + & FRIC, FRTAIL, G, GAMNCONST, GM1, IAB, ICODE, ICODE_CPL, IDAMPING, IDELT, IKM(:), IKM1(:), IKP(:), IKP1(:), & + & INDICESSAT(:, :), INLCOEF(:, :), IPHYS, IPSAT, ISNONLIN, JTOT_TAUHF, K11W(:, :), K1W(:, :), K21W(:, :), K2W(:, :), KFRH, & + & LBIWBK, LCIWABR, LICERUN, LLCAPCHNK, LLGCBZ0, LLNORMAGAM, LLUNSTR, LMASKICE, LWAMRSETCI, LWCOU, LWFLUX, LWFLUXOUT, & + & LWNEMOCOU, LWNEMOCOUSEND, LWNEMOCOUSTK, LWNEMOCOUSTRN, LWNEMOTAUOC, LWVFLX_SNL, MFRSTLW, MICHE, MLSTHG, NANG, NDEPTH, & + & NDIKCUMUL, NFRE, NFRE_ODD, NFRE_RED, NSDSNTH, NWAV_GC, OM3GMKM_GC(:), OMEGA_GC(:), OMXKM3_GC(:), PHIEPSMAX, PHIEPSMIN, & + & RHOWG_DFIM(:), RN1_RN, RNLCOEF(:, :), RNU, RNUM, ROWATER, ROWATERM1, SATWEIGHTS(:, :), SDSBR, SINTH(:), SQRTGOSURFT, & + & SSDSC2, SSDSC3, SSDSC4, SSDSC5, SSDSC6, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, SWELLF7, SWELLF7M1, & + & SWELLFT(:), TAILFACTOR, TAILFACTOR_PM, TAUOCMAX, TAUOCMIN, TAUWSHELTER, TH(:), WETAIL, WP1TAIL, WP2TAIL, WSEMEAN_MIN, & + & WSPMIN, WTAUHF(:), X0TAUHF, XKAPPA, XKDMIN, XKMSQRTVGOC2_GC(:), XKM_GC(:), XK_GC(:), XLOGKRATIOM1_GC, XNLEV, Z0RAT, & + & Z0TUBMAX, ZALP, ZPI, ZPI4GM1, ZPI4GM2, ZPIFR(:), 1, NCHNK, 1, NCHNK, NPROMA_WAM, & + & IMPLSCH_RAORW, IMPLSCH_EMEAN, IMPLSCH_FMEAN, IMPLSCH_HALP, & + & IMPLSCH_EMEANWS, IMPLSCH_FMEANWS, IMPLSCH_F1MEAN, IMPLSCH_AKMEAN, IMPLSCH_XKMEAN, IMPLSCH_PHIWA, & + & IMPLSCH_FLM, IMPLSCH_COSWDIF, IMPLSCH_SINWDIF2, IMPLSCH_RHOWGDFTH, IMPLSCH_FLD, & + & IMPLSCH_SL, IMPLSCH_SPOS, IMPLSCH_CIREDUC, IMPLSCH_SSOURCE, SINFLX_RNFAC, & + & SINFLX_TMP_EM, STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, & + & STRESSO_UST, SNONLIN_ENH, SNONLIN_XNU, SNONLIN_SIG_TH) + ! RAORW=IMPLSCH_RAORW, & + ! & EMEAN=IMPLSCH_EMEAN, FMEAN=IMPLSCH_FMEAN, HALP=IMPLSCH_HALP, EMEANWS=IMPLSCH_EMEANWS, FMEANWS=IMPLSCH_FMEANWS, & + ! & F1MEAN=IMPLSCH_F1MEAN, AKMEAN=IMPLSCH_AKMEAN, XKMEAN=IMPLSCH_XKMEAN, PHIWA=IMPLSCH_PHIWA, FLM=IMPLSCH_FLM, & + ! & COSWDIF=IMPLSCH_COSWDIF, SINWDIF2=IMPLSCH_SINWDIF2, RHOWGDFTH=IMPLSCH_RHOWGDFTH, FLD=IMPLSCH_FLD, SL=IMPLSCH_SL, & + ! & SPOS=IMPLSCH_SPOS, CIREDUC=IMPLSCH_CIREDUC, SSOURCE=IMPLSCH_SSOURCE, SINFLX_RNFAC=SINFLX_RNFAC, & + ! & SINFLX_TMP_EM=SINFLX_TMP_EM, STRESSO_XSTRESS=STRESSO_XSTRESS, STRESSO_YSTRESS=STRESSO_YSTRESS, & + ! & STRESSO_TAUHF=STRESSO_TAUHF, STRESSO_PHIHF=STRESSO_PHIHF, STRESSO_USDIRP=STRESSO_USDIRP, STRESSO_UST=STRESSO_UST, & + ! & SNONLIN_ENH=SNONLIN_ENH, SNONLIN_XNU=SNONLIN_XNU, SNONLIN_SIG_TH=SNONLIN_SIG_TH) + +!$loki end removed loop + + TIME1(2) = TIME1(2) + (TIME0 + WAM_USER_CLOCK())*1.E-06 +! $ acc end data + +!$acc end data + + CALL WVPRPT_FIELD%ENSURE_HOST() + CALL WVENVI_FIELD%ENSURE_HOST() + CALL FF_NOW_FIELD%ENSURE_HOST() + CALL WAM2NEMO_FIELD%ENSURE_HOST() + CALL INTFLDS_FIELD%ENSURE_HOST() + CALL SRC_CONTRIBS%ENSURE_HOST() + + CALL WVPRPT_FIELD%FINAL() + CALL WVENVI_FIELD%FINAL() + CALL FF_NOW_FIELD%FINAL() + CALL WAM2NEMO_FIELD%FINAL() + CALL INTFLDS_FIELD%FINAL() + CALL SRC_CONTRIBS%FINAL() + TIME1(3) = TIME1(3) + (TIME2 + WAM_USER_CLOCK())*1.E-06 + + IF (LWNEMOCOU) NEMONTAU = NEMONTAU + 1 + + ELSE + ! NO SOURCE TERM CONTRIBUTION +!$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE( ICHNK ) + DO ICHNK=1,NCHNK + MIJ(:, ICHNK) = NFRE + FL1(:, :, :, ICHNK) = MAX(FL1(:, :, :, ICHNK), EPSMIN) + XLLWS(:, :, :, ICHNK) = 0.0_JWRB + END DO +!$OMP END PARALLEL DO + END IF + CALL GSTATS(1431, 1) + + + !* UPDATE FORCING FIELDS TIME COUNTER + ! ---------------------------------- + IF (LLNEWFILE) THEN + LLNEWFILE = .false. + IDELWH = MAX(IDELWI, IDELPRO) + CALL INCDATE(CDAWIFL, IDELWH) + CALL INCDATE(CDATEFL, IDELWH) + END IF + + CDATEWO = CDATEWH + CDTIMP = CDTIMPNEXT + CALL INCDATE(CDTIMPNEXT, IDELT) + + END IF + + IF (LHOOK) CALL DR_HOOK('WAMINTGR', 1, ZHOOK_HANDLE) + + +!$acc exit data delete( IMPLSCH_RAORW, IMPLSCH_EMEAN, IMPLSCH_FMEAN, IMPLSCH_HALP, IMPLSCH_EMEANWS, IMPLSCH_FMEANWS, & +!$acc & IMPLSCH_F1MEAN, IMPLSCH_AKMEAN, IMPLSCH_XKMEAN, IMPLSCH_PHIWA, IMPLSCH_FLM, IMPLSCH_COSWDIF, IMPLSCH_SINWDIF2, & +!$acc & IMPLSCH_RHOWGDFTH, IMPLSCH_FLD, IMPLSCH_SL, IMPLSCH_SPOS, IMPLSCH_CIREDUC, IMPLSCH_SSOURCE, SINFLX_RNFAC, SINFLX_TMP_EM, & +!$acc & STRESSO_XSTRESS, STRESSO_YSTRESS, STRESSO_TAUHF, STRESSO_PHIHF, STRESSO_USDIRP, STRESSO_UST, SNONLIN_ENH, SNONLIN_XNU, & +!$acc & SNONLIN_SIG_TH ) + +END SUBROUTINE WAMINTGR_LOKI_GPU diff --git a/src/phys-scc-cuda/wnfluxes.c_hoist.F90 b/src/phys-scc-cuda/wnfluxes.c_hoist.F90 new file mode 100644 index 00000000..81416243 --- /dev/null +++ b/src/phys-scc-cuda/wnfluxes.c_hoist.F90 @@ -0,0 +1,289 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE WNFLUXES_FC (KIJS, KIJL, MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, & +& UFRIC, AIRD, NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, & +& PHIOCD, PHIEPS, PHIAW, LNUPD, AFCRV, BFCRV, CIBLOCK, CITHRSH, COSTH, EGRCRV, EPSU10, EPSUS, FR, G, LICERUN, LWAMRSETCI, & +& LWNEMOCOU, LWNEMOTAUOC, NANG, NFRE, PHIEPSMAX, PHIEPSMIN, SINTH, TAUOCMAX, TAUOCMIN, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *WNFLUXES* - WAVE FLUXES CALCULATION + + !* PURPOSE. + ! -------- + + !** INTERFACE. + ! ---------- + + ! *CALL* *WNFLUXES* (KIJS, KIJL, + ! & MIJ, RHOWGDFTH, + ! & CINV, + ! & SSURF, CICOVER, + ! & PHIWA, + ! & EM, F1, WSWAVE, WDWAVE, + ! & UFRIC, AIRD, INTFLDS, WAM2NEMO, + ! & LNUPD) + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *MIJ* - LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE + ! *RHOWGDFTH - WATER DENSITY * G * DF * DTHETA + ! FOR TRAPEZOIDAL INTEGRATION BETWEEN FR(1) and FR(MIJ) + ! !!!!!!!! RHOWGDFTH=0 FOR FR > FR(MIJ) + ! *CINV* - INVERSE PHASE SPEED. + ! *SSURF* - CONTRIBUTION OF ALL SOURCE TERMS ACTING ON + ! THE SURFACE MOMENTUM AND ENERGY FLUXES. + ! *CICOVER*- SEA ICE COVER. + ! *PHIWA* - ENERGY FLUX FROM WIND INTO WAVES INTEGRATED + ! OVER THE FULL FREQUENCY RANGE. + ! *EM* - MEAN WAVE VARIANCE. + ! *F1* - MEAN WAVE FREQUENCY BASED ON f*F INTEGRATION. + ! *WSWAVE* - WIND SPEED IN M/S. + ! *WDWAVE* - WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC CONVENTION + ! *UFRIC* - FRICTION VELOCITY IN M/S. + ! *AIRD* - AIR DENSITY IN KG/M3. + ! *INTFLDS*- INTEGRATED/DERIVED PARAMETERS + ! WAM2NEMO*- WAVE FIELDS PASSED TO NEMO + ! *LNUPD* - UPDATE NEMO FIELDS. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRO, JWRB + USE YOWDRVTYPE, ONLY: WAVE2OCEAN, FORCING_FIELDS, INTGT_PARAM_FIELDS + + + USE YOWPCONS, ONLY: ZPI + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NFRE_loki_param = 36 + INTEGER(KIND=JWIM), PARAMETER :: NANG_loki_param = 24 + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SSURF(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: PHIWA(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIOCD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIEPS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIAW(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NPHIEPS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NTAUOC(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NSWH(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NMWP(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUX(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUY(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOWSWAVE(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOPHIF(:, :) + LOGICAL, VALUE, INTENT(IN) :: LNUPD + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + INTEGER(KIND=JWIM) :: K + INTEGER(KIND=JWIM) :: M + + ! FICTITIOUS VALUE OF THE NORMALISED WAVE ENERGY FLUX UNDER THE SEA ICE + ! (negative because it is defined as leaving the waves) + REAL(KIND=JWRB), PARAMETER :: PHIOC_ICE = -3.75_JWRB + REAL(KIND=JWRB), PARAMETER :: PHIAW_ICE = 3.75_JWRB + + ! USE HERSBACH 2011 FOR CD(U10) (SEE ALSO EDSON et al. 2013) + REAL(KIND=JWRB), PARAMETER :: C1 = 1.03E-3_JWRB + REAL(KIND=JWRB), PARAMETER :: C2 = 0.04E-3_JWRB + REAL(KIND=JWRB), PARAMETER :: P1 = 1.48_JWRB + REAL(KIND=JWRB), PARAMETER :: P2 = -0.21_JWRB + REAL(KIND=JWRB), PARAMETER :: CDMAX = 0.003_JWRB + + REAL(KIND=JWRB), PARAMETER :: EFD_MIN = 0.0625_JWRB ! corresponds to min Hs=1m under sea ice + REAL(KIND=JWRB), PARAMETER :: EFD_MAX = 6.25_JWRB ! corresponds to max Hs=10m under sea ice + + REAL(KIND=JWRB) :: TAU + REAL(KIND=JWRB) :: XN + REAL(KIND=JWRB) :: TAUO + REAL(KIND=JWRB) :: U10P + REAL(KIND=JWRB) :: CD_BULK + REAL(KIND=JWRB) :: CD_WAVE + REAL(KIND=JWRB) :: CD_ICE + REAL(KIND=JWRB) :: CNST + REAL(KIND=JWRB) :: EPSUS3 + REAL(KIND=JWRB) :: CITHRSH_INV + REAL(KIND=JWRB) :: EFD + REAL(KIND=JWRB) :: FFD + REAL(KIND=JWRB) :: EFD_FAC + REAL(KIND=JWRB) :: FFD_FAC + + REAL(KIND=JWRB) :: XSTRESS + REAL(KIND=JWRB) :: YSTRESS + REAL(KIND=JWRB) :: USTAR + REAL(KIND=JWRB) :: PHILF + REAL(KIND=JWRB) :: OOVAL + REAL(KIND=JWRB) :: EM_OC + REAL(KIND=JWRB) :: F1_OC + REAL(KIND=JWRB) :: CMRHOWGDFTH + REAL(KIND=JWRB) :: SUMT + REAL(KIND=JWRB) :: SUMX + REAL(KIND=JWRB) :: SUMY + REAL(KIND=JWRB), VALUE, INTENT(IN) :: AFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CIBLOCK + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EGRCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSU10 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOTAUOC + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + EPSUS3 = EPSUS*SQRT(EPSUS) + + CITHRSH_INV = 1._JWRB / MAX(CITHRSH, 0.01_JWRB) + + EFD_FAC = 4.0_JWRB*EGRCRV / G**2 + FFD_FAC = (EGRCRV / AFCRV)**(1.0_JWRB / BFCRV)*G + + !* DETERMINE NORMALIZED FLUXES FROM AIR TO WAVE AND FROM WAVE TO OCEAN. + ! ------------------------------------------------------------------- + + ! ENERGY FLUX from SSURF + ! MOMENTUM FLUX FROM SSURF + + PHILF = 0.0_JWRB + XSTRESS = 0.0_JWRB + YSTRESS = 0.0_JWRB + + ! THE INTEGRATION ONLY UP TO FR=MIJ + DO M=1,NFRE + K = 1 + SUMT = SSURF(IJ, K, M) + SUMX = SINTH(K)*SSURF(IJ, K, M) + SUMY = COSTH(K)*SSURF(IJ, K, M) + DO K=2,NANG + SUMT = SUMT + SSURF(IJ, K, M) + SUMX = SUMX + SINTH(K)*SSURF(IJ, K, M) + SUMY = SUMY + COSTH(K)*SSURF(IJ, K, M) + END DO + PHILF = PHILF + SUMT*RHOWGDFTH(IJ, M) + CMRHOWGDFTH = CINV(IJ, M, ICHNK)*RHOWGDFTH(IJ, M) + XSTRESS = XSTRESS + SUMX*CMRHOWGDFTH + YSTRESS = YSTRESS + SUMY*CMRHOWGDFTH + END DO + + IF (LICERUN .and. LWAMRSETCI) THEN + IF (CICOVER(IJ, ICHNK) > CIBLOCK) THEN + OOVAL = EXP(-MIN((CICOVER(IJ, ICHNK)*CITHRSH_INV)**4, 10._JWRB)) + ! ADJUST USTAR FOR THE PRESENCE OF SEA ICE + U10P = MAX(WSWAVE(IJ, ICHNK), EPSU10) + CD_BULK = MIN((C1 + C2*U10P**P1)*U10P**P2, CDMAX) + CD_WAVE = (UFRIC(IJ, ICHNK) / U10P)**2 + CD_ICE = OOVAL*CD_WAVE + (1.0_JWRB - OOVAL)*CD_BULK + USTAR = MAX(SQRT(CD_ICE)*U10P, EPSUS) + + ! EM_OC and F1_OC with fully developed model ENERGY + ! The significant wave height derived from EM_OC will be used + ! by NEMO as a scaling factor as if it was open ocean + EFD = MIN(EFD_FAC*USTAR**4, EFD_MAX) + EM_OC = MAX(OOVAL*EM(IJ) + (1.0_JWRB - OOVAL)*EFD, EFD_MIN) + FFD = FFD_FAC / USTAR + F1_OC = OOVAL*F1(IJ) + (1.0_JWRB - OOVAL)*FFD + F1_OC = MIN(MAX(F1_OC, FR(2)), FR(NFRE)) + ELSE + OOVAL = 1.0_JWRB + USTAR = UFRIC(IJ, ICHNK) + EM_OC = EM(IJ) + F1_OC = F1(IJ) + END IF + ELSE + OOVAL = 1.0_JWRB + USTAR = UFRIC(IJ, ICHNK) + EM_OC = EM(IJ) + F1_OC = F1(IJ) + END IF + + + TAU = AIRD(IJ, ICHNK)*MAX(USTAR**2, EPSUS) + TAUXD(IJ, ICHNK) = TAU*SIN(WDWAVE(IJ, ICHNK)) + TAUYD(IJ, ICHNK) = TAU*COS(WDWAVE(IJ, ICHNK)) + + TAUOCXD(IJ, ICHNK) = TAUXD(IJ, ICHNK) - OOVAL*XSTRESS + TAUOCYD(IJ, ICHNK) = TAUYD(IJ, ICHNK) - OOVAL*YSTRESS + TAUO = SQRT(TAUOCXD(IJ, ICHNK)**2 + TAUOCYD(IJ, ICHNK)**2) + TAUOC(IJ, ICHNK) = MIN(MAX(TAUO / TAU, TAUOCMIN), TAUOCMAX) + + XN = AIRD(IJ, ICHNK)*MAX(USTAR**3, EPSUS3) + PHIOCD(IJ, ICHNK) = OOVAL*(PHILF - PHIWA(IJ)) + (1.0_JWRB - OOVAL)*PHIOC_ICE*XN + + PHIEPS(IJ, ICHNK) = PHIOCD(IJ, ICHNK) / XN + PHIEPS(IJ, ICHNK) = MIN(MAX(PHIEPS(IJ, ICHNK), PHIEPSMIN), PHIEPSMAX) + + PHIOCD(IJ, ICHNK) = PHIEPS(IJ, ICHNK)*XN + + PHIAW(IJ, ICHNK) = PHIWA(IJ) / XN + PHIAW(IJ, ICHNK) = OOVAL*PHIWA(IJ) / XN + (1.0_JWRB - OOVAL)*PHIAW_ICE + + IF (LWNEMOCOU .and. LNUPD) THEN + NPHIEPS(IJ, ICHNK) = PHIEPS(IJ, ICHNK) + NTAUOC(IJ, ICHNK) = TAUOC(IJ, ICHNK) + IF (EM_OC /= 0.0_JWRB) THEN + NSWH(IJ, ICHNK) = 4.0_JWRO*SQRT(EM_OC) + ELSE + NSWH(IJ, ICHNK) = 0.0_JWRO + END IF + IF (F1_OC /= 0.0_JWRB) THEN + NMWP(IJ, ICHNK) = 1.0_JWRO / F1_OC + ELSE + NMWP(IJ, ICHNK) = 0.0_JWRO + END IF + + IF (LWNEMOTAUOC) THEN + NEMOTAUX(IJ, ICHNK) = NEMOTAUX(IJ, ICHNK) + TAUOCXD(IJ, ICHNK) + NEMOTAUY(IJ, ICHNK) = NEMOTAUY(IJ, ICHNK) + TAUOCYD(IJ, ICHNK) + ELSE + NEMOTAUX(IJ, ICHNK) = NEMOTAUX(IJ, ICHNK) + TAUXD(IJ, ICHNK) + NEMOTAUY(IJ, ICHNK) = NEMOTAUY(IJ, ICHNK) + TAUYD(IJ, ICHNK) + END IF + NEMOWSWAVE(IJ, ICHNK) = NEMOWSWAVE(IJ, ICHNK) + WSWAVE(IJ, ICHNK) + NEMOPHIF(IJ, ICHNK) = NEMOPHIF(IJ, ICHNK) + PHIOCD(IJ, ICHNK) + END IF + + + ! ---------------------------------------------------------------------- + +END SUBROUTINE WNFLUXES_FC diff --git a/src/phys-scc-cuda/wnfluxes_c.c b/src/phys-scc-cuda/wnfluxes_c.c new file mode 100644 index 00000000..0a0d03f9 --- /dev/null +++ b/src/phys-scc-cuda/wnfluxes_c.c @@ -0,0 +1,186 @@ +#include +#include +#include +#include +#include +#include +#include "wnfluxes_c.h" + +__device__ void wnfluxes_c(int kijs, int kijl, const int * mij, + const double * rhowgdfth, const double * cinv, const double * ssurf, + const double * cicover, const double * phiwa, const double * em, const double * f1, + const double * wswave, const double * wdwave, const double * ufric, + const double * aird, double * nphieps, double * ntauoc, double * nswh, double * nmwp, + double * nemotaux, double * nemotauy, double * nemowswave, double * nemophif, + double * tauxd, double * tauyd, double * tauocxd, double * tauocyd, double * tauoc, + double * phiocd, double * phieps, double * phiaw, int lnupd, double afcrv, + double bfcrv, double ciblock, double cithrsh, const double * costh, double egrcrv, + double epsu10, double epsus, const double * fr, double g, int licerun, int lwamrsetci, + int lwnemocou, int lwnemotauoc, int nang, int nfre, double phiepsmax, + double phiepsmin, const double * sinth, double tauocmax, double tauocmin, int ichnk, + int nchnk, int ij) { + + + + + const int nfre_loki_param = 36; + const int nang_loki_param = 24; + + int k; + int m; + double phioc_ice = -(double) 3.75; + double phiaw_ice = (double) 3.75; + double c1 = (double) 1.03E-3; + double c2 = (double) 0.04E-3; + double p1 = (double) 1.48; + double p2 = -(double) 0.21; + double cdmax = (double) 0.003; + + double efd_min = (double) 0.0625; // corresponds to min Hs=1m under sea ice + double efd_max = (double) 6.25; // corresponds to max Hs=10m under sea ice + + double tau; + double xn; + double tauo; + double u10p; + double cd_bulk; + double cd_wave; + double cd_ice; + double cnst; + double epsus3; + double cithrsh_inv; + double efd; + double ffd; + double efd_fac; + double ffd_fac; + + double xstress; + double ystress; + double ustar; + double philf; + double ooval; + double em_oc; + double f1_oc; + double cmrhowgdfth; + double sumt; + double sumx; + double sumy; + + epsus3 = epsus*sqrt((double) (epsus)); + + cithrsh_inv = (double) 1. / max((double) (cithrsh), (double) ((double) 0.01)); + + efd_fac = (double) 4.0*egrcrv / (pow(g, 2)); + ffd_fac = (pow((egrcrv / afcrv), ((double) 1.0 / bfcrv)))*g; + + philf = (double) 0.0; + xstress = (double) 0.0; + ystress = (double) 0.0; + for (m = 1; m <= nfre; m += 1) { + k = 1; + sumt = ssurf[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + sumx = sinth[k - 1]*ssurf[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + sumy = costh[k - 1]*ssurf[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + for (k = 2; k <= nang; k += 1) { + sumt = sumt + ssurf[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + sumx = sumx + sinth[k - 1]*ssurf[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + sumy = sumy + costh[k - 1]*ssurf[ij - 1 + kijl*(k - 1 + nang_loki_param*(m - 1))]; + } + philf = philf + sumt*rhowgdfth[ij - 1 + kijl*(m - 1)]; + cmrhowgdfth = cinv[ij - 1 + kijl*(m - 1 + nfre_loki_param*(ichnk - 1))]*rhowgdfth[ij + - 1 + kijl*(m - 1)]; + xstress = xstress + sumx*cmrhowgdfth; + ystress = ystress + sumy*cmrhowgdfth; + } + + if (licerun && lwamrsetci) { + if (cicover[ij - 1 + kijl*(ichnk - 1)] > ciblock) { + ooval = exp((double) (-min((double) (pow((cicover[ij - 1 + kijl*(ichnk - 1) + ]*cithrsh_inv), 4)), (double) ((double) 10.)))); + // ADJUST USTAR FOR THE PRESENCE OF SEA ICE + u10p = max((double) (wswave[ij - 1 + kijl*(ichnk - 1)]), (double) (epsu10)); + cd_bulk = + min((double) ((c1 + c2*(pow(u10p, p1)))*(pow(u10p, p2))), (double) (cdmax)); + cd_wave = pow((ufric[ij - 1 + kijl*(ichnk - 1)] / u10p), 2); + cd_ice = ooval*cd_wave + ((double) 1.0 - ooval)*cd_bulk; + ustar = max((double) (sqrt((double) (cd_ice))*u10p), (double) (epsus)); + efd = min((double) (efd_fac*(pow(ustar, 4))), (double) (efd_max)); + em_oc = + max((double) (ooval*em[ij - 1] + ((double) 1.0 - ooval)*efd), (double) (efd_min)) + ; + ffd = ffd_fac / ustar; + f1_oc = ooval*f1[ij - 1] + ((double) 1.0 - ooval)*ffd; + f1_oc = min((double) (max((double) (f1_oc), (double) (fr[2 - 1]))), (double) + (fr[nfre - 1])); + } else { + ooval = (double) 1.0; + ustar = ufric[ij - 1 + kijl*(ichnk - 1)]; + em_oc = em[ij - 1]; + f1_oc = f1[ij - 1]; + } + } else { + ooval = (double) 1.0; + ustar = ufric[ij - 1 + kijl*(ichnk - 1)]; + em_oc = em[ij - 1]; + f1_oc = f1[ij - 1]; + } + + + tau = aird[ij - 1 + kijl*(ichnk - 1)]*max((double) (pow(ustar, 2)), (double) (epsus)); + tauxd[ij - 1 + kijl*(ichnk - 1)] = tau*sin(wdwave[ij - 1 + kijl*(ichnk - 1)]); + tauyd[ij - 1 + kijl*(ichnk - 1)] = tau*cos(wdwave[ij - 1 + kijl*(ichnk - 1)]); + + tauocxd[ij - 1 + kijl*(ichnk - 1)] = tauxd[ij - 1 + kijl*(ichnk - 1)] - ooval*xstress; + tauocyd[ij - 1 + kijl*(ichnk - 1)] = tauyd[ij - 1 + kijl*(ichnk - 1)] - ooval*ystress; + tauo = sqrt((double) ((pow(tauocxd[ij - 1 + kijl*(ichnk - 1)], 2)) + (pow(tauocyd[ij - + 1 + kijl*(ichnk - 1)], 2)))); + tauoc[ij - 1 + kijl*(ichnk - 1)] = + min((double) (max((double) (tauo / tau), (double) (tauocmin))), (double) (tauocmax)); + + xn = aird[ij - 1 + kijl*(ichnk - 1)]*max((double) (pow(ustar, 3)), (double) (epsus3)); + phiocd[ij - 1 + kijl*(ichnk - 1)] = + ooval*(philf - phiwa[ij - 1]) + ((double) 1.0 - ooval)*phioc_ice*xn; + + phieps[ij - 1 + kijl*(ichnk - 1)] = phiocd[ij - 1 + kijl*(ichnk - 1)] / xn; + phieps[ij - 1 + kijl*(ichnk - 1)] = min((double) (max((double) (phieps[ij - 1 + + kijl*(ichnk - 1)]), (double) (phiepsmin))), (double) (phiepsmax)); + + phiocd[ij - 1 + kijl*(ichnk - 1)] = phieps[ij - 1 + kijl*(ichnk - 1)]*xn; + + phiaw[ij - 1 + kijl*(ichnk - 1)] = phiwa[ij - 1] / xn; + phiaw[ij - 1 + kijl*(ichnk - 1)] = + ooval*phiwa[ij - 1] / xn + ((double) 1.0 - ooval)*phiaw_ice; + + if (lwnemocou && lnupd) { + nphieps[ij - 1 + kijl*(ichnk - 1)] = phieps[ij - 1 + kijl*(ichnk - 1)]; + ntauoc[ij - 1 + kijl*(ichnk - 1)] = tauoc[ij - 1 + kijl*(ichnk - 1)]; + if (em_oc != (double) 0.0) { + nswh[ij - 1 + kijl*(ichnk - 1)] = (double) 4.0*sqrt((double) (em_oc)); + } else { + nswh[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + } + if (f1_oc != (double) 0.0) { + nmwp[ij - 1 + kijl*(ichnk - 1)] = (double) 1.0 / f1_oc; + } else { + nmwp[ij - 1 + kijl*(ichnk - 1)] = (double) 0.0; + } + + if (lwnemotauoc) { + nemotaux[ij - 1 + kijl*(ichnk - 1)] = + nemotaux[ij - 1 + kijl*(ichnk - 1)] + tauocxd[ij - 1 + kijl*(ichnk - 1)]; + nemotauy[ij - 1 + kijl*(ichnk - 1)] = + nemotauy[ij - 1 + kijl*(ichnk - 1)] + tauocyd[ij - 1 + kijl*(ichnk - 1)]; + } else { + nemotaux[ij - 1 + kijl*(ichnk - 1)] = + nemotaux[ij - 1 + kijl*(ichnk - 1)] + tauxd[ij - 1 + kijl*(ichnk - 1)]; + nemotauy[ij - 1 + kijl*(ichnk - 1)] = + nemotauy[ij - 1 + kijl*(ichnk - 1)] + tauyd[ij - 1 + kijl*(ichnk - 1)]; + } + nemowswave[ij - 1 + kijl*(ichnk - 1)] = + nemowswave[ij - 1 + kijl*(ichnk - 1)] + wswave[ij - 1 + kijl*(ichnk - 1)]; + nemophif[ij - 1 + kijl*(ichnk - 1)] = + nemophif[ij - 1 + kijl*(ichnk - 1)] + phiocd[ij - 1 + kijl*(ichnk - 1)]; + } + + +} diff --git a/src/phys-scc-cuda/wnfluxes_c.h b/src/phys-scc-cuda/wnfluxes_c.h new file mode 100644 index 00000000..ea44a3d5 --- /dev/null +++ b/src/phys-scc-cuda/wnfluxes_c.h @@ -0,0 +1,21 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void wnfluxes_c(int kijs, int kijl, const int * mij, + const double * rhowgdfth, const double * cinv, const double * ssurf, + const double * cicover, const double * phiwa, const double * em, const double * f1, + const double * wswave, const double * wdwave, const double * ufric, + const double * aird, double * nphieps, double * ntauoc, double * nswh, double * nmwp, + double * nemotaux, double * nemotauy, double * nemowswave, double * nemophif, + double * tauxd, double * tauyd, double * tauocxd, double * tauocyd, double * tauoc, + double * phiocd, double * phieps, double * phiaw, int lnupd, double afcrv, + double bfcrv, double ciblock, double cithrsh, const double * costh, double egrcrv, + double epsu10, double epsus, const double * fr, double g, int licerun, int lwamrsetci, + int lwnemocou, int lwnemotauoc, int nang, int nfre, double phiepsmax, + double phiepsmin, const double * sinth, double tauocmax, double tauocmin, int ichnk, + int nchnk, int ij); diff --git a/src/phys-scc-cuda/wnfluxes_fc.F90 b/src/phys-scc-cuda/wnfluxes_fc.F90 new file mode 100644 index 00000000..250dca0a --- /dev/null +++ b/src/phys-scc-cuda/wnfluxes_fc.F90 @@ -0,0 +1,160 @@ +MODULE WNFLUXES_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE WNFLUXES_fc (KIJS, KIJL, MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, UFRIC, AIRD, NPHIEPS, & + & NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, & + & LNUPD, AFCRV, BFCRV, CIBLOCK, CITHRSH, COSTH, EGRCRV, EPSU10, EPSUS, FR, G, LICERUN, LWAMRSETCI, LWNEMOCOU, LWNEMOTAUOC, & + & NANG, NFRE, PHIEPSMAX, PHIEPSMIN, SINTH, TAUOCMAX, TAUOCMIN, ICHNK, NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRO, JWRB + + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + LOGICAL, VALUE, INTENT(IN) :: LNUPD + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + ! FICTITIOUS VALUE OF THE NORMALISED WAVE ENERGY FLUX UNDER THE SEA ICE + ! (negative because it is defined as leaving the waves) + + ! USE HERSBACH 2011 FOR CD(U10) (SEE ALSO EDSON et al. 2013) + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: AFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CIBLOCK + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EGRCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSU10 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOTAUOC + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE WNFLUXES_iso_c (KIJS, KIJL, MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, UFRIC, AIRD, & + & NPHIEPS, NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, & + & PHIEPS, PHIAW, LNUPD, AFCRV, BFCRV, CIBLOCK, CITHRSH, COSTH, EGRCRV, EPSU10, EPSUS, FR, G, LICERUN, LWAMRSETCI, & + & LWNEMOCOU, LWNEMOTAUOC, NANG, NFRE, PHIEPSMAX, PHIEPSMIN, SINTH, TAUOCMAX, TAUOCMIN, ICHNK, NCHNK, IJ) & + & BIND(c, name="wnfluxes_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: MIJ + TYPE(c_ptr), VALUE :: RHOWGDFTH + TYPE(c_ptr), VALUE :: CINV + TYPE(c_ptr), VALUE :: SSURF + TYPE(c_ptr), VALUE :: CICOVER + TYPE(c_ptr), VALUE :: PHIWA + TYPE(c_ptr), VALUE :: EM + TYPE(c_ptr), VALUE :: F1 + TYPE(c_ptr), VALUE :: WSWAVE + TYPE(c_ptr), VALUE :: WDWAVE + TYPE(c_ptr), VALUE :: UFRIC + TYPE(c_ptr), VALUE :: AIRD + TYPE(c_ptr), VALUE :: NPHIEPS + TYPE(c_ptr), VALUE :: NTAUOC + TYPE(c_ptr), VALUE :: NSWH + TYPE(c_ptr), VALUE :: NMWP + TYPE(c_ptr), VALUE :: NEMOTAUX + TYPE(c_ptr), VALUE :: NEMOTAUY + TYPE(c_ptr), VALUE :: NEMOWSWAVE + TYPE(c_ptr), VALUE :: NEMOPHIF + TYPE(c_ptr), VALUE :: TAUXD + TYPE(c_ptr), VALUE :: TAUYD + TYPE(c_ptr), VALUE :: TAUOCXD + TYPE(c_ptr), VALUE :: TAUOCYD + TYPE(c_ptr), VALUE :: TAUOC + TYPE(c_ptr), VALUE :: PHIOCD + TYPE(c_ptr), VALUE :: PHIEPS + TYPE(c_ptr), VALUE :: PHIAW + LOGICAL, VALUE :: LNUPD + REAL, VALUE :: AFCRV + REAL, VALUE :: BFCRV + REAL, VALUE :: CIBLOCK + REAL, VALUE :: CITHRSH + TYPE(c_ptr), VALUE :: COSTH + REAL, VALUE :: EGRCRV + REAL, VALUE :: EPSU10 + REAL, VALUE :: EPSUS + TYPE(c_ptr), VALUE :: FR + REAL, VALUE :: G + LOGICAL, VALUE :: LICERUN + LOGICAL, VALUE :: LWAMRSETCI + LOGICAL, VALUE :: LWNEMOCOU + LOGICAL, VALUE :: LWNEMOTAUOC + INTEGER(KIND=c_int), VALUE :: NANG + INTEGER(KIND=c_int), VALUE :: NFRE + REAL, VALUE :: PHIEPSMAX + REAL, VALUE :: PHIEPSMIN + TYPE(c_ptr), VALUE :: SINTH + REAL, VALUE :: TAUOCMAX + REAL, VALUE :: TAUOCMIN + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE WNFLUXES_iso_c + END INTERFACE + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SSURF(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: PHIWA(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NPHIEPS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NTAUOC(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NSWH(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NMWP(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUX(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUY(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOWSWAVE(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOPHIF(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIOCD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIEPS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIAW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) +!$acc host_data use_device( MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, UFRIC, AIRD, NPHIEPS, NTAUOC, & +!$acc & NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, & +!$acc & COSTH, FR, SINTH ) + CALL WNFLUXES_iso_c(KIJS, KIJL, c_loc(MIJ), c_loc(RHOWGDFTH), c_loc(CINV), c_loc(SSURF), c_loc(CICOVER), c_loc(PHIWA), & + & c_loc(EM), c_loc(F1), c_loc(WSWAVE), c_loc(WDWAVE), c_loc(UFRIC), c_loc(AIRD), c_loc(NPHIEPS), c_loc(NTAUOC), c_loc(NSWH), & + & c_loc(NMWP), c_loc(NEMOTAUX), c_loc(NEMOTAUY), c_loc(NEMOWSWAVE), c_loc(NEMOPHIF), c_loc(TAUXD), c_loc(TAUYD), & + & c_loc(TAUOCXD), c_loc(TAUOCYD), c_loc(TAUOC), c_loc(PHIOCD), c_loc(PHIEPS), c_loc(PHIAW), LNUPD, AFCRV, BFCRV, CIBLOCK, & + & CITHRSH, c_loc(COSTH), EGRCRV, EPSU10, EPSUS, c_loc(FR), G, LICERUN, LWAMRSETCI, LWNEMOCOU, LWNEMOTAUOC, NANG, NFRE, & + & PHIEPSMAX, PHIEPSMIN, c_loc(SINTH), TAUOCMAX, TAUOCMIN, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE WNFLUXES_fc +END MODULE WNFLUXES_FC_MOD diff --git a/src/phys-scc-cuda/wnfluxes_fc.intfb.h b/src/phys-scc-cuda/wnfluxes_fc.intfb.h new file mode 100644 index 00000000..e3719042 --- /dev/null +++ b/src/phys-scc-cuda/wnfluxes_fc.intfb.h @@ -0,0 +1,84 @@ +INTERFACE + SUBROUTINE WNFLUXES_FC (KIJS, KIJL, MIJ, RHOWGDFTH, CINV, SSURF, CICOVER, PHIWA, EM, F1, WSWAVE, WDWAVE, UFRIC, AIRD, NPHIEPS, & + & NTAUOC, NSWH, NMWP, NEMOTAUX, NEMOTAUY, NEMOWSWAVE, NEMOPHIF, TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD, PHIEPS, PHIAW, & + & LNUPD, AFCRV, BFCRV, CIBLOCK, CITHRSH, COSTH, EGRCRV, EPSU10, EPSUS, FR, G, LICERUN, LWAMRSETCI, LWNEMOCOU, LWNEMOTAUOC, & + & NANG, NFRE, PHIEPSMAX, PHIEPSMIN, SINTH, TAUOCMAX, TAUOCMIN, ICHNK, NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRO, JWRB + USE YOWDRVTYPE, ONLY: WAVE2OCEAN, FORCING_FIELDS, INTGT_PARAM_FIELDS + + + USE YOWPCONS, ONLY: ZPI + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + INTEGER(KIND=JWIM), TARGET, INTENT(IN) :: MIJ(:, :) + + REAL(KIND=JWRB), TARGET, INTENT(IN) :: RHOWGDFTH(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CINV(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SSURF(:, :, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: CICOVER(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: PHIWA(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: EM(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: F1(:) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WSWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: WDWAVE(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UFRIC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: AIRD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCXD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOCYD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: TAUOC(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIOCD(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIEPS(:, :) + REAL(KIND=JWRB), TARGET, INTENT(INOUT) :: PHIAW(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NPHIEPS(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NTAUOC(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NSWH(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NMWP(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUX(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOTAUY(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOWSWAVE(:, :) + REAL(KIND=JWRO), TARGET, INTENT(INOUT) :: NEMOPHIF(:, :) + LOGICAL, VALUE, INTENT(IN) :: LNUPD + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + + ! FICTITIOUS VALUE OF THE NORMALISED WAVE ENERGY FLUX UNDER THE SEA ICE + ! (negative because it is defined as leaving the waves) + + ! USE HERSBACH 2011 FOR CD(U10) (SEE ALSO EDSON et al. 2013) + + + + REAL(KIND=JWRB), VALUE, INTENT(IN) :: AFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: BFCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CIBLOCK + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CITHRSH + REAL(KIND=JWRB), TARGET, INTENT(IN) :: COSTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EGRCRV + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSU10 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPSUS + REAL(KIND=JWRB), TARGET, INTENT(IN) :: FR(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + LOGICAL, VALUE, INTENT(IN) :: LICERUN + LOGICAL, VALUE, INTENT(IN) :: LWAMRSETCI + LOGICAL, VALUE, INTENT(IN) :: LWNEMOCOU + LOGICAL, VALUE, INTENT(IN) :: LWNEMOTAUOC + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NANG + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: NFRE + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: PHIEPSMIN + REAL(KIND=JWRB), TARGET, INTENT(IN) :: SINTH(:) + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMAX + REAL(KIND=JWRB), VALUE, INTENT(IN) :: TAUOCMIN + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE WNFLUXES_FC +END INTERFACE \ No newline at end of file diff --git a/src/phys-scc-cuda/wsigstar_c.c b/src/phys-scc-cuda/wsigstar_c.c new file mode 100644 index 00000000..5f002eb9 --- /dev/null +++ b/src/phys-scc-cuda/wsigstar_c.c @@ -0,0 +1,65 @@ +#include +#include +#include +#include +#include +#include +#include "wsigstar_c.h" + +__device__ void wsigstar_c(double wswave, double ufric, double z0m, double wstar, + double *sig_n, double acdlin, double alphamax, double alphamin, double bcdlin, + double epsus, double g, int llgcbz0, double rnum, double wspmin, double xkappa) { + + + + + double bg_gust = (double) 0.0; // NO BACKGROUND GUSTINESS (S0 12. IS NOT USED) + double onethird = (double) 1.0 / (double) 3.0; + double sig_nmax = (double) 0.9; // MAX OF RELATIVE STANDARD DEVIATION OF USTAR + + double log10 = log((double) 10.0); + double c1 = (double) 1.03E-3; + double c2 = (double) 0.04E-3; + double p1 = (double) 1.48; + double p2 = -(double) 0.21; + double zchar, c_d, dc_ddu, sig_conv; + double xkappad, u10, c2u10p1, u10p2; + double bcd, u10m1, zn, z0vis; + // + + + if (llgcbz0) { + zn = rnum; + + u10m1 = (double) 1.0 / max((double) (wswave), (double) (wspmin)); + // CHARNOCK: + z0vis = zn / max((double) (ufric), (double) (epsus)); + zchar = g*(z0m - z0vis) / max((double) (pow(ufric, 2)), (double) (epsus)); + zchar = + max((double) (min((double) (zchar), (double) (alphamax))), (double) (alphamin)); + + bcd = bcdlin*sqrt((double) (zchar)); + c_d = acdlin + bcd*wswave; + dc_ddu = bcd; + sig_conv = (double) 1.0 + (double) 0.5*wswave / c_d*dc_ddu; + (*sig_n) = min((double) (sig_nmax), (double) + (sig_conv*u10m1*(pow((bg_gust*(pow(ufric, 3)) + (double) 0.5*xkappa*(pow(wstar, 3)) + ), onethird)))); + } else { + zn = (double) 0.0; + xkappad = (double) 1.0 / xkappa; + u10 = ufric*xkappad*(log10 - log(z0m)); + u10 = max((double) (u10), (double) (wspmin)); + u10m1 = (double) 1.0 / u10; + c2u10p1 = c2*(pow(u10, p1)); + u10p2 = pow(u10, p2); + c_d = (c1 + c2u10p1)*u10p2; + dc_ddu = (p2*c1 + (p1 + p2)*c2u10p1)*u10p2*u10m1; + sig_conv = (double) 1.0 + (double) 0.5*u10 / c_d*dc_ddu; + (*sig_n) = min((double) (sig_nmax), (double) + (sig_conv*u10m1*(pow((bg_gust*(pow(ufric, 3)) + (double) 0.5*xkappa*(pow(wstar, 3)) + ), onethird)))); + } + + +} diff --git a/src/phys-scc-cuda/wsigstar_c.h b/src/phys-scc-cuda/wsigstar_c.h new file mode 100644 index 00000000..78aa5b02 --- /dev/null +++ b/src/phys-scc-cuda/wsigstar_c.h @@ -0,0 +1,11 @@ +#include +#include +#include +#include +#include +#include + + +__device__ void wsigstar_c(double wswave, double ufric, double z0m, double wstar, + double *sig_n, double acdlin, double alphamax, double alphamin, double bcdlin, + double epsus, double g, int llgcbz0, double rnum, double wspmin, double xkappa); diff --git a/src/phys-scc-cuda/wsigstar_fc.F90 b/src/phys-scc-cuda/wsigstar_fc.F90 new file mode 100644 index 00000000..bea9dca5 --- /dev/null +++ b/src/phys-scc-cuda/wsigstar_fc.F90 @@ -0,0 +1,57 @@ +MODULE WSIGSTAR_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE WSIGSTAR_fc (WSWAVE, UFRIC, Z0M, WSTAR, SIG_N, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, EPSUS, G, LLGCBZ0, RNUM, WSPMIN, & + & XKAPPA) + USE PARKIND_WAVE, ONLY: JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + + REAL(KIND=JWRB), INTENT(IN) :: WSWAVE, UFRIC, Z0M, WSTAR + REAL(KIND=JWRB), INTENT(OUT) :: SIG_N + + + + ! $ loki routine seq + REAL(KIND=JWRB), INTENT(IN) :: ACDLIN + REAL(KIND=JWRB), INTENT(IN) :: ALPHAMAX + REAL(KIND=JWRB), INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), INTENT(IN) :: BCDLIN + REAL(KIND=JWRB), INTENT(IN) :: EPSUS + REAL(KIND=JWRB), INTENT(IN) :: G + LOGICAL, INTENT(IN) :: LLGCBZ0 + REAL(KIND=JWRB), INTENT(IN) :: RNUM + REAL(KIND=JWRB), INTENT(IN) :: WSPMIN + REAL(KIND=JWRB), INTENT(IN) :: XKAPPA +!$acc routine seq + INTERFACE + SUBROUTINE WSIGSTAR_iso_c (WSWAVE, UFRIC, Z0M, WSTAR, SIG_N, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, EPSUS, G, LLGCBZ0, RNUM, & + & WSPMIN, XKAPPA) BIND(c, name="wsigstar_c_launch") + implicit none + REAL, VALUE :: WSWAVE + REAL, VALUE :: UFRIC + REAL, VALUE :: Z0M + REAL, VALUE :: WSTAR + REAL :: SIG_N + REAL, VALUE :: ACDLIN + REAL, VALUE :: ALPHAMAX + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: BCDLIN + REAL, VALUE :: EPSUS + REAL, VALUE :: G + LOGICAL, VALUE :: LLGCBZ0 + REAL, VALUE :: RNUM + REAL, VALUE :: WSPMIN + REAL, VALUE :: XKAPPA + END SUBROUTINE WSIGSTAR_iso_c + END INTERFACE +!$acc host_data use_device + CALL WSIGSTAR_iso_c(WSWAVE, UFRIC, Z0M, WSTAR, SIG_N, ACDLIN, ALPHAMAX, ALPHAMIN, BCDLIN, EPSUS, G, LLGCBZ0, RNUM, WSPMIN, & + & XKAPPA) +!$acc end host_data + END SUBROUTINE WSIGSTAR_fc +END MODULE WSIGSTAR_FC_MOD diff --git a/src/phys-scc-cuda/yowaltas.c_hoist.F90 b/src/phys-scc-cuda/yowaltas.c_hoist.F90 new file mode 100644 index 00000000..d89b931e --- /dev/null +++ b/src/phys-scc-cuda/yowaltas.c_hoist.F90 @@ -0,0 +1,176 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWALTAS + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: NUMALT = 10 + INTEGER(KIND=JWIM), PARAMETER :: NIJALT = 4 + INTEGER(KIND=JWIM), PARAMETER :: NALTDT = 3 + INTEGER(KIND=JWIM), PARAMETER :: NALTEDT = 3 + INTEGER(KIND=JWIM), PARAMETER :: NALTUDT = 2 + + INTEGER(KIND=JWIM) :: NALTAVLB + INTEGER(KIND=JWIM) :: IBUFRSAT(NUMALT) + INTEGER(KIND=JWIM), ALLOCATABLE :: IJALT(:, :) + INTEGER(KIND=JWIM), ALLOCATABLE :: INTLMAX(:) + INTEGER(KIND=JWIM), ALLOCATABLE :: KMINLMAX(:) + INTEGER(KIND=JWIM), ALLOCATABLE :: KMAXLMAX(:) + INTEGER(KIND=JWIM), ALLOCATABLE :: NOBSPE(:) + + REAL(KIND=JWRB) :: EGRCRV + REAL(KIND=JWRB) :: AGRCRV + REAL(KIND=JWRB) :: BGRCRV + REAL(KIND=JWRB) :: AFCRV + REAL(KIND=JWRB) :: BFCRV + REAL(KIND=JWRB) :: ESH + REAL(KIND=JWRB) :: ASH + REAL(KIND=JWRB) :: BSH + REAL(KIND=JWRB) :: ASWKM + REAL(KIND=JWRB) :: BSWKM + + REAL(KIND=JWRB) :: XKAPPA2(NUMALT) + REAL(KIND=JWRB) :: HSCOEFCOR(NUMALT) + REAL(KIND=JWRB) :: HSCONSCOR(NUMALT) + REAL(KIND=JWRB) :: ALTSDTHRSH(NUMALT) + REAL(KIND=JWRB) :: ALTBGTHRSH(NUMALT) + REAL(KIND=JWRB) :: HSALTCUT(NUMALT) + + REAL(KIND=JWRB), ALLOCATABLE :: ALTDATA(:, :) + REAL(KIND=JWRB), ALLOCATABLE :: ALTEXDATA(:, :) + REAL(KIND=JWRB), ALLOCATABLE, DIMENSION(:) :: XLONOBS, SIGRATIO2, DIFFALTFG + + REAL(KIND=JWRU), ALLOCATABLE :: ALTUNDATA(:, :) + + CHARACTER(LEN=25) :: CSATNAME(NUMALT) + CHARACTER(LEN=14), ALLOCATABLE, DIMENSION(:) :: CDATEOBS + + LOGICAL :: LODBRALT + LOGICAL :: LALTCOR(NUMALT) + LOGICAL :: LALTLRGR(NUMALT) + LOGICAL :: LALTGRDOUT(NUMALT) + LOGICAL :: LALTPAS(NUMALT) + LOGICAL, ALLOCATABLE :: LALTPASSIV(:) + + ! VARIABLE TYPE PURPOSE + ! -------- ---- ------- + ! *NUMALT* INTEGER MAXIMUM NUMBER OF ALTIMETERS ALLOWED IN ALTAS. + ! *NIJALT* INTEGER SECOND DIMENSION OF IJALT + ! *NALTDT* INTEGER SECOND DIMENSION OF ALTDATA + ! IF 1 : CORRECTED WAVE HEIGHTS + ! 2 : ERROR ASSOCIATED WITH THE DATUM + ! 3 : ORIGINAL WAVE HEIGHT + ! *NALTEDT* INTEGER SECOND DIMENSION OF ALTEXDATA + ! 1 : LATITUDE OF OBSERVATION + ! 2 : LONGITUDE OF OBSERVATION + ! 3 : ORIGINAL WIND SPEED + ! *NALTUDT* INTEGER SECOND DIMENSION OF ALTUNDATA + ! 1 : LATITUDE OF CLOSEST NODE TO OBSERVATION + ! 2 : LONGITUDE OF CLOSEST NODE OBSERVATION + ! *NALTAVLB* INTEGER NUMBER OF ALTIMETERS FROM WHICH THERE ARE + ! AVAILABLE DATA. + ! *IBUFRSAT* INTEGER BUFR IDENTIFIER FOR THE SATELLITES + ! *IJALT* INTEGER ARRAY FOR: 1: ALTIMETER DATA BLOCK INDEX, + ! 2: SATELLITE IDENTIFIER, AND + ! 3: WAVE HEIGHT QUALITY STATUS + ! 4: WIND SPEED QUALITY STATUS + ! STATUS: + ! 1: ACTIVE + ! 0: PASSIVE OR BLACKLISTED (passing all QC's) + ! -1: MISSING DATA + ! -2: TOO SMALL (BELOW A CERTAIN THRESHOLD) + ! -3: TOO FEW MEASUREMENTS TO CREATE SUPEROBS + ! -4: STANDARD DEVIATION TOO LARGE TO CREATE SUPEROBS + ! -5: OVER MODEL SEA ICE THRESHOLD (SEE CITHRSH_SAT) + ! -6: FAILED BACKGROUNG CHECK + + ! *INTLMAX* INTEGER TABLE INDICATING WHETHER A PE COULD SHARE + ! ALTIMETER DATA WITH LOCAL PE (IRANK) + ! *KMINLMAX* INTEGER SOUTHERN LATITUDE INDEX OF THE SOUTHERN + ! LATITUDONAL BAND OF WIDTH LMAX FOR EACH PE + ! *KMAXLMAX* INTEGER NORTHERN LATITUDE INDEX OF THE NORTHERN + ! LATITUDONAL BAND OF WIDTH LMAX FOR EACH PE + ! *NOBSPE* INTEGER NUMBER OF DATA NEEDED PER PE (it includes data in the communication hallo). + + !!! EMPIRICAL CONSTANCE FOR SPECTRAL UPDATE FOLLOWING DATA ASSIMILATION + ! *EGRCRV* REAL PARAMETER OF THE NON DIMENSIONAL ENERGY + ! GROWTH CURVE. + ! ESTAR=EGRCRV*(TSTAR/(AGRCRV+TSTAR))**BGRCRV + ! *AGRCRV* REAL PARAMETER OF THE NON DIMENSIONAL ENERGY + ! GROWTH CURVE. + ! *BGRCRV* REAL PARAMETER OF THE NON DIMENSIONAL ENERGY + ! GROWTH CURVE. + ! *AFCRV* REAL PARAMETER OF THE NON DIMENSIONAL FREQUENCY + ! GROWTH CURVE. Based on f * F(f) + ! FSTAR=(EGRCRV/AFCRV)**(1/BFCRV) + ! *BFCRV* REAL PARAMETER OF THE NON DIMENSIONAL FREQUENCY + ! GROWTH CURVES. + ! *AFMRV* REAL PARAMETER OF THE NON DIMENSIONAL FREQUENCY + ! GROWTH CURVE. Based on 1/f F(f) + ! FSTAR=(EGRCRV/AFCRV)**(1/BFCRV) + ! *BFMRV* REAL PARAMETER OF THE NON DIMENSIONAL FREQUENCY + ! GROWTH CURVE. + ! *ESH* REAL PARAMETER OF THE NON DIMENSIONAL ENERGY LIMIT + ! AS A FUNCTION OF NON-DIMENSIONAL DEPTH DSTAR + ! ESTAR_LIMIT=ESH*TANH(ASH*DSTAR**BSH), where + ! DSTAR=DEPTH*G/USTAR**2 + ! *ASH* REAL PARAMETER OF THE NON DIMENSIONAL ENERGY LIMIT + ! SEE ESH. + ! *BSH* REAL PARAMETER OF THE NON DIMENSIONAL ENERGY LIMIT + ! SEE ESH. + ! *ASWKM* REAL PARAMETER TO EXPRESS MINIMUM KMEAN AS A FUNCTION + ! OF DEPTH: KMEAN >= ASWKM/DEPTH**BSWKM + ! *BSWKM* REAL PARAMETER TO EXPRESS MINIMUM KMEAN AS A FUNCTION + ! OF DEPTH: KMEAN >= ASWKM/DEPTH**BSWKM + + ! *XKAPPA2* REAL KAPPA2 PARAMETER USED IN THE DETERMINATION + ! OF ALTIMETER WAVE HEIGHTS (SEE GRFIELD) + ! *HSCOEFCOR*REAL COEFFICIENT OF THE CORRECTIVE LINEAR + ! REGRESSION FOR ALTIMETER WAVE HEIGHTS. + ! *HSCONSCOR*REAL CONSTANT COEFFICIE$NT OF THE CORRECTIVE + ! LINEAR REGRESSION FOR ALTIMETER WAVE + ! HEIGHTS. + ! *ALTSDTHRSH* REAL THRESHOLD FOR SUSPICIOUS DATA (SEE GRFIELD). + ! *ALTBGTHRSH* REAL THRESHOLD FOR BACKGROUND CHECK (SEE GRFIELD). + ! *HSALTCUT* REAL USER INPUT OF THE MINIMUM WAVE HEIGHT ALLOWED + ! FOR THE ALTIMETER WAVE HEIGHT. THE ACTUAL + ! MINIMUM HSCUT=MIN(HSALTCUT,SIGMA_ALT) + ! SEE GRFIELD. + ! *ALTDATA* REAL ALTIMETER DATA AND ERROR ESTIMATE AFTER + ! PREPROCESSING + ! *ALTEXDATA* REAL EXTRA ALTIMETER DATA (THAT WILL NOT BE PASSED + ! TO THE MODEL .. NEEDED ONLY FOR ODB CREATION) + ! *XLONOBS* REAL LONGITUDE OF ALTIMETER DATA AS USED BY OI. + ! *SIGRATIO2*REAL RATIO OF ALTIMETER TO MODEL ERROR IN OI. + ! *DIFFALTFG*REAL OBS MINUS FIRST GUESS AT OBS LOCATIONS. + + ! *ALTUNDATA* REAL8 FOR UNSTRUCTURED GRID: THE COORDINATES OF THE CLOSEST NODE + + ! *CSATNAME* CHARACTER NAME OF THE DIFFERENT ALTIMETERS + ! *LODBRALT* LOGICAL CONTROLS THE USE OF ODB FOR RADAR ALTIMETER OBS. + ! *LALTCOR* LOGICAL CONTROLS WHETHER THE ALTIMETER WAVE HEIGHT + ! OBSERVATION IS CORRECTED USING THE WAVE + ! SEA STATE PRIOR TO ITS ASSIMILATION. + ! *LALTLRGR* LOGICAL CONTROLS WHETHER THE ALTIMETER WAVE HEIGHT + ! OBSERVATION IS CORRECTED USING A PRESCRIBED + ! LINEAR REGRESSION. + ! *LALTGRDOUT* LOGICAL CONTROLS WHETHER TO OUTPUT THE GRIDDED + ! ALTIMETER PRODUCTS OF THE SPECIFIC + ! INSTRUMENT (AS PROVIDED IN THE NAME LIST) + ! *LALTPAS* LOGICAL CONTROLS WHETHER OR NOT THE DATA ARE FED + ! PASSIVELY OR NOT (DEFAULT). + ! *LALTPASSIV*LOGICAL USE BY OIFIELD TO EXCLUDE PASSIVE DATA. + + ! ---------------------------------------------------------------------- +!$acc declare create( EGRCRV ) +!$acc declare create( AFCRV ) +!$acc declare create( BFCRV ) +END MODULE YOWALTAS diff --git a/src/phys-scc-cuda/yowcoup.c_hoist.F90 b/src/phys-scc-cuda/yowcoup.c_hoist.F90 new file mode 100644 index 00000000..043e11fa --- /dev/null +++ b/src/phys-scc-cuda/yowcoup.c_hoist.F90 @@ -0,0 +1,251 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWCOUP + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU, JWRO + + IMPLICIT NONE + + !* ** *COUPL* - PARAMETERS FOR COUPLING. + + LOGICAL :: LLCAPCHNK + LOGICAL :: LLGCBZ0 + LOGICAL :: LLNORMAGAM + LOGICAL :: LWCOU + LOGICAL :: LWCOUSAMEGRID = .false. + LOGICAL :: LWNEMOCOU = .false. + LOGICAL :: LWNEMOCOUSEND + LOGICAL :: LWNEMOTAUOC + LOGICAL :: LWNEMOCOUSTRN = .false. + LOGICAL :: LWNEMOCOURECV + LOGICAL :: LWNEMOCOUCIC = .false. + LOGICAL :: LWNEMOCOUCIT = .false. + LOGICAL :: LWNEMOCOUCUR = .false. + LOGICAL :: LWNEMOCOUSTK = .false. + LOGICAL :: LWNEMOCOUDEBUG + LOGICAL :: LWCOU2W + LOGICAL :: LWCOURNW + LOGICAL :: LWCOUHMF + LOGICAL :: LWFLUX + LOGICAL :: LWVFLX_SNL + LOGICAL :: LWCOUNORMS + LOGICAL :: LLNORMIFS2WAM + LOGICAL :: LLNORMWAM2IFS + LOGICAL :: LLNORMWAMOUT + LOGICAL :: LLNORMWAMOUT_GLOBAL + CHARACTER(LEN=1024) :: CNORMWAMOUT_FILE + INTEGER :: IUWAMNORM_OUT + LOGICAL :: LMASK_OUT_NOT_SET + LOGICAL :: LMASK_TASK_STR + INTEGER(KIND=JWIM) :: KCOUSTEP + INTEGER(KIND=JWIM), ALLOCATABLE :: LFROMTASK(:), LTOTASK(:) + INTEGER(KIND=JWIM), ALLOCATABLE :: IJFROMTASK(:), IJTOTASK(:) + INTEGER(KIND=JWIM), ALLOCATABLE :: ISTFROMTASK(:), ISTTOTASK(:) + INTEGER(KIND=JWIM) :: NFROMTASKS, NTOTASKS + INTEGER(KIND=JWIM), ALLOCATABLE :: I_MASK_IN(:) + INTEGER(KIND=JWIM) :: N_MASK_IN + INTEGER(KIND=JWIM), ALLOCATABLE :: I_MASK_OUT(:), J_MASK_OUT(:) + INTEGER(KIND=JWIM) :: N_MASK_OUT + + INTEGER(KIND=JWIM), PARAMETER :: JTOT_TAUHF = 19 + ! must be odd !!! + REAL(KIND=JWRB) :: WTAUHF(JTOT_TAUHF) + REAL(KIND=JWRB) :: X0TAUHF + + INTEGER(KIND=JWIM) :: NEMONTAU + + INTEGER(KIND=JWIM) :: NEMOINIDATE + INTEGER(KIND=JWIM) :: NEMOINITIME + INTEGER(KIND=JWIM) :: NEMOITINI + INTEGER(KIND=JWIM) :: NEMOITEND + REAL(KIND=JWRO) :: NEMOTSTEP + INTEGER(KIND=JWIM) :: NEMOFRCO + INTEGER(KIND=JWIM) :: NEMONSTEP + INTEGER(KIND=JWIM) :: NEMOCSTEP + INTEGER(KIND=JWIM) :: NEMOWSTEP + + INTEGER(KIND=JWIM) :: IFSNSTEP + REAL(KIND=JWRB) :: IFSTSTEP + LOGICAL :: LIFS_IO_SERV_ENABLED + + CHARACTER(LEN=32) :: IFSCONTEXT + ! Corresponds to ALGORITHM_STATE_MOD%GET_ALGOR_TYPE() + INTEGER(KIND=JWIM) :: IFSNUPTRA + ! Corresponds to ALGORITHM_STATE_MOD%GET_NUPTRA() + INTEGER(KIND=JWIM) :: IFSMUPTRA + ! Corresponds to ALGORITHM_STATE_MOD%GET_MUPTRA() + + PROCEDURE(OUTWSPEC_IO_SERV), POINTER :: OUTWSPEC_IO_SERV_HANDLER => NULL() + PROCEDURE(OUTINT_IO_SERV), POINTER :: OUTINT_IO_SERV_HANDLER => NULL() + PROCEDURE(IFSTOWAM), POINTER :: IFSTOWAM_HANDLER => NULL() + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *LWCOU* LOGICAL CONTROLS COUPLING WITH ATMOSPHERIC MODEL + ! *LWCOUSAMEGRID TRUE when coupled and the atmospheric grid and the wave grid is the same + ! *LWNEMOCOUSEND* L SENDS DATA TO THE NEMO MODEL. + ! *LWNEMOCOUSTK LOGI. SEND SURFACE STOKES DRIFT TO NEMO + ! *LWNEMOCOUSTRN LOGI. SEND ICE WAVE STRAIN TO NEMO + ! *LWNEMOCOURECV* L RECV DATA FROM THE NEMO MODEL. + ! *LWNEMOCOU* LOGICAL CONTROLS COUPLING WITH NEMO OCEAN MODEL + ! *LWNEMOCOUDEBUG* LO EXTRA NETCDF DEBUGGING OUTPUT FOR NEMO COUPLING + ! *LWNEMOTAUOC* LO USE TAUOC OR FULL TAU FOR SENDING TO NEMO + ! *LWNEMOCOUCIC LOGI. USE THE ICE CONCENTRATION FROM NEMO for open ocean points as determined by the lake cover (see micep) + ! *LWNEMOCOUCIT LOGI. USE THE ICE THICKNESS FROM NEMO (see LWNEMOCOUCIC) + ! *LWNEMOCOUCUR LOGI. USE THE OCEAN CURRENTS FROM NEMO for open ocean points as determined by the lake cover (see getcurr) + ! *LWCOU2W* LOGICAL CONTROLS 1-WAY OR 2-WAY COUPLING TO ATMOSPHERE + ! *LWCOURNW* LOGICAL WHEN COUPLED, IF TRUE THEN THE WINDS ARE THE 10m NEUTRAL WINDS RELATIVE TO SURFACE OCEAN CURRENTS + ! *LWCOUHMF* LOGICAL WHEN COUPLED, IF TRUE THEN THE SEA STATE EFFECT ON THE HEAT AND MOISTURE WILL BE ACTIVATED + ! *LWFLUX* LOGICAL IF TRUE FLUXES FOR OCEAN MODEL ARE PRODUCED + ! FOR THE IFS. + ! *LWVFLX_SNL LOGICAL IF TRUE FLUXES FOR OCEAN MODEL ARE PRODUCED + ! WITh THE NONLINEAR SOURCE TERM CONTRIBUTION + ! *LWCOUNORMS*LOGICAL CONTROLS COMPUTING/PRINTING OF TRUE GLOBAL NORMS OF FIELDS + ! FROM/TO THE ATMOS MODEL + ! *LLNORMIFS2WAM* LOGICAL IF TRUE NORMS FOR FIELDS PASSED FROM IFS TO WAM WILL BE PRODUCED + ! *LLNORMWAM2IFS* LOGICAL IF TRUE NORMS FOR FIELDS PASSED FROM WAM TO IFS WILL BE PRODUCED + ! *LLNORMWAMOUT* LOGICAL IF TRUE NORMS OF SELECTED OUPTUT FIELDS WILL BE PRODUCED + ! *LLNORMWAMOUT_GLOBAL* LOGICAL IF TRUE NORMS OF SELECTED OUPTUT FIELDS WILL BE GLOBAL (see above) + ! *LMASK_OUT_NOT_SET INDICATES IF THE MASK USED FOR FIELDS RETURNED + ! TO IFS IS UNSET OR NOT. + ! *LMASK_TASK_STR* LOGICAL TRUE UNTIL THE TASK STRUCTURE CORRESPONDING + ! TO MASK_OUT IS DETERMINED. + ! *KCOUSTEP* INTEGER COUPLING TIME TO THE IFS (in seconds). + ! *LFROMTASK* INTEGER CONTROLS WHICH WAM TASKS CONTRIBUTE TO THE FIELDS + ! RETURNED TO THE IFS FROM CURRENT TASK + ! BY SPECIFYING THE NUMBER OF SEA POINTS THAT + ! CONTRIBUTES TO THE FIELDS + ! *LTOTASK* INTEGER CONTROLS WHICH WAM TASKS NEED TO RECEIVE + ! CONTRIBUTIONS TO THE FIELDS RETURNED TO IFS + ! FROM CURRENT WAM TASK BY SPECIFYING + ! THE NUMBER OF SEA POINTS THAT ARE NEEDED. + ! *IJFROMTASK*INTEGER GIVES THE (global) IJ INDEX FOR EACH SEA POINT + ! REFERRED TO BY LFROMTASK. + ! SIZE IS GIVEN BY NFROMTASKS + ! *IJTOTASK* INTEGER GIVES THE (global) IJ INDEX FOR EACH SEA POINT + ! REFERRED TO BY LTOTASK + ! SIZE IS GIVEN BY NTOTASKS. + ! *ISTFROMTASK*INTEGER GIVES THE STARTNG INDEX IN IJFROMTASK FOR ALL + ! IJ's THAT ARE FROM EACH TASK (if any). + ! *ISTTOTASK* INTEGER GIVES THE STARTNG INDEX IN IJTOTASK FOR ALL + ! IJ's THAT ARE TO BE SENT FROM EACh TASK (if any). + ! *NFROMTASKS*INTEGER SUM OF LFROMTASKS ON EACH TASK. + ! *NTOTASKS* INTEGER SUM OF LTOTASKS ON EACH TASK. + ! *I_MASK_IN* INTEGER LIST OF I INDEX OF MASK_IN THAT ARE LOCAL TO TASK + ! *N_MASK_IN* INTEGER MAXIMUM SIZE OF I_MASK_IN + ! *I_MASK_OUT*INTEGER LIST OF I INDEX OF MASK_OUT THAT ARE LOCAL TO TASK + ! *J_MASK_OUT*INTEGER LIST OF J INDEX OF MASK_OUT THAT ARE LOCAL TO TASK + ! *N_MASK_OUT*INTEGER MAXIMUM SIZE OF I_MASK_OUT AND J_MASK_OUT + ! *LLCAPCHNK* LOGICAL IF TRUE CHARNOCK FOR HIGH WINDS WILL BE CAPPED (see chnkmin) + ! *LLGCBZ0* LOGICAL IF TRUE USE GRAVITY-CAPILLARY MODEL FOR BACKGROUND ROUGHNESS + ! *LNORMAGAM* LOGICAL IF TRUE USE THE RENORMALISTION OF THE GROWTH RATE. + + ! *JTOT_TAUHF INTEGER DIMENSION OF WTAUHF. IT MUST BE ODD !!! + ! *WTAUHF* REAL INTEGRATION WEIGHT FOR TAU_PHI_HF + ! *X0TAUHF* REAL LOWEST LIMIT FOR INTEGRATION IN TAU_PHI_HF: X0 *(G/USTAR) + ! + + ! FOR ACCUMULATED FIELDS PASSED TO NEMO: + ! *NEMONTAU* INTEGER ACCUMULATION COUNT + ! + ! *NEMOINIDATE* INTEGER NEMO INITIAL DATE + ! *NEMOINITIME* INTEGER NEMO INITIAL TIME + ! *NEMOITINI* INTEGER NEMO INITIAL TIME STEP + ! *NEMOITEND* INTEGER NEMO FINAL TIME STEP + ! *NEMOTSTEP* REAL NEMO TIMESTEP + ! *NEMOFRCO* INTEGER NEMO COUPLING FREQ IN WAM TIME STEPS + ! *NEMONSTEP* INTEGER NEMO COUPLING FREQ IN NEMO TIME STEPS + ! *NEMOCSTEP* INTEGER NEMO CURRENT TIME STEP + ! *NEMOWSTEP* INTEGER WAM CURRENT TIME STEP + + ! *IFSTSTEP* TIME STEP OF ATMOSPHERIC MODEL + ! *IFSNSTEP* CURRENT STEP OF ATMOSPHERIC MODEL + ! *LIFS_IO_SERV_ENABLED* LOGICAL TRUE IF IFS IO SERVER ENABLED + ! + ! IFSCONTEXT Corresponds to ALGORITHM_STATE_MOD%GET_ALGOR_TYPE() + ! IFSNUPTRA Corresponds to ALGORITHM_STATE_MOD%GET_NUPTRA() + ! IFSMUPTRA Corresponds to ALGORITHM_STATE_MOD%GET_MUPTRA() + ! + ! ---------------------------------------------------------------------- + +!$acc declare create( LWFLUX ) +!$acc declare create( LWVFLX_SNL ) +!$acc declare create( LWNEMOTAUOC ) +!$acc declare create( LWCOU ) +!$acc declare create( LWNEMOCOU ) +!$acc declare create( LWNEMOCOUSEND ) +!$acc declare create( LWNEMOCOUSTK ) +!$acc declare create( LWNEMOCOUSTRN ) +!$acc declare create( LLCAPCHNK ) +!$acc declare create( X0TAUHF ) +!$acc declare create( WTAUHF ) +!$acc declare create( LLNORMAGAM ) +!$acc declare create( LLGCBZ0 ) + CONTAINS + + !---------------------------------------------------------------------------------------- + + SUBROUTINE IFSTOWAM (BLK2LOC, NFIELDS, NGPTOTG, NCA, NRA, FIELDS, LWCUR, MASK_IN, NXS, NXE, NYS, NYE, FIELDG) + USE PARKIND_WAVE, ONLY: JWIM, JWRB + USE YOWDRVTYPE, ONLY: WVGRIDLOC, FORCING_FIELDS + USE YOWGRID, ONLY: NPROMA_WAM, NCHNK + USE YOWABORT, ONLY: WAM_ABORT + TYPE(WVGRIDLOC), INTENT(IN) :: BLK2LOC + INTEGER(KIND=JWIM), INTENT(IN) :: NFIELDS, NGPTOTG, NCA, NRA + REAL(KIND=JWRB), INTENT(IN) :: FIELDS(NGPTOTG, NFIELDS) + LOGICAL, INTENT(IN) :: LWCUR + INTEGER(KIND=JWIM), INTENT(INOUT) :: MASK_IN(NGPTOTG) + INTEGER(KIND=JWIM), INTENT(IN) :: NXS, NXE, NYS, NYE + TYPE(FORCING_FIELDS), INTENT(INOUT) :: FIELDG + + IF (.not.ASSOCIATED(IFSTOWAM_HANDLER)) CALL WAM_ABORT('IFSTOWAM_HANDLER IS NOT INITIALIZED') + CALL IFSTOWAM_HANDLER(BLK2LOC, NFIELDS, NGPTOTG, NCA, NRA, FIELDS, LWCUR, MASK_IN, NXS, NXE, NYS, NYE, FIELDG) + + END SUBROUTINE IFSTOWAM + + !---------------------------------------------------------------------------------------- + + SUBROUTINE OUTWSPEC_IO_SERV (IJS, IJL, SPEC, MARSTYPE, CDATE, IFCST) + USE PARKIND_WAVE, ONLY: JWIM, JWRB + USE YOWPARAM, ONLY: NANG, NFRE + USE YOWABORT, ONLY: WAM_ABORT + IMPLICIT NONE + INTEGER(KIND=JWIM), INTENT(IN) :: IJS, IJL + REAL(KIND=JWRB), INTENT(IN) :: SPEC(IJS:IJL, NANG, NFRE) + CHARACTER(LEN=2), INTENT(IN) :: MARSTYPE + CHARACTER(LEN=14), INTENT(IN) :: CDATE + INTEGER, INTENT(IN) :: IFCST + + IF (.not.ASSOCIATED(OUTWSPEC_IO_SERV_HANDLER)) CALL WAM_ABORT('OUTWSPEC_IO_SERV_HANDLER IS NOT INITIALIZED') + CALL OUTWSPEC_IO_SERV_HANDLER(IJS, IJL, SPEC, MARSTYPE, CDATE, IFCST) + + END SUBROUTINE OUTWSPEC_IO_SERV + + !---------------------------------------------------------------------------------------- + + SUBROUTINE OUTINT_IO_SERV (NIPRMOUT, BOUT, INFOBOUT, MARSTYPE, CDATE, IFCST) + USE PARKIND_WAVE, ONLY: JWIM, JWRB + USE YOWGRID, ONLY: NPROMA_WAM, NCHNK + USE YOWABORT, ONLY: WAM_ABORT + IMPLICIT NONE + INTEGER(KIND=JWIM), INTENT(IN) :: NIPRMOUT + REAL(KIND=JWRB), INTENT(IN) :: BOUT(NPROMA_WAM, NIPRMOUT, NCHNK) + INTEGER(KIND=JWIM), INTENT(IN) :: INFOBOUT(NIPRMOUT, 3) + CHARACTER(LEN=2), INTENT(IN) :: MARSTYPE + CHARACTER(LEN=14), INTENT(IN) :: CDATE + INTEGER(KIND=JWIM), INTENT(IN) :: IFCST + + IF (.not.ASSOCIATED(OUTINT_IO_SERV_HANDLER)) CALL WAM_ABORT('OUTINT_IO_SERV_HANDLER IS NOT INITIALIZED') + CALL OUTINT_IO_SERV_HANDLER(NIPRMOUT, BOUT, INFOBOUT, MARSTYPE, CDATE, IFCST) + + END SUBROUTINE OUTINT_IO_SERV + + !---------------------------------------------------------------------------------------- + +END MODULE YOWCOUP diff --git a/src/phys-scc-cuda/yowcout.c_hoist.F90 b/src/phys-scc-cuda/yowcout.c_hoist.F90 new file mode 100644 index 00000000..a0201d23 --- /dev/null +++ b/src/phys-scc-cuda/yowcout.c_hoist.F90 @@ -0,0 +1,152 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWCOUT + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + !* ** *COUT* OUTPUT POINTS INDICES AND FLAGS. + + INTEGER(KIND=JWIM), PARAMETER :: NTRAIN = 3 + INTEGER(KIND=JWIM), PARAMETER :: JPPFLAG = 69 + 3*NTRAIN + 5 + !!!! change also in scripts: wave_setgflag + INTEGER(KIND=JWIM), PARAMETER :: NREAL = 14 + INTEGER(KIND=JWIM), PARAMETER :: NIPRMINFO = 5 + INTEGER(KIND=JWIM), PARAMETER :: NINFOBOUT = 3 + + CHARACTER(LEN=14), ALLOCATABLE :: COUTT(:) + CHARACTER(LEN=14) :: COUTLST + CHARACTER(LEN=14), ALLOCATABLE :: COUTS(:) + CHARACTER(LEN=14), ALLOCATABLE :: CASS(:) + + CHARACTER(LEN=256) :: COUTDESCRIPTION(JPPFLAG) + CHARACTER(LEN=33) :: COUTNAME(JPPFLAG) + + LOGICAL :: FFLAG(JPPFLAG) + LOGICAL :: FFLAG20 + LOGICAL :: GFLAG(JPPFLAG) + LOGICAL :: GFLAG20 + LOGICAL :: NFLAG(JPPFLAG) + LOGICAL :: NFLAGALL + LOGICAL :: UFLAG(JPPFLAG) + LOGICAL :: LFDB + LOGICAL :: LOUTINT + LOGICAL :: LWFLUXOUT + LOGICAL :: LSECONDORDER + LOGICAL :: LRSTST0 + LOGICAL :: LWAMANOUT + LOGICAL :: LWAMANOUT_ORIG + LOGICAL :: LRSTPARALR + LOGICAL :: LRSTPARALW + LOGICAL :: LRSTINFDAT + LOGICAL :: LLPARTITION + LOGICAL :: LWAM_USE_IO_SERV + LOGICAL :: LOUTMDLDCP + + INTEGER(KIND=JWIM) :: NWRTOUTWAM = 1 + INTEGER(KIND=JWIM) :: NIPRMOUT + INTEGER(KIND=JWIM) :: NGOUT + INTEGER(KIND=JWIM), ALLOCATABLE :: IJAR(:) + INTEGER(KIND=JWIM) :: NOUTT + INTEGER(KIND=JWIM) :: NOUTS + INTEGER(KIND=JWIM) :: NASS + INTEGER(KIND=JWIM) :: IRWDIR, IRCD, IRU10, IRHS, IRTP, IRT1, IRPHIAW, IRPHIOC, IRTAUOC + INTEGER(KIND=JWIM) :: IRHSWS, IRT1WS, IRBATHY + INTEGER(KIND=JWIM) :: IRALTHS, IRALTHSC, IRALTRC + INTEGER(KIND=JWIM) :: IFRSTPARTI + INTEGER(KIND=JWIM) :: IPFGTBL(JPPFLAG + 1) + INTEGER(KIND=JWIM), PARAMETER :: KDEL = 1 + INTEGER(KIND=JWIM), PARAMETER :: MDEL = 1 + INTEGER(KIND=JWIM) :: IPRMINFO(JPPFLAG, NIPRMINFO) + INTEGER(KIND=JWIM) :: ITOBOUT(JPPFLAG) + INTEGER(KIND=JWIM), ALLOCATABLE, DIMENSION(:, :) :: INFOBOUT + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *NTRAIN* INTEGER MAXIMUM NUMBER OF SWELL TRAINS. + ! *NREAL* INTEGER NUMBER OF REAL FIELDS IN RESTART FILE + ! *NIPRMINFO* INTEGER NUMBER OF AUXILLIARY INFORMATION ITEMS ON OUTPUT INTEGRATED PARAMETERS + ! *NINFOBOUT* INTEGER NUMBER OF AUXILLIARY INFORMATION NEEDED TO ENCODE IN GRIB THE INTEGRATED PARAMETERS + ! *COUTT* CHAR*14 OUTPUT TIMES. + ! *COUTLST* CHAR*14 LAST OUTPUT TIME. + ! *COUTS* CHAR*14 OUTPUT TIMES FOR THE SPECTRA. + ! *CASS* CHAR*14 ASSIMILATION TIMES. + ! *COUTNAME CHAR*33 NAME OF THE OUTPUT VARIABLES + ! *COUTDESCRIPTION CHAR*256 CHARACTER DESCRIPTION OF THE OUTPUT VARIABLES + ! *FFLAG* LOGICAL FILE OUTPUT FLAG FOR EACH OUTPUT TYPE. + ! *FFLAG20* LOGICAL .TRUE. IF OUTPUT IS WRITTEN TO UNIT IU20. + ! *GFLAG* LOGICAL GRIB OUTPUT FLAG FOR EACH OUTPUT TYPE. + ! *GFLAG20* LOGICAL .TRUE. IF OUTPUT IS GRIBBED TO UNIT IU30. + ! *NFLAG* LOGICAL NORM OUTPUT FLAG FOR EACH OUTPUT TYPE. + ! *NFLAGALL* LOGICAL .TRUE. IF NORM OUTPUT IS REQUESTED. + ! *UFLAG* LOGICAL FLAG WHETHER OUTPUT GRID FIELD IS USED + ! IN THE ASSIMILATION SCHEME + ! *LFDB* LOGICAL .TRUE. IF OUTPUT IS SENT TO FDB. + ! *LOUTINT* LOGICAL .TRUE. IF OUTINT WAS CALLED. + ! *NGOUT* INTEGER NUMBER OF OUTPUT POINTS. + ! *IJAR* INTEGER GRIDPOINT NUMBER OF OUTPUT POINT. + ! *NOUTT* INTEGER NUMBER OF OUTPUT TIMES. + ! *NOUTS* INTEGER NUMBER OF OUTPUT TIMES FOR THE SPECTRA. + ! *NASS* INTEGER NUMBER OF ASSIMILATION TIMES. + ! *IPFGTBL* INTEGER TABLE THAT ASSOCIATES EACH INTEGRATED OUTPUT PARAMETER + ! WITH A SPECIFIC PROCESSOR. IF SET TO -1, IT MEANS THAT + ! THE PARAMETER IS ONLY NEEDED FOR NORM CALCULATION. + ! *IRWDIR* INTEGER INDEX IN IPFGTBL OF WIND DIRECTION + ! *IRCD* INTEGER INDEX IN IPFGTBL OF CD + ! *IRU10* INTEGER INDEX IN IPFGTBL OF U10 + ! *IRHS* INTEGER INDEX IN IPFGTBL OF HS + ! *IRTP* INTEGER INDEX IN IPFGTBL OF TP + ! *IRT1* INTEGER INDEX IN IPFGTBL OF T1 + ! *IRPHIAW* INTEGER INDEX IN IPFGTBL OF PHIAW + ! *IRPHIOC* INTEGER INDEX IN IPFGTBL OF PHIOC + ! *IRTAUOC* INTEGER INDEX IN IPFGTBL OF TAUOC + ! *IRHSWS* INTEGER INDEX IN IPFGTBL OF HS WINDSEA + ! *IRT1WS* INTEGER INDEX IN IPFGTBL OF T1 WINDSEA + ! *IRBATHY* INTEGER INDEX IN IPFGTBL OF WATER DEPTH + ! *IRALTHS* INTEGER INDEX IN IPFGTBL OF ALTIMETER HS + ! *IRALTHSC* INTEGER INDEX IN IPFGTBL OF ALTIMETER HS CORRECTED + ! *IRALTRC* INTEGER INDEX IN IPFGTBL OF ALTIMETER RANGE CORRECTION + ! *IFRSTPARTI*INTEGER INDEX IN IPFGTBL OF THE FIRST PARTITONED PARAMETERS + ! *KDEL* INTEGER NUMBER OF DIRECTIONS THAT WILL BE WRITTEN + ! OUT/READ IN WHEN BINARY SPECTRA ARE PRODUCED + ! *MDEL* INTEGER NUMBER OF FREQUENCIES THAT WILL BE WRITTEN + ! OUT/READ IN WHEN BINARY SPECTRA ARE PRODUCED + ! *LWFLUXOUT* LOGICAL TRUE IF THE OCEAN FLUXES ARE OUTPUT PARAMETERS. + ! *LSECONDORDER* TRUE IF SECOND ORDER CORRECTION IS COMPUTED + ! FOR OUTPUT INTEGRATED PARAMETERS. + ! *LRSTST0 LOGICAL TRUE IF GRIB HEADER HAVE TO BE RESET + ! SUCH THAT THE FORECAST STEP POINTS TO + ! THE START OF THE RUN. + ! *LWAMANOUT* LOGICAL CONTROLS WHETHER FIELDS WILL BE WRITTEN AT + ! ANALYSIS TIME OR NOT. (USEFUL WHEN WAVE DATA + ! ASSIMILATION IS DONE IN MORE THAN ONE TRAJECTORY.) + ! *LRSTPARALR*LOGICAL TRUE WILL READ BINARY RESTART FILES IN PARALLEL (i.e. PER MPI TASK) + ! *LRSTPARALW*LOGICAL TRUE WILL WRITE BINARY RESTART FILES IN PARALLEL (i.e. PER MPI TASK) + ! *LRSTINFDAT*LOGICAL TRUE WILL WRITE AN ADDITIONAL wamfile WITH DATE/TIME INFO + ! *LLPARTITION* TRUE IF ANY SWELL PARTITION PARAMETER IS TO BE OUPUT + ! *NWRTOUTWAM INTEGER CONTROLS THE STRIDE WITH WHICH FDB OUTPUT PE's + ! ARE SELECTED (BY DEFAULT = 1) + ! *NIPRMOUT* INTEGER ACTUAL TOTAL NUMBER OF OUTPUT INTEGRATED PARAMETERS + ! *IPRMINFO* INTEGER AUXILIARY INFORMATION FOR OUTPUT OF INTEGRATED PARAMETERS + ! IPRMINFO(:,1) : GRIB TABLE NUMBER. + ! IPRMINFO(:,2) : GRIB PARAMETER IDENTIFIER. + ! IPRMINFO(:,3) : GRIB REFERENCE LEVEL IN FULL METER. + ! IPRMINFO(:,4) : 1 IF SEA ICE MASK IS IMPOSED ON OUTPUT FIELD. + ! IPRMINFO(:,5) : 1 IF TOO SHALLOW POINTS ARE SET TO MISSING. + ! *ITOBOUT* INTEGER GIVES THE INDEX IN BOUT OF THE INTEGRATED FIELDS THAT ARE ACTUALLY OUTPUT + ! *INFOBOUT* AUXILIARY INFORMATION TO ENCODE INTEGRATED PARAMETERS IN GRIB + ! INFOBOUT(:,1) : GRIB TABLE NUMBER. + ! INFOBOUT(:,2) : GRIB PARAMETER IDENTIFIER. + ! INFOBOUT(:,3) : GRIB REFERENCE LEVEL IN FULL METER. + ! *LWAM_USE_IO_SERV* LOGICAL CONTROLS WHETHER WAVE MODEL SHOULD USE IFS IO SERVER + ! *LOUTMDLDCP* LOGICAL, CONTROLS WHETHER THE MODEL MPI DECOMPOSITION IS WRITTEN OUT TO A FILE (see OUTMDLDCP) + ! ---------------------------------------------------------------------- +!$acc declare create( LWFLUXOUT ) +END MODULE YOWCOUT diff --git a/src/phys-scc-cuda/yowfred.c_hoist.F90 b/src/phys-scc-cuda/yowfred.c_hoist.F90 new file mode 100644 index 00000000..9dabf803 --- /dev/null +++ b/src/phys-scc-cuda/yowfred.c_hoist.F90 @@ -0,0 +1,219 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWFRED + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + USE YOWDRVTYPE, ONLY: FREQUENCY_LAND + + IMPLICIT NONE + + !* ** *FREDIR* - FREQUENCY AND DIRECTION GRID. + +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: FR(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIM(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: RHOWG_DFIM(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIM_SIM(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIMOFR(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIMOFR_SIM(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIM_END_L(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIM_END_U(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIMFR(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIMFR_SIM(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIMFR2(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: DFIMFR2_SIM(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: GOM(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: C(:) + REAL(KIND=JWRB) :: DELTH + REAL(KIND=JWRB) :: DELTR +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: TH(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: COSTH(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: SINTH(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: ZPIFR(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: FR5(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: FRM5(:) +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: COFRM4(:) + +!$loki dimension( NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: FLMAX(:) + + TYPE(FREQUENCY_LAND) :: WVPRPT_LAND + + + REAL(KIND=JWRB), PARAMETER :: FRATIO = 1.1_JWRB + REAL(KIND=JWRB), PARAMETER :: WETAIL = 0.25_JWRB + REAL(KIND=JWRB), PARAMETER :: FRTAIL = 0.2_JWRB + REAL(KIND=JWRB), PARAMETER :: WP1TAIL = 1.0_JWRB / 3.0_JWRB + REAL(KIND=JWRB), PARAMETER :: WP2TAIL = 0.5_JWRB + REAL(KIND=JWRB), PARAMETER :: QPTAIL = 2.0_JWRB / 9.0_JWRB + REAL(KIND=JWRB), PARAMETER :: COEF4 = 5.0E-07_JWRB + + + REAL(KIND=JWRB) :: XKMSS_CUTOFF + + INTEGER(KIND=JWIM) :: NWAV_GC + REAL(KIND=JWRB), PARAMETER :: KRATIO_GC = 1.2_JWRB + REAL(KIND=JWRB), PARAMETER :: XLOGKRATIOM1_GC = 1.0_JWRB / LOG(KRATIO_GC) + REAL(KIND=JWRB), PARAMETER :: XKS_GC = 0.006_JWRB + REAL(KIND=JWRB), PARAMETER :: XKL_GC = 20000.0_JWRB + +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: XK_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: XKM_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: OMEGA_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: OMXKM3_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: VG_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: C_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: CM_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: C2OSQRTVG_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: XKMSQRTVGOC2_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: OM3GMKM_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: DELKCC_GC(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: DELKCC_GC_NS(:) +!$loki dimension( NWAV_GC ) + REAL(KIND=JWRB), ALLOCATABLE :: DELKCC_OMXKM3_GC(:) + + REAL(KIND=JWRB), PARAMETER :: FRIC = 28.0_JWRB + REAL(KIND=JWRB), PARAMETER :: OLDWSFC = 1.2_JWRB + REAL(KIND=JWRB) :: FLOGSPRDM1 + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *FR* REAL FREQUENCIES IN HERTZ. + ! *DFIM* REAL FREQUENCY INTERVAL*DIRECTION INTERVAL. + ! FOR TRAPEZOIDAL RULE + ! *RHOWG_DFIM*REAL FREQUENCY INTERVAL*DIRECTION INTERVAL TIMES WATER DENSITY AND G. + ! *DFIM_SIM* REAL FREQUENCY INTERVAL*DIRECTION INTERVAL. + ! FOR SIMPSON RULE + ! *DFIMOFR* REAL DFIM/FR + ! *DFIMOFR_SIMREAL DFIM_SIM/FR + ! *DFIM_END_L REAL FREQUENCY INTERVAL*DIRECTION INTERVAL + ! FOR LOWER BOUND FOR TRAPEZOIDAL INTEGRATION WHERE + ! DFIM IS USED IN BETWEEN DFIM_END_L AND DFIM_END_U + ! *DFIM_END_U REAL FREQUENCY INTERVAL*DIRECTION INTERVAL + ! FOR UPPER BOUND FOR TRAPEZOIDAL INTEGRATION WHERE + ! DFIM IS USED IN BETWEEN DFIM_END_L AND DFIM_END_U + ! *DFIMFR* REAL DFIM*FR + ! *DFIMFR_SIM REAL DFIM_SIM*FR + ! *DFIMFR2* REAL DFIM*FR**2 + ! *DFIMFR2_SIMREAL DFIM_SIM*FR**2 + ! *GOM* REAL DEEP WATER GROUP VELOCITIES (M/S). + ! *C* REAL DEEP WATER PHASE VELOCITIES (M/S). + ! *DELTH* REAL ANGULAR INCREMENT OF SPECTRUM (RADIANS). + ! *DELTR* REAL DELTH TIMES RADIUS OF EARTH (METRES). + ! *TH* REAL DIRECTIONS IN RADIANS. + ! *COSTH* REAL COS OF DIRECTION. + ! *SINTH* REAL SIN OF DIRECTION. + ! *ZPIFR* REAL ZPI*FR(M) + ! *FR5* REAL FR(M)**5 + ! *FRM5* REAL (1./FR(M))**5 + ! *COFRM4* REAL COEF4*G*FR(M)**(-4.) + ! *FLMAX* REAL MAXIMUM SPECTRAL COMPONENT ALLOWED. + ! (ALPHAPMAX/PI) (G**2/(2PI)**4) FR(M)**-5 + ! ALPHAPMAX MAXIMUM PHILLIPS PARAMETER (SEE YOWPHYS). + ! *WVPRPT_LAND* FICTIOUS VALUE FOR LAND POINT (NSUP+1) + ! *FRATIO* REAL FREQUENCY RATIO. + ! *WETAIL* REAL WAVE ENERGY TAIL CONSTANT FACTOR. + ! *FRTAIL* REAL FREQUENCY TAIL CONSTANT FACTOR. + ! *WP1TAIL* REAL PERIOD 1 TAIL CONSTANT FACTOR. + ! *WP2TAIL* REAL PERIOD 2 TAIL CONSTANT FACTOR. + ! *QPTAIL* REAL GODA TAIL CONSTANT FACTOR. + ! *COEF4* REAL COEFFICIENT USED TO COMPUTE THE SPECTRAL + ! LIMITER IN IMPLSCH. + + ! *XKMSS_CUTOFF* IF DIFFERENT FROM 0., SETS THE MAXIMUM WAVE NUMBER TO BE USED IN + ! THE CALCULATION OF THE MEAN SQUARE SLOPE. + + ! *NWAV_GC* INTEGER TOTAL NUMBER OF DISCRETISED WAVE NUMBER OF THE GRAVITY-CAPILLARY SPECTRUM. + ! *KRATIO_GC* REAL WAVE NUMBER RATIO FOR THE GRAVITY-CAPILLARY SPECTRUM. + ! *XKS_GC* REAL WAVE NUMBER LOWER LIMIT FOR THE GRAVITY-CAPILLARY SPECTRUM. + ! *XKL_GC* REAL WAVE NUMBER UPPER LIMIT FOR THE GRAVITY-CAPILLARY SPECTRUM. + + ! *XK_GC* WAVE NUMBER OF THE GRAVITY-CAPILLARY SPECTRUM. + ! *XKM_GC* 1 / XK_GC + ! *OMEGA_GC* ANGULAR FREQUENCY OF THE GRAVITY-CAPILLARY SPECTRUM. + ! *OMXKM3_GC* OMEGA_GC * XKM_GC**3 + ! *VG_GC* GROUP VELOCITY OF THE GRAVITY-CAPILLARY SPECTRUM. + ! *C_GC* PHASE VELOCITY OF THE GRAVITY-CAPILLARY SPECTRUM. + ! *CM_GC* 1 / C_GC + ! *C2OSQRTVG_GC* C_GC**2/SQRT(VG_GC) + ! *XKMSQRTVGOC2_GC* XKM_GC * SQRT(VG_GC)/C_GC**2 + ! *OM3GMKM_GC* OMEGA_GC**3 / (g*XK_GC) + ! *DELKCC_GC* WAVE NUMBER OF THE GRAVITY-CAPILLARY SPECTRUM SPACING / C2OSQRTVG_GC + ! *DELKCC_GC_NS* WAVE NUMBER OF THE GRAVITY-CAPILLARY SPECTRUM SPACING for index NS / C2OSQRTVG_GC + ! *DELKCC_OMXKM3_GC* DELKCC_GC * OMXKM3_GC + + + ! *FRIC* REAL COEFFICIENT RELATING THE PIERSON-MOSKOVITCH + ! ANGULAR FREQUENCY OF THE SPECTRAL PEAK + ! TO THE FRICTION VELOCITY: + ! OMEGA_PM=G/(FRIC*USTAR) + ! *OLDWSFC* REAL OLD WIND SEA FACTOR USED TO DETERMINE THE THRESHOLD + ! FOR WINDSEA/SWELL SEPARATION + ! *FLOGSPRDM1* REAL FLOGSPRDM1=1./LOG10(FRATIO) + ! ---------------------------------------------------------------------- +!$acc declare create( COFRM4 ) +!$acc declare create( FLMAX ) +!$acc declare create( FLOGSPRDM1 ) +!$acc declare create( RHOWG_DFIM ) +!$acc declare create( DFIMFR ) +!$acc declare create( DFIMOFR ) +!$acc declare create( DFIMFR2 ) +!$acc declare create( DFIM_SIM ) +!$acc declare create( FR ) +!$acc declare create( DFIM ) +!$acc declare create( COSTH ) +!$acc declare create( SINTH ) +!$acc declare create( ZPIFR ) +!$acc declare create( FR5 ) +!$acc declare create( TH ) +!$acc declare create( DELTH ) +!$acc declare create( OMXKM3_GC ) +!$acc declare create( CM_GC ) +!$acc declare create( C2OSQRTVG_GC ) +!$acc declare create( XKMSQRTVGOC2_GC ) +!$acc declare create( OM3GMKM_GC ) +!$acc declare create( DELKCC_GC_NS ) +!$acc declare create( DELKCC_OMXKM3_GC ) +!$acc declare create( OMEGA_GC ) +!$acc declare create( XK_GC ) +!$acc declare create( NWAV_GC ) +!$acc declare create( XKM_GC ) +END MODULE YOWFRED diff --git a/src/phys-scc-cuda/yowice.c_hoist.F90 b/src/phys-scc-cuda/yowice.c_hoist.F90 new file mode 100644 index 00000000..2d1e3595 --- /dev/null +++ b/src/phys-scc-cuda/yowice.c_hoist.F90 @@ -0,0 +1,83 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWICE + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + !* ** *ICE* ICE POINTS + + + INTEGER(KIND=JWIM) :: IPARAMCI + INTEGER(KIND=JWIM) :: NICT, NICH + + REAL(KIND=JWRB), PARAMETER :: FLMIN = 0.00001_JWRB + ! MINIMUM ENERGY IN SPECTRAL BINS + REAL(KIND=JWRB) :: CITHRSH + REAL(KIND=JWRB) :: CIBLOCK + REAL(KIND=JWRB) :: CITHRSH_SAT + REAL(KIND=JWRB) :: CITHRSH_TAIL + REAL(KIND=JWRB) :: CDICWA + REAL(KIND=JWRB) :: TICMIN, HICMIN + REAL(KIND=JWRB) :: DTIC, DHIC + REAL(KIND=JWRB), ALLOCATABLE :: CIDEAC(:, :) + + LOGICAL :: LICERUN + LOGICAL :: LICETH + LOGICAL :: LMASKICE + LOGICAL :: LWAMRSETCI + LOGICAL :: LCIWABR + + !-------------------------------------------------------------------- + + !* VARIABLE TYPE PURPOSE + ! -------- ---- ------- + ! IPARAMCI INTEGER GRIB PARAMETER VALUE OF SEA ICE FRACTION OR SST. + ! NICT INTEGER FIRST DIMENSION (WAVE PERIOD) OF TABLE CIDEAC. + ! NICH INTEGER SECOND DIMENSION (ICE THICKNESS) OF TABLE CIDEAC. + ! FLMIN REAL ABSOLUTE MINIMUM VALUE + ! OF EACH SPECTRAL COMPONENTS. + ! CITHRSH REAL SEA ICE TRESHOLD, ALL SEA POINTS WITH CICOVER > CITHRSH + ! WILL BE SET TO MISSING + ! WHEN LMASKICE IS TRUE IT IS DONE AT ALL TIME STEP + ! WHEN IT IS FALSE IT IS !ONLY! DONE FOR THE OUTPUT OF + ! THE WAVE INTEGRATED PARAMETERS. + ! CIBLOCK REAL IF LMASKICE : FULL BLOCKING SEA ICE TRESHOLD, ALL SEA POINTS WITH CICOVER > CIBLOCK + ! AND THRESHOLD OVER WHICH FIELDS THAT ARE EXCHANGED WITH THE ATMOSPHERE AND THE OCEAN + ! ARE RESET. + ! CITHRSH_SAT REAL SEA ICE TRESHOLD FOR DATA ASSIMILATION, WHICH WILL ONLY BE DONE FOR + ! ALL SEA POINTS WITH CICOVER < CITHRSH_SAT + ! CITHRSH_TAIL REAL SEA ICE TRESHOLD FOR IMPOSITION OF SPECTRAL TAIL, + ! FOR ALL SEA POINTS WITH CICOVER < CITHRSH_TAIL + ! CDICWA REAL DRAG COEFFICIENT ICE-WATER. + ! TICMIN REAL MINIMUM WAVE PERIOD IN TABLE CIDEAC. + ! HICMIN REAL MINIMUM ICE THICKNESS IN TABLE CIDEAC. + ! DTIC REAL WAVE PERIOD INCREMENT IN TABLE CIDEAC. + ! DHIC REAL ICE THICKNESS INCREMENT IN TABLE CIDEAC. + ! CIDEAC REAL SEA ICE DIMENSIONLESS ENERGY ATTENUATION COEFFICIENT TABLE. + ! LICERUN LOGICAL SET TO TRUE IF SEA ICE IS TAKEN INTO ACCOUNT. + ! LICETH LOGICAL SET TO TRUE IF SEA ICE THICKNESS IS PART OF THE INPUT DATA. + ! LMASKICE LOGICAL SET TO TRUE IF ICE MASK IS APPLIED (SEE CITHRSH) + ! NOTE THAT THE MASK IS ALWAYS APPLIED FOR SATELLITE + ! DATA PROCESSING AS WELL AS FOR CHARNOCK THAT + ! IS RETURNED TO THE IFS. + ! LWAMRSETCI LOGICAL SET TO TRUE IF FIELDS THAT ARE EXCHANGED WITH THE ATMOSPHERE AND THE OCEAN + ! ARE RESET TO WHAT WOULD BE USED IF THERE WERE NO WAVE MODELS. + ! LCIWABR LOGICAL SET TO TRUE IF SEA ICE BOTTOM FRICTION ATTENUATION IS USED. + !-------------------------------------------------------------------- +!$acc declare create( LCIWABR ) +!$acc declare create( LMASKICE ) +!$acc declare create( CDICWA ) +!$acc declare create( CIBLOCK ) +!$acc declare create( CITHRSH_TAIL ) +!$acc declare create( LICERUN ) +!$acc declare create( LWAMRSETCI ) +!$acc declare create( CITHRSH ) +END MODULE YOWICE diff --git a/src/phys-scc-cuda/yowindn.c_hoist.F90 b/src/phys-scc-cuda/yowindn.c_hoist.F90 new file mode 100644 index 00000000..36e9861e --- /dev/null +++ b/src/phys-scc-cuda/yowindn.c_hoist.F90 @@ -0,0 +1,130 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWINDN + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + !* ** *INDNL* - INDICES AND WEIGHTS USED IN THE COMPUTATION + ! OF THE NONLINEAR TRANSFER RATE. + + INTEGER(KIND=JWIM), PARAMETER :: NINL = 5 + INTEGER(KIND=JWIM), PARAMETER :: NRNL = 25 + INTEGER(KIND=JWIM) :: KFRH + INTEGER(KIND=JWIM) :: MFRSTLW + INTEGER(KIND=JWIM) :: MLSTHG + +!$loki dimension( MFRSTLW:MLSTHG ) + INTEGER(KIND=JWIM), ALLOCATABLE :: IKP(:) +!$loki dimension( MFRSTLW:MLSTHG ) + INTEGER(KIND=JWIM), ALLOCATABLE :: IKP1(:) +!$loki dimension( MFRSTLW:MLSTHG ) + INTEGER(KIND=JWIM), ALLOCATABLE :: IKM(:) +!$loki dimension( MFRSTLW:MLSTHG ) + INTEGER(KIND=JWIM), ALLOCATABLE :: IKM1(:) +!$loki dimension( NANG,2 ) + INTEGER(KIND=JWIM), ALLOCATABLE :: K1W(:, :) +!$loki dimension( NANG,2 ) + INTEGER(KIND=JWIM), ALLOCATABLE :: K2W(:, :) +!$loki dimension( NANG,2 ) + INTEGER(KIND=JWIM), ALLOCATABLE :: K11W(:, :) +!$loki dimension( NANG,2 ) + INTEGER(KIND=JWIM), ALLOCATABLE :: K21W(:, :) +!$loki dimension( NINL,1:MLSTHG ) + INTEGER(KIND=JWIM), ALLOCATABLE :: INLCOEF(:, :) + +!$loki dimension( MFRSTLW:MLSTHG ) + REAL(KIND=JWRB), ALLOCATABLE :: AF11(:) +!$loki dimension( MFRSTLW:MLSTHG ) + REAL(KIND=JWRB), ALLOCATABLE :: FKLAP(:) +!$loki dimension( MFRSTLW:MLSTHG ) + REAL(KIND=JWRB), ALLOCATABLE :: FKLAP1(:) +!$loki dimension( MFRSTLW:MLSTHG ) + REAL(KIND=JWRB), ALLOCATABLE :: FKLAM(:) +!$loki dimension( MFRSTLW:MLSTHG ) + REAL(KIND=JWRB), ALLOCATABLE :: FKLAM1(:) + REAL(KIND=JWRB) :: ACL1 + REAL(KIND=JWRB) :: ACL2 + REAL(KIND=JWRB) :: CL11 + REAL(KIND=JWRB) :: CL21 + REAL(KIND=JWRB) :: DAL1 + REAL(KIND=JWRB) :: DAL2 +!$loki dimension( KFRH ) + REAL(KIND=JWRB), ALLOCATABLE :: FRH(:) +!$loki dimension( MFRSTLW:1 ) + REAL(KIND=JWRB), ALLOCATABLE :: FTRF(:) +!$loki dimension( NRNL,1:MLSTHG ) + REAL(KIND=JWRB), ALLOCATABLE :: RNLCOEF(:, :) + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- ------- + ! *NINL* INTEGER SIZE OF INLCOEF + ! *NRNL* INTEGER SIZE OF RNLCOEF + ! *KFRH* INTEGER SIZE OF FRH + ! *MFRSTLW* INTEGER INDEX OF FIRST EXTRA LOW FREQUENCY FOR SNL + ! *MLSTHG* INTEGER INDEX OF LAST EXTRA HIGH FREQUENCY FOR SNL + ! *IKP* INTEGER FREQUENCY INDEX ARRAY FOR STORING ENERGY + ! TRANSFER INCREMENTS INTO BINS, WAVE NO. 3. + ! *IKP1* INTEGER IKP+1. + ! *IKM* INTEGER FREQUENCY INDEX ARRAY FOR STORING ENERGY + ! TRANSFER INCREMENTS INTO BINS, WAVE NO. 4. + ! *IKM1* INTEGER IKM+1 + ! *K1W* INTEGER ANGULAR INDEX ARRAY FOR STORING ENERGY + ! TRANSFER INCREMENTS INTO BINS, WAVE NO. 3. + ! *K11W* INTEGER K1W(.,1)-1, K1W(.,2)+1. + ! *K2W* INTEGER ANGULAR INDEX ARRAY FOR STORING ENERGY + ! TRANSFER INCREMENTS INTO BINS, WAVE NO. 4. + ! *K21W* INTEGER K2W(.,1)+1, K2W(.,2)-1. + ! *INLCOEF* INTEGER ARRAY USED TO STORE ALL FREQUENCY DEPENDENT + ! INDICES FOUND IN SNONLIN + ! *AF11* REAL WEIGHTS FOR DISCRETE APPROXIMATION OF NONL + ! TRANSFER (AT PRESENT ONE TERM ONLY SET TO + ! 3000). MULTIPLIED BY FREQUENCIES **11. + ! *FKLAP* REAL WEIGHT IN FREQUENCY GRID FOR INTERPOLATION, + ! WAVE NO. 3 ("1+LAMBDA" TERM). + ! *FKLAP1* REAL 1-FKLAP. + ! *FKLAM* REAL WEIGHT IN FREQUENCY GRID FOR INTERPOLATION, + ! WAVE NO. 4 ("1-LAMBDA" TERM). + ! *ACL1* REAL WEIGHT IN ANGULAR GRID FOR INTERPOLATION, + ! WAVE NO. 3 ("1+LAMBDA" TERM). + ! *ACL2* REAL WEIGHT IN ANGULAR GRID FOR INTERPOLATION, + ! WAVE NO. 4 ("1-LAMBDA" TERM). + ! *CL11* REAL 1.-ACL1. + ! *CL21* REAL 1.-ACL2. + ! *DAL1* REAL 1./ACL1. + ! *DAL2* REAL 1./ACL2. + ! *FRH* REAL TAIL FREQUENCY RATION **5 + ! *FTRF* REAL FRONT TAIL REDUCTIOn FACTOR USED TO A SPECTRAL + ! TAIL IN FRONT OF THE FIRST DISCRETISED FREQUENCY + ! *RNLCOEF* REAL ARRAY USED TO STORE ALL FREQUENCY DEPENDENT + ! COEFFICIENT FOUND IN SNONLIN + + ! ---------------------------------------------------------------------- +!$acc declare create( IKP ) +!$acc declare create( IKP1 ) +!$acc declare create( IKM ) +!$acc declare create( IKM1 ) +!$acc declare create( K1W ) +!$acc declare create( K2W ) +!$acc declare create( K11W ) +!$acc declare create( K21W ) +!$acc declare create( AF11 ) +!$acc declare create( FKLAP ) +!$acc declare create( FKLAP1 ) +!$acc declare create( FKLAM ) +!$acc declare create( FKLAM1 ) +!$acc declare create( DAL1 ) +!$acc declare create( DAL2 ) +!$acc declare create( MFRSTLW ) +!$acc declare create( MLSTHG ) +!$acc declare create( KFRH ) +!$acc declare create( INLCOEF ) +!$acc declare create( RNLCOEF ) +END MODULE YOWINDN diff --git a/src/phys-scc-cuda/yowparam.c_hoist.F90 b/src/phys-scc-cuda/yowparam.c_hoist.F90 new file mode 100644 index 00000000..b7c214b1 --- /dev/null +++ b/src/phys-scc-cuda/yowparam.c_hoist.F90 @@ -0,0 +1,101 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWPARAM + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + INTEGER(KIND=JWIM), PARAMETER :: IMDLGRDID = 218 + INTEGER(KIND=JWIM), PARAMETER :: KWAMVER = 8 + INTEGER(KIND=JWIM), PARAMETER :: NANG_PARAM = 36 + + !* ** *PARAM* GENERAL GRID SIZE INFORMATION. + + INTEGER(KIND=JWIM) :: NANG + INTEGER(KIND=JWIM) :: NFRE + INTEGER(KIND=JWIM) :: NFRE_RED + INTEGER(KIND=JWIM) :: NFRE_ODD + INTEGER(KIND=JWIM) :: NGX + INTEGER(KIND=JWIM) :: NGY + INTEGER(KIND=JWIM) :: NIBLO + INTEGER(KIND=JWIM) :: NOVER + INTEGER(KIND=JWIM) :: NIBL1 + INTEGER(KIND=JWIM) :: NIBLD + INTEGER(KIND=JWIM) :: NIBLC + + REAL(KIND=JWRB) :: SWAMPWIND + REAL(KIND=JWRB) :: SWAMPWIND2 + REAL(KIND=JWRB) :: DTNEWWIND + REAL(KIND=JWRB) :: SWAMPCIFR + REAL(KIND=JWRB) :: SWAMPCITH + + CHARACTER(LEN=1) :: CLDOMAIN + + LOGICAL :: LTURN90 + LOGICAL :: LL1D + LOGICAL :: LWDINTS + + ! Moved here from yowunpool + LOGICAL :: LLUNSTR + LOGICAL :: LLR8TOR4 = .false. + ! Is input in fact legacy REAL*8 & NKIND == 4 ? + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *IMDLGRDID* INTEGER MODEL GRID IDENTIFICATION NUMBER. + ! IT SHOULD BE UPDATED ONLY IF NEW gridglou + ! AND ubufglou FILES ARE PRODUCED!!!! + ! *KWAMVER* INTEGER WAM SOFTWARE VERSION NUMBER. + ! *NANG* INTEGER NUMBER OF ANGLES. + ! *NFRE* INTEGER NUMBER OF FREQUENCIES FOR THE PHYSICS. + ! *NFRE_RED* INTEGER REDUCED NUMBER OF FREQUENCIES FOR THE PROPAGATION AND IO + ! BY DEFAULT = NFRE + ! *NFRE_ODD* INTEGER NFRE-1 IF NFRE EVEN, BUT NFRE IS NFRE ODD + ! *NGX* INTEGER NUMBER OF LONGITUDES IN GRID. + ! *NGY* INTEGER NUMBER OF LATITUDES IN GRID. + ! *NIBLO* INTEGER NUMBER OF SEA POINTS IN BLOCK. + ! *NOVER* INTEGER MAXIMUM NUMBER POINTS IN FIRST LATITUDE + ! OF BLOCKS. + ! *NIBL1* INTEGER = NIBLO IF MULTI BLOCK VERSION. + ! = 1 IF ONE BLOCK VERSION. + ! *NIBLD* INTEGER = NIBLO IF DEPTH OR CURRENT REFRACTION. + ! = 1 ELSE. + ! *NIBLC* INTEGER = NIBLO IF CURRENT REFRACTION. + ! = 1 ELSE. + ! *SWAMPWIND* REAL CONSTANT WIND SPEED USED TO RUN SWAMP CASE. + ! FIRST VALUE + ! *SWAMPWIND2*REAL CONSTANT WIND SPEED USED TO RUN SWAMP CASE. + ! SECOND VALUE PROVIDED IT'S NOT ZERO + ! *DTNEWWIND* REAL TIME AFTER WHICH SWAMPWIND2 IS APPLIED + ! IN HOURS + ! *SWAMPCIFR* REAL SEA ICE COVER FOR THE NORTHERN HALF OF THE SWAMP DOMAIN + ! *SWAMPCITH* REAL SEA ICE THICKNESS FOR THE NORTHERN HALF OF THE SWAMP DOMAIN + ! *LTURN90* LOGICAL IF TRUE THE NEW SWAMP WIND WILL BE TURNED + ! BY 90 DEGREES. + ! *LWDINTS* LOGICAL IF TRUE A FILE CONTAINING WIND SPEED (m/s) AND DIRECTION + ! (in degrees following the meteorological convention) + ! TIME SERIES WILL BY USED TO SET THE WIND FORCING + ! OVER THE ALL DOMAIN. + ! THE PRESENCE OF THE FILE, windforcing_time_series + ! WILL DETERMINE WHETHER OR NOT LWDINTS IS TRUE OR NOT + ! *CLDOMAIN* CHARACTER DEFINES THE DOMAIN OF THE MODEL (for the + ! FDB and for selection of some variables) + ! *LL1D* LOGICAL IF TRUE THEN THE DOMAIN DECOMPOSITION IS ONLY + ! DONE IN LATITUNAL BANDS + ! (like it used to be done). + ! ---------------------------------------------------------------------- +!$acc declare create( nang ) +!$acc declare create( nfre_red ) +!$acc declare create( ngy ) +!$acc declare create( niblo ) +!$acc declare create( LLUNSTR ) +!$acc declare create( NFRE_ODD ) +!$acc declare create( NFRE ) +END MODULE YOWPARAM diff --git a/src/phys-scc-cuda/yowpcons.c_hoist.F90 b/src/phys-scc-cuda/yowpcons.c_hoist.F90 new file mode 100644 index 00000000..05f9d91e --- /dev/null +++ b/src/phys-scc-cuda/yowpcons.c_hoist.F90 @@ -0,0 +1,133 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWPCONS + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + !* *PARAMETER* OF GLOBAL CONSTANTS. + ! THE NON PARAMETRIC CONSTANTS WILL BE RESET BY CALLING INIWCST !!!! + + REAL(KIND=JWRB) :: G = 9.806_JWRB + REAL(KIND=JWRB) :: GM1 = 0.101978381_JWRB + REAL(KIND=JWRB), PARAMETER :: OLDPI = 3.1415927_JWRB + REAL(KIND=JWRB) :: PI = OLDPI + REAL(KIND=JWRB), PARAMETER :: CIRC = 40000000.0_JWRB + REAL(KIND=JWRB) :: ZPI = 6.2831854_JWRB + REAL(KIND=JWRB) :: THREEZPI = 18.849555922_JWRB + REAL(KIND=JWRB) :: ZPI4GM1 = 158.93794172_JWRB + REAL(KIND=JWRB) :: ZPI4GM2 = 16.208233910_JWRB + REAL(KIND=JWRB) :: ZPISQRT = 1.7724539_JWRB + REAL(KIND=JWRB) :: ZCONST = 0.0281349_JWRB + REAL(KIND=JWRB) :: RAD = 0.017453293_JWRB + REAL(KIND=JWRB) :: DEG = 57.295778667_JWRB + REAL(KIND=JWRB) :: R = 6366198.0_JWRB + REAL(KIND=JWRB), PARAMETER :: EPSMIN = 0.1E-32_JWRB + REAL(KIND=JWRB), PARAMETER :: DKMAX = 40.0_JWRB + REAL(KIND=JWRB), PARAMETER :: TAUOCMIN = 0.01_JWRB + REAL(KIND=JWRB), PARAMETER :: TAUOCMAX = 50.0_JWRB + REAL(KIND=JWRB), PARAMETER :: PHIEPSMIN = -3276.80_JWRB + REAL(KIND=JWRB), PARAMETER :: PHIEPSMAX = -0.05_JWRB + REAL(KIND=JWRB), PARAMETER :: WSEMEAN_MIN = 0.001_JWRB + REAL(KIND=JWRB) :: ZMISS = -999.0_JWRB + REAL(KIND=JWRB), PARAMETER :: ROAIR = 1.225_JWRB + REAL(KIND=JWRB), PARAMETER :: ROWATER = 1000.0_JWRB + REAL(KIND=JWRB), PARAMETER :: ROWATERM1 = 1.0_JWRB / ROWATER + REAL(KIND=JWRB), PARAMETER :: YEPS = ROAIR / ROWATER + REAL(KIND=JWRB), PARAMETER :: YINVEPS = 1.0_JWRB / YEPS + REAL(KIND=JWRB), PARAMETER :: GAM_SURF = 0.0717_JWRB + !!!! will need to be adapted if you change ROWATER + REAL(KIND=JWRB), PARAMETER :: SURFT = GAM_SURF / ROWATER + REAL(KIND=JWRB) :: SQRTGOSURFT + !! SQRT(G/SURFT) (see wavemdl) + REAL(KIND=JWRB), PARAMETER :: WSTAR0 = 0.0_JWRB + REAL(KIND=JWRB), PARAMETER :: Rconstant = 287.16_JWRB + ! The gas constant + REAL(KIND=JWRB), PARAMETER :: EpsWaterVapor = 0.61_JWRB + ! The mass ratio of water vapor to dry air + REAL(KIND=JWRB), PARAMETER :: EPSUS = 1.0E-6_JWRB + REAL(KIND=JWRB), PARAMETER :: EPSU10 = SQRT(1.0E-3_JWRB) + + REAL(KIND=JWRB), PARAMETER :: ACD = 8.0E-4_JWRB + REAL(KIND=JWRB), PARAMETER :: BCD = 8.0E-5_JWRB + + REAL(KIND=JWRB), PARAMETER :: ACDLIN = 0.0008_JWRB + REAL(KIND=JWRB), PARAMETER :: BCDLIN = 0.00047_JWRB + + REAL(KIND=JWRB), PARAMETER :: C1CD = 1.03E-3_JWRB + REAL(KIND=JWRB), PARAMETER :: C2CD = 0.04E-3_JWRB + REAL(KIND=JWRB), PARAMETER :: P1CD = 1.48_JWRB + REAL(KIND=JWRB), PARAMETER :: P2CD = -0.21_JWRB + + REAL(KIND=JWRB), PARAMETER :: CDMAX = 0.0025_JWRB + + REAL(KIND=JWRB), PARAMETER :: FM2FP = 0.9_JWRB + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *G* REAL ACCELLERATION OF GRAVITY. + ! *GM1* REAL 1/G. + ! *OLDPI* REAL OLD VALUE USED FOR PI (PRIOR TO CY21R3). + ! *PI* REAL PI (See SUB. INIWCST). + ! *CIRC* REAL EARTH CIRCUMFERENCE (METRES). + ! *RAD* REAL PI / 180. + ! *DEG* REAL 180. / PI. + ! *ZPI* REAL 2. * PI. + ! *ZPI4GM1* REAL ZPI**4/G* + ! *ZPI4GM2* REAL ZPI**4/G**2 + ! *ZPISQRT* REAL SQRT(PI) + ! *ZCONST* REAL 1./(8.*PI*SQRT(2.)) + ! *R* REAL EARTH RADIUS (METRES). + ! *EPSMIN* REAL SMALL NUMBER + ! *DKMAX* REAL MAXIMUM VALUE OF DEPTH*WAVENUMBER BEFORE + ! SIMPLIFYING TO DEEP WATER EXPRESIONS. + ! *BF2MAX* REAL MAXIMUM VALUE ALLOWED FOR BFI SQUARED + ! *BF2MIN* REAL MINIMUM VALUE ALLOWED FOR BFI SQUARED + ! *C4MAX* REAL MAXIMUM VALUE ALLOWED FOR KURTOSIS + ! *C4MIN* REAL MINIMUM VALUE ALLOWED FOR KUTOSIS + ! *PHIEPSMIN* REAL MINIMUM VALUE ALLOWED FOR NORMALISED ENERGY FLUX INTO OCEAN + ! *PHIEPSMAX* REAL MAXIMUM VALUE ALLOWED FOR NORMALISED ENERGY FLUX INTO OCEAN + ! *WSEMEAN_MIN* REAL MINIMUM VALUE ALLOWED FOR WSEMEAN + ! *ZMISS* REAL MISSING DATA INDICATOR + ! (SET IN CHIEF OR VIA THE IFS). + ! *ROAIR* REAL AIR DENSITY. + ! *ROWATER* REAL WATER DENSITY. + ! *ROWATERM1* REAL 1 /(WATER DENSITY). + ! *GAM_SURF* REAL SURFACE TENSION (in N/m) + ! *SURFT* REAL SURFACE TENSION divided by water density (in m**3 s**-2) + ! *YEPS* REAL ROAIR/ROWATER. + ! *YINVEPS* REAL 1./YEPS. + ! *WSTAR0* REAL DEFAULT VALUE FOR w*. + ! *EPSUS* REAL SMALL NUMBER ADDED TO THE SQUARE OF USTAR + ! WHEN COMPUTING CD OR THE CHARNOCK COEF. + ! *EPSU10* REAL SMALL NUMBER TO INSURE U10 IS NEVER 0 + + ! *ACD* REAL COEFFICIENTS FOR SIMPLE CD(U10) RELATION + ! *BCD* REAL CD = ACD + BCD*U10 + + ! *ACDLIN* REAL COEFFICIENTS FOR SIMPLE LINEARISED CD(U10,CHARNOCK) RELATION + ! *BCDLIN* REAL CD = ACDLIN + BCDLIN*SQRT(CHARNOCK) * U10 + + ! USE HERSBACH 2011 FOR CD(U10) (SEE ALSO EDSON et al. 2013) + ! C_D = (C1CD + C2CD*U10**P1CD)*U10**P2CD + + ! *CDMAX* REAL MAXIMUM CD ALLOWED FOR ALL CD(U10) RELATIONS + + ! *FM2FP* REAL EMPIRICAL FACTOR FOR THE CONVERSION OF WINDSEA MEAN FREQUENCY + ! TO WINDSEA PEAK FREQUENCY. + !---------------------------------------------------------------------- + +!$acc declare create( GM1 ) +!$acc declare create( ZPI ) +!$acc declare create( ZPI4GM1 ) +!$acc declare create( ZPI4GM2 ) +!$acc declare create( G ) +!$acc declare create( SQRTGOSURFT ) +END MODULE YOWPCONS diff --git a/src/phys-scc-cuda/yowphys.c_hoist.F90 b/src/phys-scc-cuda/yowphys.c_hoist.F90 new file mode 100644 index 00000000..9a260bd3 --- /dev/null +++ b/src/phys-scc-cuda/yowphys.c_hoist.F90 @@ -0,0 +1,195 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWPHYS + + !* ** *YOWPHYS* - PARAMETERS FOR WAVE PHYSICS PARAMETERISATION + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + ! *XKAPPA* VON KARMAN CONSTANT. + REAL(KIND=JWRB), PARAMETER :: XKAPPA = 0.40_JWRB + ! *XNLEV* REAL WIND SPEED REFERENCE HEIGHT + REAL(KIND=JWRB), PARAMETER :: XNLEV = 10.0_JWRB + ! *RNU* KINEMATIC AIR VISCOSITY (when coupled get from the atmospheric model) + REAL(KIND=JWRB) :: RNU + ! *RNUM* REDUCED KINEMATIC AIR VISCOSITY FOR MOMENTUM TRANSFER (as RNU) + REAL(KIND=JWRB) :: RNUM + ! *PRCHAR* DEFAULT VALUE FOR CHARNOCK + REAL(KIND=JWRB) :: PRCHAR + + + + ! WIND INPUT :: + ! ========== + ! *BETAMAX* PARAMETER FOR WIND INPUT. + REAL(KIND=JWRB) :: BETAMAX + + ! *BETAMAXOXKAPPA2* BETAMAX/XKAPPA**2 + REAL(KIND=JWRB) :: BETAMAXOXKAPPA2 + + ! *BMAXOKAP* DELTA_THETA_RN * BETAMAXOXKAPPA2 /XKAPPA + REAL(KIND=JWRB) :: BMAXOKAP + + ! *BMAXOKAPDTH* BMAXOKAP * DELTH + REAL(KIND=JWRB) :: BMAXOKAPDTH + + ! *GAMNCONST* DELTA_THETA*0.5_JWRB*ZPI**4*GM1*3*BETAMAXOXKAPPA2/XKAPPA + REAL(KIND=JWRB) :: GAMNCONST + + ! *ZALP* SHIFTS GROWTH CURVE. + REAL(KIND=JWRB) :: ZALP + + ! *ALPHA* MINIMUM CHARNOCK CONSTANT WITH NO WAVES. + REAL(KIND=JWRB) :: ALPHA + REAL(KIND=JWRB) :: ALPHAMIN + ! MAXIMUM CHARNOCK + REAL(KIND=JWRB), PARAMETER :: ALPHAMAX = 0.11_JWRB + + ! *CHNKMIN_U* WIND THRESHOLD USED TO REDUCED MIN CHARNOCK (see *CHNKMIN*) + REAL(KIND=JWRB) :: CHNKMIN_U + + ! *TAUWSHELTER* SHELTERING COEFFICIENT in Ardhuin et al. PHYSICS + REAL(KIND=JWRB) :: TAUWSHELTER + + ! MAXIMUM PHILLIPS PARAMETER USED TO CONTROL MAXIMUM STEEPNESS + REAL(KIND=JWRB) :: ALPHAPMAX + + ! MINIMUM PHILLIPS PARAMETER ALLOWED : ALPHAPMINFAC/WAVE_AGE + REAL(KIND=JWRB), PARAMETER :: ALPHAPMINFAC = 0.1_JWRB + REAL(KIND=JWRB) :: FLMINFAC + + ! DIRECTIONALITY CORRECTION FACTORS IN THE GOWTH RATE RENORMALISATION (SEE JANSSEN ECMWF TECH MEMO 845) + REAL(KIND=JWRB) :: DELTA_THETA_RN + REAL(KIND=JWRB) :: RN1_RN + ! if LLCAPCHNK, DELTA_THETA_RN is enhanced by factor 1+DTHRN_A*(1+TANH(U10-DTHRN_U)) + ! This is intended to model the impact of unrepresented effects on the drag for very high winds + ! (i.e. spray, foam, etc...) + REAL(KIND=JWRB) :: DTHRN_A + REAL(KIND=JWRB) :: DTHRN_U + + ! COMPUTE LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM. + ! FREQUENCIES LE MAX(TAILFACTOR*MAX(FMNWS,FM),TAILFACTOR_PM*FPM), + ! WHERE FPM IS THE PIERSON-MOSKOWITZ FREQUENCY BASED ON FRICTION + ! VELOCITY. (FPM=G/(FRIC*ZPI*USTAR)) + REAL(KIND=JWRB) :: TAILFACTOR + REAL(KIND=JWRB) :: TAILFACTOR_PM + + ! FOR THE GRAVITY-CAPILLARY MODEL, ONE NEEDS TO SPECIFY ANGULAR ADJUSTMENT ANG_GC (SEE *SETWAVPHYS*) + ! ANG_GC = ANG_GC_A + ANG_GC_B * TANH(ANG_GC_C * USTAR**2) + REAL(KIND=JWRB) :: ANG_GC_A, ANG_GC_B, ANG_GC_C + + ! Negative wind input, ARDHUIN et al. 2010: + REAL(KIND=JWRB), PARAMETER :: SWELLF = 0.66_JWRB + ! controls the turbulent swell dissipation + REAL(KIND=JWRB), PARAMETER :: SWELLF2 = -0.018_JWRB + REAL(KIND=JWRB), PARAMETER :: SWELLF3 = 0.022_JWRB + REAL(KIND=JWRB), PARAMETER :: SWELLF4 = 1.5E05_JWRB + REAL(KIND=JWRB) :: SWELLF5 + ! controls the viscous swell dissipation + REAL(KIND=JWRB), PARAMETER :: SWELLF6 = 1.0_JWRB + REAL(KIND=JWRB), PARAMETER :: SWELLF7 = 3.6E05_JWRB + REAL(KIND=JWRB), PARAMETER :: SWELLF7M1 = 1.0_JWRB / SWELLF7 + !!!! set it to 1 if you decide to have SWELLF7=0 + REAL(KIND=JWRB) :: Z0RAT + REAL(KIND=JWRB) :: Z0TUBMAX + + REAL(KIND=JWRB), PARAMETER :: ABMIN = 0.3_JWRB + REAL(KIND=JWRB), PARAMETER :: ABMAX = 8.0_JWRB + + + ! WHITECAP DISSIPATION :: + ! ==================== + + + ! Whitecap dissipation WAM cycle 4: + + REAL(KIND=JWRB) :: CDIS + REAL(KIND=JWRB) :: DELTA_SDIS + REAL(KIND=JWRB) :: CDISVIS + + + ! Whitecap dissipation, ARDHUIN et al. 2010: + ! TEST 473: + ! Br: + REAL(KIND=JWRB), PARAMETER :: SDSBR = 9.0E-4_JWRB + + ! Saturation dissipation coefficient + INTEGER(KIND=JWIM), PARAMETER :: ISDSDTH = 80_JWIM + INTEGER(KIND=JWIM), PARAMETER :: ISB = 2_JWIM + INTEGER(KIND=JWIM), PARAMETER :: IPSAT = 2_JWIM + + REAL(KIND=JWRB), PARAMETER :: SSDSC2 = -2.2E-5_JWRB + REAL(KIND=JWRB), PARAMETER :: SSDSC4 = 1.0_JWRB + REAL(KIND=JWRB), PARAMETER :: SSDSC6 = 0.3_JWRB + REAL(KIND=JWRB), PARAMETER :: MICHE = 1.0_JWRB + + + ! Cumulative dissipation coefficient + !!! REAL(KIND=JWRB), PARAMETER :: SSDSC3 = -0.40344_JWRB + !!! This is quite an expensive computation. Setting it to 0 will disable its calculation. + !!! It was found that if the high frequency tail is prescribed (see frcutindex), + !!! then the results are very similar. + !!! Converserly, it will be required, in particular for the wave modified fluxes to NEMO + !!! when the high frequency tail is not prescribed and used in all calculation + REAL(KIND=JWRB), PARAMETER :: SSDSC3 = 0.0_JWRB + REAL(KIND=JWRB), PARAMETER :: SSDSBRF1 = 0.5_JWRB + ! 28.16 = 22.0 * 1.6² * 1/2 with + ! 22.0 (Banner & al. 2000, figure 6) + ! 1.6 the coefficient that transforms SQRT(B) to Banner et al. (2000)'s epsilon + ! 1/2 factor to correct overestimation of Banner et al. (2000)'s breaking probability due to zero-crossing analysis + REAL(KIND=JWRB), PARAMETER :: BRKPBCOEF = 28.16_JWRB + + ! Wave-turbulence interaction coefficient + REAL(KIND=JWRB), PARAMETER :: SSDSC5 = 0.0_JWRB + + ! NSDSNTH is the number of directions on both used to compute the spectral saturation + INTEGER(KIND=JWIM) :: NSDSNTH + ! NDIKCUMUL is the integer difference in frequency bands + INTEGER(KIND=JWIM) :: NDIKCUMUL + +!$loki dimension( NANG,NSDSNTH*2+1 ) + INTEGER(KIND=JWIM), ALLOCATABLE :: INDICESSAT(:, :) +!$loki dimension( NANG,NSDSNTH*2+1 ) + REAL(KIND=JWRB), ALLOCATABLE :: SATWEIGHTS(:, :) +!$loki dimension( NDEPTH,0:NANG/2,NFRE,NFRE ) + REAL(KIND=JWRB), ALLOCATABLE :: CUMULW(:, :, :, :) + ! ---------------------------------------------------------------------- +!$acc declare create( DTHRN_A ) +!$acc declare create( DTHRN_U ) +!$acc declare create( ALPHAPMAX ) +!$acc declare create( TAILFACTOR ) +!$acc declare create( TAILFACTOR_PM ) +!$acc declare create( CDIS ) +!$acc declare create( DELTA_SDIS ) +!$acc declare create( CDISVIS ) +!$acc declare create( NSDSNTH ) +!$acc declare create( NDIKCUMUL ) +!$acc declare create( INDICESSAT ) +!$acc declare create( SATWEIGHTS ) +!$acc declare create( CUMULW ) +!$acc declare create( ANG_GC_A ) +!$acc declare create( ANG_GC_B ) +!$acc declare create( ANG_GC_C ) +!$acc declare create( RNU ) +!$acc declare create( SWELLF5 ) +!$acc declare create( Z0RAT ) +!$acc declare create( Z0TUBMAX ) +!$acc declare create( TAUWSHELTER ) +!$acc declare create( GAMNCONST ) +!$acc declare create( ZALP ) +!$acc declare create( BETAMAXOXKAPPA2 ) +!$acc declare create( BMAXOKAP ) +!$acc declare create( RN1_RN ) +!$acc declare create( ALPHA ) +!$acc declare create( CHNKMIN_U ) +!$acc declare create( RNUM ) +!$acc declare create( ALPHAMIN ) +END MODULE YOWPHYS diff --git a/src/phys-scc-cuda/yowshal.c_hoist.F90 b/src/phys-scc-cuda/yowshal.c_hoist.F90 new file mode 100644 index 00000000..4d4559ef --- /dev/null +++ b/src/phys-scc-cuda/yowshal.c_hoist.F90 @@ -0,0 +1,69 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWSHAL + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + USE YOWDRVTYPE, ONLY: ENVIRONMENT, FREQUENCY + + IMPLICIT NONE + + !* ** *SHALLOW* SHALLOW WATER TABLES and FEATURES. + + INTEGER(KIND=JWIM) :: NDEPTH + + REAL(KIND=JWRB), PARAMETER :: GAM_B_J = 0.8_JWRB + REAL(KIND=JWRB), PARAMETER :: BATHYMAX = 999.0_JWRB + REAL(KIND=JWRB), PARAMETER :: XKDMIN = 0.75_JWRB + + REAL(KIND=JWRB) :: DEPTHA + REAL(KIND=JWRB) :: DEPTHD + REAL(KIND=JWRB) :: TOOSHALLOW + + REAL(KIND=JWRB), ALLOCATABLE :: DEPTH_INPUT(:) + !!! should be removed as soon as possible + + REAL(KIND=JWRB), ALLOCATABLE :: TCGOND(:, :) + REAL(KIND=JWRB), ALLOCATABLE :: TFAK(:, :) + REAL(KIND=JWRB), ALLOCATABLE :: TSIHKD(:, :) + REAL(KIND=JWRB), ALLOCATABLE :: TFAC_ST(:, :) + + !* ** GRID POINT FIELDS ** + TYPE(ENVIRONMENT) :: WVENVI + + !* ** GRID POINT AND FREQUENCY FIELDS ** + TYPE(FREQUENCY) :: WVPRPT + + !* ** FICTIOUS VALUE FOR LAND POINT (NSUP+1) + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *NDEPTH* INTEGER LENGTH OF SHALLOW WATER TABLES (see MTABS). + ! *GAM_B_J REAL FACTIO OF THE DEPTH THAT DETERMINES THE MAXIMUM SIGNIFICANT WAVE HEIGHT ALLOWED + ! *BATHYMAX* REAL MAXIMUM DEPTH, ASSUMED TO CORRESPOND TO DEEP WATER CONDITIONS + ! *XKDMIN* REAL MINIMUM VALUE FOR K*DEPTH IN NON-LINEAR EFFECT FOR FREAK WAVE SOFTWARE. + ! *DEPTHA* REAL MINIMUM DEPTH FOR TABLES (METRES). + ! *TOOSHALLOW REAL MINIMUM DEPTH THAT WILL BE ALLOWED + ! USED TO POINT TO LAND POINTS + ! *DEPTHD* REAL DEPTH INCREMENT (METRES). + ! *TCGOND* REAL SHALLOW WATER GROUP VELOCITY TABLE. + ! *TFAK* REAL WAVE NUMBER TABLE. + ! *TSIHKD* REAL TABLE FOR OMEGA/SINH(2KD). + ! *TFAC_ST* REAL TABLE FOR 2*G*K**2/(OMEGA*TANH(2KD)). + + !! GRID POINT FIELDS: + ! ----------------- + ! *WVENVI* ENVIRONMENT IN WHICH WAVES EVOLVE + + !! GRID POINT AND FREQUENCY FIELDS: + ! -------------------------------- + ! *WVPRPT* REAL WAVE PROPERTIES + + ! ---------------------------------------------------------------------- +!$acc declare create( NDEPTH ) +END MODULE YOWSHAL diff --git a/src/phys-scc-cuda/yowstat.c_hoist.F90 b/src/phys-scc-cuda/yowstat.c_hoist.F90 new file mode 100644 index 00000000..3777b96d --- /dev/null +++ b/src/phys-scc-cuda/yowstat.c_hoist.F90 @@ -0,0 +1,262 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWSTAT + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + !* ** *STATUS* - TIME STATUS OF INTEGRATION, WIND INPUT, + ! OUTPUT OF RESULTS, MODEL OPTIONS, + ! AND ALTIMETER DATA ASSIMILATION WINDOW. + + + CHARACTER(LEN=2) :: MARSTYPE + CHARACTER(LEN=2) :: YCLASS + CHARACTER(LEN=4) :: YEXPVER + + CHARACTER(LEN=14) :: CDATEA + CHARACTER(LEN=14) :: CDATEE + CHARACTER(LEN=14) :: CDATEF + CHARACTER(LEN=14) :: CDTPRO +!$loki dimension( NDELW_LST ) + CHARACTER(LEN=14), ALLOCATABLE :: CDTW_LST(:) + + CHARACTER(LEN=14) :: CDTRES + CHARACTER(LEN=14) :: CDTBC + CHARACTER(LEN=14) :: CDATER + CHARACTER(LEN=14) :: CDATES + CHARACTER(LEN=14) :: CDTINTT + CHARACTER(LEN=25) :: CMETER + CHARACTER(LEN=25) :: CEVENT + + INTEGER(KIND=JWIM) :: IFRELFMAX + REAL(KIND=JWRB) :: DELPRO_LF + INTEGER(KIND=JWIM) :: IDELPRO + INTEGER(KIND=JWIM) :: IDELT + INTEGER(KIND=JWIM) :: IDELWI +!$loki dimension( NDELW_LST ) + INTEGER(KIND=JWIM), ALLOCATABLE :: IDELWI_LST(:) + INTEGER(KIND=JWIM) :: IDELWO +!$loki dimension( NDELW_LST ) + INTEGER(KIND=JWIM), ALLOCATABLE :: IDELWO_LST(:) + INTEGER(KIND=JWIM) :: NDELW_LST + INTEGER(KIND=JWIM) :: IDELALT + INTEGER(KIND=JWIM) :: IREST + INTEGER(KIND=JWIM) :: IDELRES + INTEGER(KIND=JWIM) :: IDELBC + INTEGER(KIND=JWIM) :: IDELINT + INTEGER(KIND=JWIM) :: IDELINS + INTEGER(KIND=JWIM) :: IDELSPT + INTEGER(KIND=JWIM) :: IDELSPS + INTEGER(KIND=JWIM) :: ICASE + INTEGER(KIND=JWIM) :: ISHALLO + INTEGER(KIND=JWIM) :: ISNONLIN + INTEGER(KIND=JWIM) :: IPHYS + INTEGER(KIND=JWIM) :: IREFRA + INTEGER(KIND=JWIM) :: IPROPAGS = -1 + INTEGER(KIND=JWIM) :: IDAMPING + INTEGER(KIND=JWIM) :: IASSI + INTEGER(KIND=JWIM) :: IASSI_ORIG + INTEGER(KIND=JWIM) :: NENSFNB + INTEGER(KIND=JWIM) :: NTOTENS + INTEGER(KIND=JWIM) :: NSYSNB + INTEGER(KIND=JWIM) :: NMETNB + INTEGER(KIND=JWIM) :: ISTREAM + INTEGER(KIND=JWIM) :: NLOCGRB + INTEGER(KIND=JWIM) :: NCONSENSUS + INTEGER(KIND=JWIM) :: NDWD + INTEGER(KIND=JWIM) :: NMFR + INTEGER(KIND=JWIM) :: NNCEP + INTEGER(KIND=JWIM) :: NUKM + INTEGER(KIND=JWIM) :: IREFDATE + + LOGICAL :: LANAONLY + LOGICAL :: L4VTYPE + LOGICAL :: LFRSTFLD + LOGICAL :: LALTAS + LOGICAL :: LSARAS + LOGICAL :: LSARINV + LOGICAL :: LGUST + LOGICAL :: LADEN + LOGICAL :: LRELWIND + LOGICAL :: LSUBGRID + LOGICAL :: LBIWBK + LOGICAL :: LLSOURCE + LOGICAL :: LNSESTART + LOGICAL :: LSMSSIG_WAM + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *MARSTYPE* CHAR*2 CHARACTER STRING INDICATING THE CURRENT + ! STATUS OF THE MODEL. + ! *YCLASS* CHAR*2 CHARACTER STRING INDICATING THE CLASS OF + ! THE CURRENT RUN. + ! *YEXPVER* CHAR*4 CHARACTER STRING INDICATING THE EXPERIMENT + ! VERSION NUMBER OF THE CURRENT RUN. + + ! *CDATEA* CHAR*14 START DATE OF RUN (YYYYMMDDHHMMSS). + ! *CDATEE* CHAR*14 END DATE OF RUN (YYYYMMDDHHMMSS). + ! *CDATEF* CHAR*14 END DATE OF ANALYSIS RUN (YYYYMMDDHHMM). + ! *CDTPRO* CHAR*14 END DATE OF PROPAGATION. + ! *CDTW_LST* CHAR*14 LIST OF END DATES OF WIND INPUT TIMES. + ! MUST BE INPUT IN CHRONOLOGICAL ORDER !!! + ! *CDTRES* CHAR*14 NEXT DATE TO SAVE OUTPUT AND RESTART FILES. + ! *CDTBC* CHAR*14 NEXT DATE TO SAVE BC FILES. + ! *CDATER* CHAR*14 DATE FOR OUTPUT OF BOTH RESTART FILES + ! IF NOT SET (ie: BLANK LINE IN WAMINFO) + ! OR SET TO 00000000000000 THEN + ! OUTPUT WILL OCCUR AS SPECIFIED IN THE + ! INPUT FILE TO THE WAVE MODEL. + ! IF SET BUT NOT BETWEEN CDATEA AND CDATEE, + ! THEN IT WILL BE SET TO CDATEE. + ! *CDATES* CHAR*14 LAST DATE FOR OUTPUT OF RESTART FILES + ! IF NOT SET IT WILL BE SET BY DEFAULT TO + ! CDATEE + ! *CDTINTT* CHAR*14 NEXT DATE TO WRITE INTEG. PARAMETERS. + + ! *IFRELFMAX* INTEGER FREQUENCY INDEX FOR THE LOW FREQUENCY WAVES (see DELPRO_LF below) + ! *DELPRO_LF* REAL TIMESTEP WAM PROPAGATION IN SECONDS FOR LOW FREQUENCY WAVES (can be fraction od seconds) + ! FOR ALL WAVES WITH FREQUENCY <= FR(IFRELFMAX), IF IFRELFMAX>0 + ! !!! this option is only possible when no refraction effects are used (IREFRA=0) + ! !!! and only if IPROPAGS = 2 (I could not be bother to code if for the other options) + ! *IDELPRO* INTEGER TIMESTEP WAM PROPAGATION IN full SECONDS FOR ALL WAVES IF IFRELFMAX=0, + ! OR ALL WAVES WITH FREQUENCIES > FR(IFRELFMAX)a (see above). + ! *IDELT* INTEGER TIMESTEP SOURCE FUNCTION IN SECONDS. + ! *IDELWI* INTEGER INPUT WIND TIMESTEP PREWIND IN SECONDS. + ! *IDELWI_LST*INTEGER LIST OF IDELWI'S. (!!! ALWAYS IN SECONDS!!!) + ! *IDELWO* INTEGER OUTPUT WIND TIMESTEP IN SECONDS + ! EQUAL TO INPUT WIND TIMESTEP INTO WAMODEL. + ! *IDELWO_LST*INTEGER LIST OF IDELWO'S. (!!! ALWAYS IN SECONDS!!!) + ! *NDELW_LST* INTEGER NUMBER OF ENTRIES IN LISTS IDELWI_LST and + ! IDELWO_LST + ! *IDELALT* INTEGER LENGTH IN SECONDS OF THE CENTERED TIME + ! WINDOW FOR THE ALTIMETER DATA ASSIMILATION + ! AT EACH ASSIMILATION TIME. IF NOT + ! PRESCRIBED, IT WILL BE SET TO IDELWO. + ! *IREST* INTEGER RESTART FILE SAVE OPTION. + ! = 1 RESTART FILES ARE SAVED + ! = 2 RESTART FILES ARE SAVED IN SPLIT MODE + ! = 3 RESTART FILES ARE SAVED AND + ! PREALLOCATION OF THE OUTPUT FILE WHICH + ! IS SAVED TO A VFL FILE SYSTEM + ! = 4 RESTART FILES ARE SAVED IN SPLIT MODE + ! OF THE OUTPUT FILE WHICH IS SAVED TO + ! A VFL FILE SYSTEM + ! OTHERWISE RESTART FILES ARE NOT SAVED. + ! *IDELRES* INTEGER OUTPUT AND RESTART FILE DISPOSE TIMESTEP. + ! *IDELBC* INTEGER OUTPUT BC FILE DISPOSE TIMESTEP. + ! *IDELINT* INTEGER INTEG. PARAMETER (TOTAL SEA) OUTPUT + ! TIMESTEP IN SECONDS. + ! *IDELINS* INTEGER INTEG. PARAMETER (SEA + SWELL) OUTPUT + ! TIMESTEP IN SECONDS. + ! *IDELSPT* INTEGER SPECTRA (TOTAL) OUTPUT TIMESTEP IN SECONDS. + ! *IDELSPS* INTEGER SPECTRA (SEA + SWELL) OUTPUT + ! TIMESTEP IN SECONDS. + + ! *ICASE* INTEGER PROPAGATION FLAG + ! = 1 SPHERICAL COORDINATES + ! OTHERWISE CARTESIAN COORDINATES. + ! *ISHALLO* INTEGER SHALLOW WATER MODEL FLAG !!! no longer used. It is always shallow water option + ! = 1 DEEP WATER MODEL + ! OTHERWISE SHALLOW WATER MODEL. + ! *ISNONLIN* INTEGER SNONLIN FLAG + ! = 0 THE OLD FORMULATION IS USED. + ! *IREFRA* INTEGER REFRACTION OPTION.. + ! = 0 NO REFRACTION. + ! = 1 DEPTH REFRACTION ONLY. + ! = 2 CURRENT REFRACTION ONLY. + ! = 2 DEPTH AND CURRENT REFRACTION. + ! *IPROPAGS* INTEGER PROPAGATION SCHEME OPTION. + ! = 0 ORIGINAL FIRST ORDER SCHEME ON QUADRANT. + ! = 1 FIRST ORDER SCHEME ON TWO QUADRANTS + ! *IDAMPING* INTEGER WAVE DAMPING CONTROL + ! = 0 NO WAVE DAMPING + ! = 1 WAVE DAMPING IS ON. + ! *IASSI* INTEGER ASSIMILATION MODEL FLAG + ! = 1 ASSIMILATION IS DONE IF ANALYSIS RUN + ! OTHERWISE NO ASSIMILATION. + ! *NENSFNB* INTEGER ENSEMBLE FORECAST NUMBER (DEFAULT=0) + ! *NTOTENS* INTEGER TOTAL ENSEMBLE FORECAST MEMBERS (DEFAULT=0) + ! *NSYSNB* INTEGER SYSTEM NUMBER TO BE USED FOR GRIBBING OF + ! SEASONAL DATA (DEFAULT=-1). + ! *NMETNB* INTEGER METHOD NUMBER TO BE USED FOR GRIBBING OF + ! SEASONAL DATA (DEFAULT=-1). + ! *LANAONLY* LOGICAL CONTROLS WHETHER ANALYSIS IS RUN WITHOUT + ! PRIOR ADVECTION STEPS + ! *L4VTYPE* LOGICAL CONTROLS WHETHER MARS TYPE 4V IS USED + ! INSTEAD OF TYPE FG. + ! *LFRSTFLD* LOGICAL CONTROLS WHETHER INITIAL OUTPUT INTEGRATED + ! PARAMETERS ARE PRODUCED BASED ON THE INITIAL + ! CONDITIONS. IT WILL ONLY OUTPUT PARAMETERS + ! THAT ARE NOT USED AS INPUT (233, 245, 251) + ! OR CONNECTED TO THE ALTIMETER WAVE HEIGHT + ! CORRECTION (246, 247, 248). + ! *LALTAS* LOGICAL CONTROLS WHETHER ALTAS IS CALLED FOR THE + ! ASSIMILATION. + ! *LSARAS* LOGICAL CONTROLS WHETHER SARAS IS CALLED FOR THE + ! ASSIMILATION. + ! *LSARINV* LOGICAL CONTROLS WHETHER SARINVERT IS CALLED FOR + ! THE SAR INVERSION. + ! *ISTREAM* INTEGER STREAM NUMBER WHEN CODING DATA IN GRID + ! IF SET TO 0 IT WILL NOT BE USED AND + ! INSTEAD MARSTYPE WILL BVE USED TO DETERMINE + ! THE STREAM. + ! *LGUST* LOGICAL CONTROLS WHETHER WIND GUSTINESS EFFECT WILL + ! BE USED IN COMPUTATIONS + ! *LADEN* LOGICAL CONTROLS WHETHER COMPUTED AIR DENSITY WILL + ! BE USED IN COMPUTATIONS + ! *LRELWIND* LOGICAL CONTROLS WHETHER RELATIVE WINDS WITH RESPECT TO + ! SURFACE CURRENTS ARE USED OR NOT. + ! FOR COUPLED RUNS, THE WINDS PASSED By THE IFS + ! ARE ALREADY RELATIVE. ON THE OTHEr HAND, + ! STANDALONE MODE, THE INPUT WIND SHOULD BE IN + ! ABSOLUTE TERMS. + ! *LBIWBK* LOGICAL CONTROLS WHETHER BOTTOM INDUCED WAVE BREAKING + ! IS SHITCHED ON. + ! *LSUBGRID* LOGICAL CONTROLS WHETHER THE SUB-GRID SCALE + ! PARAMETRISATION IS USED OR RESET TO THE + ! IMPACT OF NOT HAVING SUB-GRID SCALE. + ! *LLSOURCE* LOGICAL CONTROLS WHETHER SOURCE TERM CONTRIBUTION IS + ! COMPUTED. + ! *LNSESTART* LOGICAL IF TRUE INITIAL CONDITIONS WILL BE SET TO + ! NOISE LEVEL. + ! *NLOCGRB* INTEGER LOCAL GRIB TABLE NUMBER. + ! *NCONCENSUS*INTEGER ONLY USED IN THE CONTEXT OF MULTI-ANALYSIS + ! ENSEMBLE FORECASTS. IT SPECIFIED WHETHER + ! ONE (NCONCENSUS=0) OR MORE ANALYSES ARE + ! USED IN THE INITIAL CONDITIONS. + ! *NDWD* INTEGER ONLY USED IN THE CONTEXT OF MULTI-ANALYSIS + ! ENSEMBLE FORECASTS. IT SPECIFIED WHETHER + ! DWD IS USED IN THE INITIAL CONDITIONS. + ! *NMFR* INTEGER ONLY USED IN THE CONTEXT OF MULTI-ANALYSIS + ! ENSEMBLE FORECASTS. IT SPECIFIED WHETHER + ! METEO FRANCE IS USED IN THE INITIAL + ! CONDITIONS. + ! *NNCEP* INTEGER ONLY USED IN THE CONTEXT OF MULTI-ANALYSIS + ! ENSEMBLE FORECASTS. IT SPECIFIED WHETHER + ! NCEP IS USED IN THE INITIAL CONDITIONS. + ! *NUKM* INTEGER ONLY USED IN THE CONTEXT OF MULTI-ANALYSIS + ! ENSEMBLE FORECASTS. IT SPECIFIED WHETHER + ! THE MET OFFICE IS USED IN THE INITIAL + ! CONDITIONS. + ! *IREFDATE* INTEGER REFERENCE DATE FOR MONTHLY FORECAST + ! HINDCAST RUNS. + ! + ! *LSMSSIG_WAM* LOGICAL .T. = send signals to SMS or ECFLOW (ECMWF supervisor) + ! *CMETER* CHARACTER SMS or ECFLOW meter command (ECMWF supervisor) + ! *CEVENT* CHARACTER SMS or ECFLOW event command (ECMWF supervisor) + ! ---------------------------------------------------------------------- +!$acc declare create( icase ) +!$acc declare create( IDELT ) +!$acc declare create( ISNONLIN ) +!$acc declare create( LBIWBK ) +!$acc declare create( IPHYS ) +!$acc declare create( IDAMPING ) +END MODULE YOWSTAT diff --git a/src/phys-scc-cuda/yowtabl.c_hoist.F90 b/src/phys-scc-cuda/yowtabl.c_hoist.F90 new file mode 100644 index 00000000..90f6d4b6 --- /dev/null +++ b/src/phys-scc-cuda/yowtabl.c_hoist.F90 @@ -0,0 +1,142 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWTABL + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + !* ** *TABLE* - TABLE FOR TOTAL STRESS AND HIGH FREQ STRESS. !!!! (obsolete !!! + ! AND TABLES FOR THE CORRECTION OF ALTIMETER HS. + !* ** *TABLE* - TABLE FOR 2ND-ORDER INTERACTION COEFFICIENTS. + + INTEGER(KIND=JWIM), PARAMETER :: ITAUMAX = 400 + INTEGER(KIND=JWIM), PARAMETER :: JUMAX = 300 + INTEGER(KIND=JWIM), PARAMETER :: IUSTAR = 500 + INTEGER(KIND=JWIM), PARAMETER :: IALPHA = 400 + INTEGER(KIND=JWIM), PARAMETER :: ILEVTAIL = 50 + INTEGER(KIND=JWIM), PARAMETER :: IAB = 200 + INTEGER(KIND=JWIM), PARAMETER :: NFREHF = 49 + + INTEGER(KIND=JWIM) :: MR + INTEGER(KIND=JWIM) :: MA + INTEGER(KIND=JWIM) :: NFREH + INTEGER(KIND=JWIM) :: NANGH + INTEGER(KIND=JWIM) :: NMAX + + REAL(KIND=JWRB), PARAMETER :: EPS1 = 0.00001_JWRB + REAL(KIND=JWRB), PARAMETER :: UMAX = 75.0_JWRB + REAL(KIND=JWRB), ALLOCATABLE :: TAUT(:, :, :) + REAL(KIND=JWRB) :: DELTAUW + REAL(KIND=JWRB) :: DELU + REAL(KIND=JWRB), PARAMETER :: USTARM = 5.0_JWRB + REAL(KIND=JWRB), PARAMETER :: ALPHAMCOEF = 40.0_JWRB + REAL(KIND=JWRB), PARAMETER :: XLEVTAILM = 0.02_JWRB + REAL(KIND=JWRB), ALLOCATABLE :: TAUHFT(:, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: PHIHFT(:, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: TAUHFT2(:, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: PHIHFT2(:, :, :) + REAL(KIND=JWRB) :: DELUST + REAL(KIND=JWRB) :: DELALP + REAL(KIND=JWRB) :: DELTAIL + REAL(KIND=JWRB), ALLOCATABLE :: FAC0(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: FAC1(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: FAC2(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: FAC3(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: FAK(:) + REAL(KIND=JWRB), ALLOCATABLE :: FRHF(:) + REAL(KIND=JWRB), ALLOCATABLE :: DFIMHF(:) + REAL(KIND=JWRB) :: SWELLFT(IAB) + REAL(KIND=JWRB) :: XMR + REAL(KIND=JWRB) :: XMA + REAL(KIND=JWRB) :: DELTHH + + INTEGER(KIND=JWIM), ALLOCATABLE :: IM_P(:, :) + INTEGER(KIND=JWIM), ALLOCATABLE :: IM_M(:, :) + + REAL(KIND=JWRB), ALLOCATABLE :: OMEGA(:) + REAL(KIND=JWRB), ALLOCATABLE :: DFDTH(:) + REAL(KIND=JWRB), ALLOCATABLE :: THH(:) + REAL(KIND=JWRB), ALLOCATABLE :: TA(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: TB(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: TC_QL(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: TT_4M(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: TT_4P(:, :, :, :) + REAL(KIND=JWRB), ALLOCATABLE :: TFAKH(:, :) + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! + !*** STRESS AND HIGH-FREQUENCY WAVE STRESS. + ! ------------------------------------- + ! + ! *ITAUMAX* INTEGER TABLE DIMENSION. + ! *JUMAX* INTEGER TABLE DIMENSION. + ! *IUSTAR* INTEGER TABLE DIMENSION. + ! *IALPHA* INTEGER TABLE DIMENSION. + ! *ILEVTAIL* INTEGER TABLE DIMENSION. + ! *IAB* INTEGER TABLE DIMENSION. + ! *NFREHF* INTEGER EXTENDED NUMBER OF FREQUENCIES. + ! *EPS1* REAL SMALL MULTIPLICATIVE NUMBER TO MAKE SURE THAT A SOLUTION + ! IS OBTAINED IN ITERATION WITH TAU>TAUW. + ! *UMAX* REAL MAXIMUM WIND SPEED IN STRESS TABLE. + ! *TAUT* REAL STRESS TABLE. + ! *DELTAUW* REAL WAVE STRESS INCREMENT. + ! *DELU* REAL WIND INCREMENT. + ! *USTARM* REAL MAXIMUM FRICTION VELOCITY IN STRESS TABLE. + ! *ALPHAMCOEF*REAL MULTIPLICATIVE FACTOR TO SET THE MAXIMUM CHARNOCK + ! BASED ON THE MINIMUM CHARNOCK VALUE IN STRESS TABLE. + ! *XLEVTAILM* REAL MAXIMUM TAIL FACTOR (SATURATION LEVEL) IN STRESS TABLE. + ! *TAUHFT* REAL HIGH FREQUENCY STRESS TABLE for ECMWF PHYSICS. + ! *TAUHFT2* REAL HIGH FREQUENCY STRESS TABLE for METEO FRANCE PHYSICS. + ! *PHIHFT* REAL HIGH FREQUENCY WIND INPUT WAVE ENERGY FLUX TABLE for ECMWF PHYSICS. + ! *PHIHFT2* REAL HIGH FREQUENCY WIND INPUT WAVE ENERGY FLUX TABLE for METEO FRANCE PHYSICS. + ! *DELUST* REAL USTAR INCREMENT. + ! *DELALP* REAL ALPHA INCREMENT. + ! *DELTAIL* REAL ALPHA INCREMENT. + ! + !*** CORRECTIONS TO ALTIMETER. + ! ------------------------ + ! + ! *FAC0* REAL TABLE FOR HIGHER MOMENT CALCULATION. + ! *FAC1* REAL TABLE FOR HIGHER MOMENT CALCULATION. + ! *FAC2* REAL TABLE FOR HIGHER MOMENT CALCULATION. + ! *FAC3* REAL TABLE FOR HIGHER MOMENT CALCULATION. + ! *FAK* REAL WAVE NUMBERS FOR HIGHER MOMENT CALCULATION. + ! *FRHF* REAL FREQUENCIES FOR HIGHER MOMENT CALCULATION. + ! *DFIMHF* REAL FREQUENCY DIRECTION AREA FOR HIGHER + ! MOMENT CALCULATION. + ! *SWELLFT* REAL FRICTION COEFFICIENTS IN OSCILLATORY BOUNDARY LAYERS. + ! + !*** SECOND AND THIRD-ORDER INETERACTION COEFFICIENTS. + ! ------------------------------------------------ + ! + ! MR INTEGER THINNING PARAMETER IN FREQUECY SPACE + ! MA INTEGER THINNING PARAMETER IN ANGULAR SPACE + ! NFREH INTEGER NUMBER OF FREQUENCIES + ! NANGH INTEGER NUMBER OF DIRECTIONS + ! NMAX INTEGER MAXIMUM OF FREQUENCY INDEX + ! XMR REAL INVERSE OF THINNING FACTOR IN FREQUENCY SPACE + ! XMA REAL INVERSE OF THINNING FACTOR IN ANGULAR SPACE + ! DELTHH REAL DIRECTIONAL INCREMENT IN REDUCED SPACE + ! OMEGA REAL ANGULAR FREQUENCY ARRAY + ! DFDTH REAL FREQUENCY DIRECTION INCREMENT IN REDUCED SPACE + ! THH REAL DIRECTION ARRAY + ! TA REAL TABLE FOR MINUS INTERACTIONS + ! TB REAL TABLE FOR PLUS INTERACTIONS + ! TC_QL REAL TABLE FOR QUASI-LINEAR INTERACTIONS + ! TT_4M REAL TABLE FOR STOKES FREQUENCY CORRECTION + ! TT_4P REAL TABLE FOR STOKES FREQUENCY CORRECTION + ! IM_P INTEGER TABLE FOR WAVENUMBER M2 PLUS + ! IM_M INTEGER TABLE FOR WAVENUMBER M2 MIN + ! TFAKH REAL WAVENUMBER TABLE IN REDUCED SPACE + ! + ! ---------------------------------------------------------------------- +!$acc declare create( SWELLFT ) +END MODULE YOWTABL diff --git a/src/phys-scc-cuda/yowwind.c_hoist.F90 b/src/phys-scc-cuda/yowwind.c_hoist.F90 new file mode 100644 index 00000000..d9b43f1b --- /dev/null +++ b/src/phys-scc-cuda/yowwind.c_hoist.F90 @@ -0,0 +1,91 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWWIND + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + USE YOWDRVTYPE, ONLY: FORCING_FIELDS + + IMPLICIT NONE + + REAL(KIND=JWRB) :: WSPMIN + REAL(KIND=JWRB), PARAMETER :: WSPMIN_RESET_TAUW = 4.0_JWRB + REAL(KIND=JWRB), PARAMETER :: USTMIN_RESET_TAUW = 0.08_JWRB + REAL(KIND=JWRB), PARAMETER :: RWFAC = 0.5_JWRB + + CHARACTER(LEN=14) :: CDATEWL + CHARACTER(LEN=14) :: CDAWIFL + CHARACTER(LEN=14) :: CDATEWO + CHARACTER(LEN=14) :: CDATEFL + CHARACTER(LEN=14) :: CDTNEXT + CHARACTER(LEN=80) :: CWDFILE + + INTEGER(KIND=JWIM) :: IIG + INTEGER(KIND=JWIM) :: NC + INTEGER(KIND=JWIM) :: NR + INTEGER(KIND=JWIM) :: NXFFS + INTEGER(KIND=JWIM) :: NXFFE + INTEGER(KIND=JWIM) :: NYFFS + INTEGER(KIND=JWIM) :: NYFFE + INTEGER(KIND=JWIM) :: NXFFS_LOC + INTEGER(KIND=JWIM) :: NXFFE_LOC + INTEGER(KIND=JWIM) :: NYFFS_LOC + INTEGER(KIND=JWIM) :: NYFFE_LOC + INTEGER(KIND=JWIM) :: NSTORE + INTEGER(KIND=JWIM) :: IUNITW = 0 + INTEGER(KIND=JWIM) :: NBITW = 8100000 + + TYPE(FORCING_FIELDS) :: FF_NEXT + + LOGICAL :: LLWSWAVE + LOGICAL :: LLWDWAVE + LOGICAL :: LLNEWCURR + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *WSPMIN* REAL MINIMUM WIND SPEED ALLOWED IN WAM (SEE USERIN). + ! *WSPMIN_RESET_TAUW MINIMUM WIND SPEED TO RESET WAVE INDUCED STRESS + ! *USTMIN_RESET_TAUW MINIMUM FRICTION VELOCITY TO RESET WAVE INDUCED STRESS + ! *RWFAC* REAL REDUCTION FACTOR OF THE SURFACE CURRENTS + ! WHEN USED TO COMPUTE THE RELATIVE WINDS + ! 0 <= RWFAC <= 1 + ! *CDATEWL* CHAR*14 DATE OF LAST WINDFIELD READ IN. + ! *CDATEWO* CHAR*14 DATE OF NEXT WIND FIELD TO BE READ. + ! *CDAWIFL* CHAR*14 DATE OF NEXT WIND FILE NAME. + ! *CDATEFL* CHAR*14 DATE OF NEXT WIND FILE TO BE ACCESSED. + ! *CDTNEXT* CHAR*14 DATE CORRESPONDING TO TEMPORARY STORAGE ??? obsolete ??? + ! (SEE BELOW). + ! *CWDFILE* CHAR*80 FILENAME FOR FILE CONTAINING WIND SPEED + ! AND DIRECTION TIMESERIES WHEN USED INSTEAD + ! OF FORCING FROM INPUT WIND FIELDS + ! (see USERIN). + ! *IIG* INTEGER BLOCK NUMBER OF LAST WIND FIELD READ IN + ! *NC* INTEGER NUMBER OF COLUMNS IN INPUT WIND ARRAY + ! *NR* INTEGER NUMBER OF ROWS IN INPUT WIND ARRAY + ! *NXFFS INTEGER FIRST ROW IN FORCING_FIELDS DATA + ! *NXFFE INTEGER LAST ROW IN FORCING_FIELDS DATA + ! *NYFFS INTEGER FIRST COLUMN IN FORCING_FIELDS DATA + ! *NYFFE INTEGER LAST COLUMN IN FORCING_FIELDS DATA + ! *NXFFS_LOC INTEGER FIRST ROW IN FORCING_FIELDS DATA FOR POINTS THAT ARE LOVAT TO A GIVEN MPI TASK + ! *NXFFE_LOC INTEGER LAST ROW IN FORCING_FIELDS DATA FOR POINTS THAT ARE LOVAT TO A GIVEN MPI TASK + ! *NYFFS_LOC INTEGER FIRST COLUMN IN FORCING_FIELDS DATA FOR POINTS THAT ARE LOVAT TO A GIVEN MPI TASK + ! *NYFFE_LOC INTEGER LAST COLUMN IN FORCING_FIELDS DATA FOR POINTS THAT ARE LOVAT TO A GIVEN MPI TASK + ! *IUNITW* INTEGER UNIT USED TO OPEN THE INPUT WIND DATA + ! OR THE FILE HANDLE IF GRIBAPI IS USED. + ! *NBITW* INTEGER SIZE OF DECODING BUFFER FOR FORCING DATA. + ! *FF_NEXT* REAL UPDATE FOR FORCING + + ! *LLWSWAVE* LOGICAL TRUE IF PARAMETER 245 IS PART OF THE INPUT + ! *LLWDWAVE* LOGICAL TRUE IF PARAMETER 249 IS PART OF THE INPUT + ! *LLNEWCURR* LOGICAL TRUE IF NEW CURRENTS ARE PASSED FROM IFS + ! TO WAM + ! ---------------------------------------------------------------------- + +!$acc declare create( WSPMIN ) +END MODULE YOWWIND diff --git a/src/phys-scc-cuda/yowwndg.c_hoist.F90 b/src/phys-scc-cuda/yowwndg.c_hoist.F90 new file mode 100644 index 00000000..7a3aa740 --- /dev/null +++ b/src/phys-scc-cuda/yowwndg.c_hoist.F90 @@ -0,0 +1,37 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +MODULE YOWWNDG + + USE PARKIND_WAVE, ONLY: JWIM, JWRB, JWRU + + IMPLICIT NONE + + !* ** *WNDGRD* - INPUT WIND GRID SPECIFICATIONS. + + INTEGER(KIND=JWIM) :: ICODE + INTEGER(KIND=JWIM) :: ICODE_CPL + INTEGER(KIND=JWIM) :: IWPER + INTEGER(KIND=JWIM) :: ICOORD + + !* VARIABLE. TYPE. PURPOSE. + ! --------- ------- -------- + ! *ICODE* INTEGER WIND CODE FROM INPUT FILE + ! 1 = USTAR; 2 = USTRESS; 3 = U10 + ! *ICODE_CPL* INTEGER WIND CODE PASSED VIA WAVEMDL + ! 0 = NOT SET; 1 = USTAR; 2 = USTRESS; 3 = U10 + ! *IWPER* INTEGER INDICATOR PERIODICAL GRID. + ! 0= NON-PERIODICAL; 1= PERIODICAL. + ! *ICOORD* INTEGER CODE FOR COORDINATE SYSTEM USED + ! 1= RECTANGULAR,EQUIDISTANT LON/LAT GRID. + ! 2= .......NOT IMPLEMENTED. + ! ---------------------------------------------------------------------- + +!$acc declare create( ICODE ) +!$acc declare create( ICODE_CPL ) +END MODULE YOWWNDG diff --git a/src/phys-scc-cuda/z0wave.c_hoist.F90 b/src/phys-scc-cuda/z0wave.c_hoist.F90 new file mode 100644 index 00000000..12492c05 --- /dev/null +++ b/src/phys-scc-cuda/z0wave.c_hoist.F90 @@ -0,0 +1,107 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +ATTRIBUTES(DEVICE) SUBROUTINE Z0WAVE_FC (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK, ALPHA, ALPHAMIN, CHNKMIN_U, EPS1, G, GM1, & +& LLCAPCHNK, ICHNK, NCHNK, IJ) + + ! ---------------------------------------------------------------------- + + !**** *Z0WAVE* - DETERMINE THE SEA STATE DEPENDENT ROUGHNESS LENGTH. + + !* PURPOSE. + ! -------- + + ! COMPUTE ROUGHNESS LENGTH. + + !** INTERFACE. + ! ---------- + + ! *CALL* *Z0WAVE (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK) + ! *KIJS* - INDEX OF FIRST GRIDPOINT. + ! *KIJL* - INDEX OF LAST GRIDPOINT. + ! *US* - OUTPUT BLOCK OF SURFACE STRESSES. + ! *TAUW* - INPUT BLOCK OF WAVE STRESSES. + ! *UTOP* - WIND SPEED. + ! *Z0* - OUTPUT BLOCK OF ROUGHNESS LENGTH. + ! *Z0B* - BACKGROUND ROUGHNESS LENGTH. + ! *CHRNCK- CHARNOCK COEFFICIENT + + ! METHOD. + ! ------- + + ! EXTERNALS. + ! ---------- + + ! NONE. + + ! REFERENCE. + ! --------- + + ! NONE. + + ! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION CHNKMIN_FC (U10) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: CHNKMIN + REAL(KIND=JWRB), INTENT(IN) :: U10 + END FUNCTION CHNKMIN_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: US(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UTOP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB) :: UST2 + REAL(KIND=JWRB) :: UST3 + REAL(KIND=JWRB) :: ARG + REAL(KIND=JWRB) :: ALPHAOG + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + + ! ---------------------------------------------------------------------- + + + + IF (LLCAPCHNK) THEN + ALPHAOG = CHNKMIN_FC(UTOP(IJ, ICHNK), ALPHA, ALPHAMIN, CHNKMIN_U)*GM1 + ELSE + ALPHAOG = ALPHA*GM1 + END IF + + UST2 = US(IJ, ICHNK)**2 + UST3 = US(IJ, ICHNK)**3 + ARG = MAX(UST2 - TAUW(IJ, ICHNK), EPS1) + Z0(IJ, ICHNK) = ALPHAOG*UST3 / SQRT(ARG) + Z0B(IJ, ICHNK) = ALPHAOG*UST2 + CHRNCK(IJ, ICHNK) = G*Z0(IJ, ICHNK) / UST2 + + + +END SUBROUTINE Z0WAVE_FC diff --git a/src/phys-scc-cuda/z0wave_c.c b/src/phys-scc-cuda/z0wave_c.c new file mode 100644 index 00000000..239457fa --- /dev/null +++ b/src/phys-scc-cuda/z0wave_c.c @@ -0,0 +1,38 @@ +#include +#include +#include +#include +#include +#include +#include "z0wave_c.h" +#include "chnkmin_c.h" + +__device__ void z0wave_c(int kijs, int kijl, const double * us, const double * tauw, + const double * utop, double * z0, double * z0b, double * chrnck, double alpha, + double alphamin, double chnkmin_u, double eps1, double g, double gm1, int llcapchnk, + int ichnk, int nchnk, int ij) { + + + + double ust2; + double ust3; + double arg; + double alphaog; + + + if (llcapchnk) { + alphaog = chnkmin_c(utop[ij - 1 + kijl*(ichnk - 1)], alpha, alphamin, chnkmin_u)*gm1; + } else { + alphaog = alpha*gm1; + } + + ust2 = pow(us[ij - 1 + kijl*(ichnk - 1)], 2); + ust3 = pow(us[ij - 1 + kijl*(ichnk - 1)], 3); + arg = max((double) (ust2 - tauw[ij - 1 + kijl*(ichnk - 1)]), (double) (eps1)); + z0[ij - 1 + kijl*(ichnk - 1)] = alphaog*ust3 / sqrt((double) (arg)); + z0b[ij - 1 + kijl*(ichnk - 1)] = alphaog*ust2; + chrnck[ij - 1 + kijl*(ichnk - 1)] = g*z0[ij - 1 + kijl*(ichnk - 1)] / ust2; + + + +} diff --git a/src/phys-scc-cuda/z0wave_c.h b/src/phys-scc-cuda/z0wave_c.h new file mode 100644 index 00000000..8f4e17d9 --- /dev/null +++ b/src/phys-scc-cuda/z0wave_c.h @@ -0,0 +1,12 @@ +#include +#include +#include +#include +#include +#include +#include "chnkmin_c.h" + +__device__ void z0wave_c(int kijs, int kijl, const double * us, const double * tauw, + const double * utop, double * z0, double * z0b, double * chrnck, double alpha, + double alphamin, double chnkmin_u, double eps1, double g, double gm1, int llcapchnk, + int ichnk, int nchnk, int ij); diff --git a/src/phys-scc-cuda/z0wave_fc.F90 b/src/phys-scc-cuda/z0wave_fc.F90 new file mode 100644 index 00000000..704c7db9 --- /dev/null +++ b/src/phys-scc-cuda/z0wave_fc.F90 @@ -0,0 +1,71 @@ +MODULE Z0WAVE_FC_MOD + USE iso_c_binding + CONTAINS + SUBROUTINE Z0WAVE_fc (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK, ALPHA, ALPHAMIN, CHNKMIN_U, EPS1, G, GM1, LLCAPCHNK, ICHNK, & + & NCHNK, IJ) + USE iso_c_binding, ONLY: c_loc + USE PARKIND_WAVE, ONLY: JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION CHNKMIN (U10) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: CHNKMIN + REAL(KIND=JWRB), INTENT(IN) :: U10 + END FUNCTION CHNKMIN + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + INTERFACE + SUBROUTINE Z0WAVE_iso_c (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK, ALPHA, ALPHAMIN, CHNKMIN_U, EPS1, G, GM1, LLCAPCHNK, & + & ICHNK, NCHNK, IJ) BIND(c, name="z0wave_c_launch") + USE iso_c_binding, ONLY: c_int, c_ptr + implicit none + INTEGER(KIND=c_int), VALUE :: KIJS + INTEGER(KIND=c_int), VALUE :: KIJL + TYPE(c_ptr), VALUE :: US + TYPE(c_ptr), VALUE :: TAUW + TYPE(c_ptr), VALUE :: UTOP + TYPE(c_ptr), VALUE :: Z0 + TYPE(c_ptr), VALUE :: Z0B + TYPE(c_ptr), VALUE :: CHRNCK + REAL, VALUE :: ALPHA + REAL, VALUE :: ALPHAMIN + REAL, VALUE :: CHNKMIN_U + REAL, VALUE :: EPS1 + REAL, VALUE :: G + REAL, VALUE :: GM1 + LOGICAL, VALUE :: LLCAPCHNK + INTEGER(KIND=c_int), VALUE :: ICHNK + INTEGER(KIND=c_int), VALUE :: NCHNK + INTEGER(KIND=c_int), VALUE :: IJ + END SUBROUTINE Z0WAVE_iso_c + END INTERFACE + REAL(KIND=JWRB), TARGET, INTENT(IN) :: US(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UTOP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) +!$acc host_data use_device( US, TAUW, UTOP, Z0, Z0B, CHRNCK ) + CALL Z0WAVE_iso_c(KIJS, KIJL, c_loc(US), c_loc(TAUW), c_loc(UTOP), c_loc(Z0), c_loc(Z0B), c_loc(CHRNCK), ALPHA, ALPHAMIN, & + & CHNKMIN_U, EPS1, G, GM1, LLCAPCHNK, ICHNK, NCHNK, IJ) +!$acc end host_data + END SUBROUTINE Z0WAVE_fc +END MODULE Z0WAVE_FC_MOD diff --git a/src/phys-scc-cuda/z0wave_fc.intfb.h b/src/phys-scc-cuda/z0wave_fc.intfb.h new file mode 100644 index 00000000..70f201ef --- /dev/null +++ b/src/phys-scc-cuda/z0wave_fc.intfb.h @@ -0,0 +1,39 @@ +INTERFACE + SUBROUTINE Z0WAVE_FC (KIJS, KIJL, US, TAUW, UTOP, Z0, Z0B, CHRNCK, ALPHA, ALPHAMIN, CHNKMIN_U, EPS1, G, GM1, LLCAPCHNK, ICHNK, & + & NCHNK, IJ) + USE PARKIND_WAVE, ONLY: JWRU, JWIM, JWRB + + + + ! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTERFACE + FUNCTION CHNKMIN_FC (U10) + USE parkind_wave, ONLY: jwrb + REAL(KIND=JWRB) :: CHNKMIN + REAL(KIND=JWRB), INTENT(IN) :: U10 + END FUNCTION CHNKMIN_FC + END INTERFACE + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJS + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: KIJL + REAL(KIND=JWRB), TARGET, INTENT(IN) :: US(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: TAUW(:, :) + REAL(KIND=JWRB), TARGET, INTENT(IN) :: UTOP(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: Z0B(:, :) + REAL(KIND=JWRB), TARGET, INTENT(OUT) :: CHRNCK(:, :) + + + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: IJ + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHA + REAL(KIND=JWRB), VALUE, INTENT(IN) :: ALPHAMIN + REAL(KIND=JWRB), VALUE, INTENT(IN) :: CHNKMIN_U + REAL(KIND=JWRB), VALUE, INTENT(IN) :: EPS1 + REAL(KIND=JWRB), VALUE, INTENT(IN) :: G + REAL(KIND=JWRB), VALUE, INTENT(IN) :: GM1 + LOGICAL, VALUE, INTENT(IN) :: LLCAPCHNK + INTEGER(KIND=JWIM), VALUE, INTENT(IN) :: ICHNK + INTEGER, VALUE, INTENT(IN) :: NCHNK + END SUBROUTINE Z0WAVE_FC +END INTERFACE \ No newline at end of file