Changeset 12603 for NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC
- Timestamp:
- 2020-03-25T16:20:25+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC
- Files:
-
- 11 edited
-
lbc_lnk_multi_generic.h90 (modified) (2 diffs)
-
lbc_nfd_ext_generic.h90 (modified) (2 diffs)
-
lbc_nfd_generic.h90 (modified) (5 diffs)
-
lbc_nfd_nogather_generic.h90 (modified) (5 diffs)
-
lbclnk.F90 (modified) (10 diffs)
-
lbcnfd.F90 (modified) (6 diffs)
-
lib_mpp.F90 (modified) (18 diffs)
-
mpp_allreduce_generic.h90 (modified) (3 diffs)
-
mpp_lnk_generic.h90 (modified) (8 diffs)
-
mpp_loc_generic.h90 (modified) (4 diffs)
-
mpp_nfd_generic.h90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lbc_lnk_multi_generic.h90
r11536 r12603 1 #if defined DIM_2d 2 # define ARRAY_TYPE(i,j,k,l) REAL(wp), DIMENSION(i,j) 3 # define PTR_TYPE TYPE(PTR_2D) 4 # define PTR_ptab pt2d 5 #endif 6 #if defined DIM_3d 7 # define ARRAY_TYPE(i,j,k,l) REAL(wp), DIMENSION(i,j,k) 8 # define PTR_TYPE TYPE(PTR_3D) 9 # define PTR_ptab pt3d 10 #endif 11 #if defined DIM_4d 12 # define ARRAY_TYPE(i,j,k,l) REAL(wp), DIMENSION(i,j,k,l) 13 # define PTR_TYPE TYPE(PTR_4D) 14 # define PTR_ptab pt4d 1 #if defined SINGLE_PRECISION 2 # if defined DIM_2d 3 # define ARRAY_TYPE(i,j,k,l) REAL(sp), DIMENSION(i,j) 4 # define PTR_TYPE TYPE(PTR_2D_sp) 5 # define PTR_ptab pt2d 6 # endif 7 # if defined DIM_3d 8 # define ARRAY_TYPE(i,j,k,l) REAL(sp), DIMENSION(i,j,k) 9 # define PTR_TYPE TYPE(PTR_3D_sp) 10 # define PTR_ptab pt3d 11 # endif 12 # if defined DIM_4d 13 # define ARRAY_TYPE(i,j,k,l) REAL(sp), DIMENSION(i,j,k,l) 14 # define PTR_TYPE TYPE(PTR_4D_sp) 15 # define PTR_ptab pt4d 16 # endif 17 # define PRECISION sp 18 #else 19 # if defined DIM_2d 20 # define ARRAY_TYPE(i,j,k,l) REAL(dp), DIMENSION(i,j) 21 # define PTR_TYPE TYPE(PTR_2D_dp) 22 # define PTR_ptab pt2d 23 # endif 24 # if defined DIM_3d 25 # define ARRAY_TYPE(i,j,k,l) REAL(dp), DIMENSION(i,j,k) 26 # define PTR_TYPE TYPE(PTR_3D_dp) 27 # define PTR_ptab pt3d 28 # endif 29 # if defined DIM_4d 30 # define ARRAY_TYPE(i,j,k,l) REAL(dp), DIMENSION(i,j,k,l) 31 # define PTR_TYPE TYPE(PTR_4D_dp) 32 # define PTR_ptab pt4d 33 # endif 34 # define PRECISION dp 15 35 #endif 16 36 … … 79 99 END SUBROUTINE ROUTINE_LOAD 80 100 101 #undef PRECISION 81 102 #undef ARRAY_TYPE 82 103 #undef PTR_TYPE -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lbc_nfd_ext_generic.h90
r10525 r12603 8 8 # define L_SIZE(ptab) 1 9 9 #endif 10 #define ARRAY_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 10 #if defined SINGLE_PRECISION 11 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 12 # define PRECISION sp 13 #else 14 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 15 # define PRECISION dp 16 #endif 11 17 12 18 SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj ) … … 149 155 END SUBROUTINE ROUTINE_NFD 150 156 157 #undef PRECISION 151 158 #undef ARRAY_TYPE 152 159 #undef ARRAY_IN -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lbc_nfd_generic.h90
r10425 r12603 4 4 # define F_SIZE(ptab) kfld 5 5 # if defined DIM_2d 6 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D),INTENT(inout)::ptab(f) 6 # if defined SINGLE_PRECISION 7 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp),INTENT(inout)::ptab(f) 8 # else 9 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp),INTENT(inout)::ptab(f) 10 # endif 7 11 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 8 12 # define K_SIZE(ptab) 1 … … 10 14 # endif 11 15 # if defined DIM_3d 12 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D),INTENT(inout)::ptab(f) 16 # if defined SINGLE_PRECISION 17 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp),INTENT(inout)::ptab(f) 18 # else 19 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp),INTENT(inout)::ptab(f) 20 # endif 13 21 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 14 22 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) … … 16 24 # endif 17 25 # if defined DIM_4d 18 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab(f) 26 # if defined SINGLE_PRECISION 27 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab(f) 28 # else 29 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab(f) 30 # endif 19 31 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 20 32 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) … … 41 53 # define L_SIZE(ptab) SIZE(ptab,4) 42 54 # endif 43 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 55 # if defined SINGLE_PRECISION 56 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 57 # else 58 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 59 # endif 44 60 #endif 61 62 # if defined SINGLE_PRECISION 63 # define PRECISION sp 64 # else 65 # define PRECISION dp 66 # endif 45 67 46 68 #if defined MULTI … … 167 189 END SUBROUTINE ROUTINE_NFD 168 190 191 #undef PRECISION 169 192 #undef ARRAY_TYPE 170 193 #undef ARRAY_IN -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r11536 r12603 4 4 # define F_SIZE(ptab) kfld 5 5 # if defined DIM_2d 6 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D),INTENT(inout)::ptab(f) 6 # if defined SINGLE_PRECISION 7 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp),INTENT(inout)::ptab(f) 8 # else 9 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp),INTENT(inout)::ptab(f) 10 # endif 7 11 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 8 12 # define K_SIZE(ptab) 1 … … 10 14 # endif 11 15 # if defined DIM_3d 12 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D),INTENT(inout)::ptab(f) 16 # if defined SINGLE_PRECISION 17 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp),INTENT(inout)::ptab(f) 18 # else 19 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp),INTENT(inout)::ptab(f) 20 # endif 13 21 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 14 22 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) … … 16 24 # endif 17 25 # if defined DIM_4d 18 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab(f) 26 # if defined SINGLE_PRECISION 27 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab(f) 28 # else 29 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab(f) 30 # endif 19 31 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 20 32 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 21 33 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) 22 34 # endif 23 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab2(f) 35 # if defined SINGLE_PRECISION 36 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab2(f) 37 # else 38 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab2(f) 39 # endif 24 40 # define J_SIZE(ptab2) SIZE(ptab2(1)%pt4d,2) 25 41 # define ARRAY2_IN(i,j,k,l,f) ptab2(f)%pt4d(i,j,k,l) … … 46 62 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l) 47 63 # define J_SIZE(ptab2) SIZE(ptab2,2) 48 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 49 # define ARRAY2_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 50 #endif 51 64 # if defined SINGLE_PRECISION 65 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 66 # define ARRAY2_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 67 # else 68 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 69 # define ARRAY2_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 70 # endif 71 # endif 72 # ifdef SINGLE_PRECISION 73 # define PRECISION sp 74 # else 75 # define PRECISION dp 76 # endif 52 77 SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld ) 53 78 !!---------------------------------------------------------------------- … … 345 370 END DO ! End jf loop 346 371 END SUBROUTINE ROUTINE_NFD 372 #undef PRECISION 347 373 #undef ARRAY_TYPE 348 374 #undef ARRAY_IN -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lbclnk.F90
r12377 r12603 28 28 29 29 INTERFACE lbc_lnk 30 MODULE PROCEDURE mpp_lnk_2d , mpp_lnk_3d , mpp_lnk_4d 30 MODULE PROCEDURE mpp_lnk_2d_sp , mpp_lnk_3d_sp , mpp_lnk_4d_sp 31 MODULE PROCEDURE mpp_lnk_2d_dp , mpp_lnk_3d_dp , mpp_lnk_4d_dp 31 32 END INTERFACE 32 33 INTERFACE lbc_lnk_ptr 33 MODULE PROCEDURE mpp_lnk_2d_ptr , mpp_lnk_3d_ptr , mpp_lnk_4d_ptr 34 MODULE PROCEDURE mpp_lnk_2d_ptr_sp , mpp_lnk_3d_ptr_sp , mpp_lnk_4d_ptr_sp 35 MODULE PROCEDURE mpp_lnk_2d_ptr_dp , mpp_lnk_3d_ptr_dp , mpp_lnk_4d_ptr_dp 34 36 END INTERFACE 35 37 INTERFACE lbc_lnk_multi 36 MODULE PROCEDURE lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 38 MODULE PROCEDURE lbc_lnk_2d_multi_sp , lbc_lnk_3d_multi_sp, lbc_lnk_4d_multi_sp 39 MODULE PROCEDURE lbc_lnk_2d_multi_dp , lbc_lnk_3d_multi_dp, lbc_lnk_4d_multi_dp 37 40 END INTERFACE 38 41 ! 39 42 INTERFACE lbc_lnk_icb 40 MODULE PROCEDURE mpp_lnk_2d_icb 43 MODULE PROCEDURE mpp_lnk_2d_icb_dp, mpp_lnk_2d_icb_sp 41 44 END INTERFACE 42 45 43 46 INTERFACE mpp_nfd 44 MODULE PROCEDURE mpp_nfd_2d , mpp_nfd_3d , mpp_nfd_4d 45 MODULE PROCEDURE mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr 47 MODULE PROCEDURE mpp_nfd_2d_sp , mpp_nfd_3d_sp , mpp_nfd_4d_sp 48 MODULE PROCEDURE mpp_nfd_2d_dp , mpp_nfd_3d_dp , mpp_nfd_4d_dp 49 MODULE PROCEDURE mpp_nfd_2d_ptr_sp, mpp_nfd_3d_ptr_sp, mpp_nfd_4d_ptr_sp 50 MODULE PROCEDURE mpp_nfd_2d_ptr_dp, mpp_nfd_3d_ptr_dp, mpp_nfd_4d_ptr_dp 51 46 52 END INTERFACE 47 53 … … 92 98 !!---------------------------------------------------------------------- 93 99 94 # define DIM_2d 95 # define ROUTINE_LOAD load_ptr_2d 96 # define ROUTINE_MULTI lbc_lnk_2d_multi 97 # include "lbc_lnk_multi_generic.h90" 98 # undef ROUTINE_MULTI 99 # undef ROUTINE_LOAD 100 # undef DIM_2d 101 102 # define DIM_3d 103 # define ROUTINE_LOAD load_ptr_3d 104 # define ROUTINE_MULTI lbc_lnk_3d_multi 105 # include "lbc_lnk_multi_generic.h90" 106 # undef ROUTINE_MULTI 107 # undef ROUTINE_LOAD 108 # undef DIM_3d 109 110 # define DIM_4d 111 # define ROUTINE_LOAD load_ptr_4d 112 # define ROUTINE_MULTI lbc_lnk_4d_multi 100 !! 101 !! ---- SINGLE PRECISION VERSIONS 102 !! 103 # define SINGLE_PRECISION 104 # define DIM_2d 105 # define ROUTINE_LOAD load_ptr_2d_sp 106 # define ROUTINE_MULTI lbc_lnk_2d_multi_sp 107 # include "lbc_lnk_multi_generic.h90" 108 # undef ROUTINE_MULTI 109 # undef ROUTINE_LOAD 110 # undef DIM_2d 111 112 # define DIM_3d 113 # define ROUTINE_LOAD load_ptr_3d_sp 114 # define ROUTINE_MULTI lbc_lnk_3d_multi_sp 115 # include "lbc_lnk_multi_generic.h90" 116 # undef ROUTINE_MULTI 117 # undef ROUTINE_LOAD 118 # undef DIM_3d 119 120 # define DIM_4d 121 # define ROUTINE_LOAD load_ptr_4d_sp 122 # define ROUTINE_MULTI lbc_lnk_4d_multi_sp 123 # include "lbc_lnk_multi_generic.h90" 124 # undef ROUTINE_MULTI 125 # undef ROUTINE_LOAD 126 # undef DIM_4d 127 # undef SINGLE_PRECISION 128 !! 129 !! ---- DOUBLE PRECISION VERSIONS 130 !! 131 132 # define DIM_2d 133 # define ROUTINE_LOAD load_ptr_2d_dp 134 # define ROUTINE_MULTI lbc_lnk_2d_multi_dp 135 # include "lbc_lnk_multi_generic.h90" 136 # undef ROUTINE_MULTI 137 # undef ROUTINE_LOAD 138 # undef DIM_2d 139 140 # define DIM_3d 141 # define ROUTINE_LOAD load_ptr_3d_dp 142 # define ROUTINE_MULTI lbc_lnk_3d_multi_dp 143 # include "lbc_lnk_multi_generic.h90" 144 # undef ROUTINE_MULTI 145 # undef ROUTINE_LOAD 146 # undef DIM_3d 147 148 # define DIM_4d 149 # define ROUTINE_LOAD load_ptr_4d_dp 150 # define ROUTINE_MULTI lbc_lnk_4d_multi_dp 113 151 # include "lbc_lnk_multi_generic.h90" 114 152 # undef ROUTINE_MULTI … … 130 168 ! !== 2D array and array of 2D pointer ==! 131 169 ! 132 # define DIM_2d 133 # define ROUTINE_LNK mpp_lnk_2d 134 # include "mpp_lnk_generic.h90" 135 # undef ROUTINE_LNK 136 # define MULTI 137 # define ROUTINE_LNK mpp_lnk_2d_ptr 170 !! 171 !! ---- SINGLE PRECISION VERSIONS 172 !! 173 # define SINGLE_PRECISION 174 # define DIM_2d 175 # define ROUTINE_LNK mpp_lnk_2d_sp 176 # include "mpp_lnk_generic.h90" 177 # undef ROUTINE_LNK 178 # define MULTI 179 # define ROUTINE_LNK mpp_lnk_2d_ptr_sp 138 180 # include "mpp_lnk_generic.h90" 139 181 # undef ROUTINE_LNK … … 144 186 ! 145 187 # define DIM_3d 146 # define ROUTINE_LNK mpp_lnk_3d 147 # include "mpp_lnk_generic.h90" 148 # undef ROUTINE_LNK 149 # define MULTI 150 # define ROUTINE_LNK mpp_lnk_3d_ptr 188 # define ROUTINE_LNK mpp_lnk_3d_sp 189 # include "mpp_lnk_generic.h90" 190 # undef ROUTINE_LNK 191 # define MULTI 192 # define ROUTINE_LNK mpp_lnk_3d_ptr_sp 151 193 # include "mpp_lnk_generic.h90" 152 194 # undef ROUTINE_LNK … … 157 199 ! 158 200 # define DIM_4d 159 # define ROUTINE_LNK mpp_lnk_4d 160 # include "mpp_lnk_generic.h90" 161 # undef ROUTINE_LNK 162 # define MULTI 163 # define ROUTINE_LNK mpp_lnk_4d_ptr 164 # include "mpp_lnk_generic.h90" 165 # undef ROUTINE_LNK 166 # undef MULTI 167 # undef DIM_4d 201 # define ROUTINE_LNK mpp_lnk_4d_sp 202 # include "mpp_lnk_generic.h90" 203 # undef ROUTINE_LNK 204 # define MULTI 205 # define ROUTINE_LNK mpp_lnk_4d_ptr_sp 206 # include "mpp_lnk_generic.h90" 207 # undef ROUTINE_LNK 208 # undef MULTI 209 # undef DIM_4d 210 # undef SINGLE_PRECISION 211 212 !! 213 !! ---- DOUBLE PRECISION VERSIONS 214 !! 215 # define DIM_2d 216 # define ROUTINE_LNK mpp_lnk_2d_dp 217 # include "mpp_lnk_generic.h90" 218 # undef ROUTINE_LNK 219 # define MULTI 220 # define ROUTINE_LNK mpp_lnk_2d_ptr_dp 221 # include "mpp_lnk_generic.h90" 222 # undef ROUTINE_LNK 223 # undef MULTI 224 # undef DIM_2d 225 ! 226 ! !== 3D array and array of 3D pointer ==! 227 ! 228 # define DIM_3d 229 # define ROUTINE_LNK mpp_lnk_3d_dp 230 # include "mpp_lnk_generic.h90" 231 # undef ROUTINE_LNK 232 # define MULTI 233 # define ROUTINE_LNK mpp_lnk_3d_ptr_dp 234 # include "mpp_lnk_generic.h90" 235 # undef ROUTINE_LNK 236 # undef MULTI 237 # undef DIM_3d 238 ! 239 ! !== 4D array and array of 4D pointer ==! 240 ! 241 # define DIM_4d 242 # define ROUTINE_LNK mpp_lnk_4d_dp 243 # include "mpp_lnk_generic.h90" 244 # undef ROUTINE_LNK 245 # define MULTI 246 # define ROUTINE_LNK mpp_lnk_4d_ptr_dp 247 # include "mpp_lnk_generic.h90" 248 # undef ROUTINE_LNK 249 # undef MULTI 250 # undef DIM_4d 251 168 252 169 253 !!---------------------------------------------------------------------- … … 181 265 ! !== 2D array and array of 2D pointer ==! 182 266 ! 183 # define DIM_2d 184 # define ROUTINE_NFD mpp_nfd_2d 185 # include "mpp_nfd_generic.h90" 186 # undef ROUTINE_NFD 187 # define MULTI 188 # define ROUTINE_NFD mpp_nfd_2d_ptr 267 !! 268 !! ---- SINGLE PRECISION VERSIONS 269 !! 270 # define SINGLE_PRECISION 271 # define DIM_2d 272 # define ROUTINE_NFD mpp_nfd_2d_sp 273 # include "mpp_nfd_generic.h90" 274 # undef ROUTINE_NFD 275 # define MULTI 276 # define ROUTINE_NFD mpp_nfd_2d_ptr_sp 189 277 # include "mpp_nfd_generic.h90" 190 278 # undef ROUTINE_NFD … … 195 283 ! 196 284 # define DIM_3d 197 # define ROUTINE_NFD mpp_nfd_3d 198 # include "mpp_nfd_generic.h90" 199 # undef ROUTINE_NFD 200 # define MULTI 201 # define ROUTINE_NFD mpp_nfd_3d_ptr 285 # define ROUTINE_NFD mpp_nfd_3d_sp 286 # include "mpp_nfd_generic.h90" 287 # undef ROUTINE_NFD 288 # define MULTI 289 # define ROUTINE_NFD mpp_nfd_3d_ptr_sp 202 290 # include "mpp_nfd_generic.h90" 203 291 # undef ROUTINE_NFD … … 208 296 ! 209 297 # define DIM_4d 210 # define ROUTINE_NFD mpp_nfd_4d 211 # include "mpp_nfd_generic.h90" 212 # undef ROUTINE_NFD 213 # define MULTI 214 # define ROUTINE_NFD mpp_nfd_4d_ptr 215 # include "mpp_nfd_generic.h90" 216 # undef ROUTINE_NFD 217 # undef MULTI 218 # undef DIM_4d 219 298 # define ROUTINE_NFD mpp_nfd_4d_sp 299 # include "mpp_nfd_generic.h90" 300 # undef ROUTINE_NFD 301 # define MULTI 302 # define ROUTINE_NFD mpp_nfd_4d_ptr_sp 303 # include "mpp_nfd_generic.h90" 304 # undef ROUTINE_NFD 305 # undef MULTI 306 # undef DIM_4d 307 # undef SINGLE_PRECISION 308 309 !! 310 !! ---- DOUBLE PRECISION VERSIONS 311 !! 312 # define DIM_2d 313 # define ROUTINE_NFD mpp_nfd_2d_dp 314 # include "mpp_nfd_generic.h90" 315 # undef ROUTINE_NFD 316 # define MULTI 317 # define ROUTINE_NFD mpp_nfd_2d_ptr_dp 318 # include "mpp_nfd_generic.h90" 319 # undef ROUTINE_NFD 320 # undef MULTI 321 # undef DIM_2d 322 ! 323 ! !== 3D array and array of 3D pointer ==! 324 ! 325 # define DIM_3d 326 # define ROUTINE_NFD mpp_nfd_3d_dp 327 # include "mpp_nfd_generic.h90" 328 # undef ROUTINE_NFD 329 # define MULTI 330 # define ROUTINE_NFD mpp_nfd_3d_ptr_dp 331 # include "mpp_nfd_generic.h90" 332 # undef ROUTINE_NFD 333 # undef MULTI 334 # undef DIM_3d 335 ! 336 ! !== 4D array and array of 4D pointer ==! 337 ! 338 # define DIM_4d 339 # define ROUTINE_NFD mpp_nfd_4d_dp 340 # include "mpp_nfd_generic.h90" 341 # undef ROUTINE_NFD 342 # define MULTI 343 # define ROUTINE_NFD mpp_nfd_4d_ptr_dp 344 # include "mpp_nfd_generic.h90" 345 # undef ROUTINE_NFD 346 # undef MULTI 347 # undef DIM_4d 220 348 221 349 !!====================================================================== 222 350 223 351 224 225 SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, kextj) 226 !!--------------------------------------------------------------------- 352 !!====================================================================== 353 !!--------------------------------------------------------------------- 227 354 !! *** routine mpp_lbc_north_icb *** 228 355 !! … … 240 367 !! 241 368 !!---------------------------------------------------------------------- 242 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array with extra halo 243 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 244 ! ! = T , U , V , F or W -points 245 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the 246 !! ! north fold, = 1. otherwise 247 INTEGER , INTENT(in ) :: kextj ! Extra halo width at north fold 248 ! 249 INTEGER :: ji, jj, jr 250 INTEGER :: ierr, itaille, ildi, ilei, iilb 251 INTEGER :: ipj, ij, iproc 252 ! 253 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 254 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 255 !!---------------------------------------------------------------------- 256 #if defined key_mpp_mpi 257 ! 258 ipj=4 259 ALLOCATE( ztab_e(jpiglo, 1-kextj:ipj+kextj) , & 260 & znorthloc_e(jpimax, 1-kextj:ipj+kextj) , & 261 & znorthgloio_e(jpimax, 1-kextj:ipj+kextj,jpni) ) 262 ! 263 ztab_e(:,:) = 0._wp 264 znorthloc_e(:,:) = 0._wp 265 ! 266 ij = 1 - kextj 267 ! put the last ipj+2*kextj lines of pt2d into znorthloc_e 268 DO jj = jpj - ipj + 1 - kextj , jpj + kextj 269 znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj) 270 ij = ij + 1 271 END DO 272 ! 273 itaille = jpimax * ( ipj + 2*kextj ) 274 ! 275 IF( ln_timing ) CALL tic_tac(.TRUE.) 276 CALL MPI_ALLGATHER( znorthloc_e(1,1-kextj) , itaille, MPI_DOUBLE_PRECISION, & 277 & znorthgloio_e(1,1-kextj,1), itaille, MPI_DOUBLE_PRECISION, & 278 & ncomm_north, ierr ) 279 ! 280 IF( ln_timing ) CALL tic_tac(.FALSE.) 281 ! 282 DO jr = 1, ndim_rank_north ! recover the global north array 283 iproc = nrank_north(jr) + 1 284 ildi = nldit (iproc) 285 ilei = nleit (iproc) 286 iilb = nimppt(iproc) 287 DO jj = 1-kextj, ipj+kextj 288 DO ji = ildi, ilei 289 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 290 END DO 291 END DO 292 END DO 293 294 ! 2. North-Fold boundary conditions 295 ! ---------------------------------- 296 CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj ) 297 298 ij = 1 - kextj 299 !! Scatter back to pt2d 300 DO jj = jpj - ipj + 1 - kextj , jpj + kextj 301 DO ji= 1, jpi 302 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 303 END DO 304 ij = ij +1 305 END DO 306 ! 307 DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 308 ! 309 #endif 310 END SUBROUTINE mpp_lbc_north_icb 311 312 313 SUBROUTINE mpp_lnk_2d_icb( cdname, pt2d, cd_type, psgn, kexti, kextj ) 369 # define SINGLE_PRECISION 370 # define ROUTINE_LNK mpp_lbc_north_icb_sp 371 # include "mpp_lbc_north_icb_generic.h90" 372 # undef ROUTINE_LNK 373 # undef SINGLE_PRECISION 374 # define ROUTINE_LNK mpp_lbc_north_icb_dp 375 # include "mpp_lbc_north_icb_generic.h90" 376 # undef ROUTINE_LNK 377 378 314 379 !!---------------------------------------------------------------------- 315 380 !! *** routine mpp_lnk_2d_icb *** … … 333 398 !! nono : number for local neighboring processors 334 399 !!---------------------------------------------------------------------- 335 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 336 REAL(wp), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) :: pt2d ! 2D array with extra halo 337 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 338 REAL(wp) , INTENT(in ) :: psgn ! sign used across the north fold 339 INTEGER , INTENT(in ) :: kexti ! extra i-halo width 340 INTEGER , INTENT(in ) :: kextj ! extra j-halo width 341 ! 342 INTEGER :: jl ! dummy loop indices 343 INTEGER :: imigr, iihom, ijhom ! local integers 344 INTEGER :: ipreci, iprecj ! - - 345 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 346 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 347 !! 348 REAL(wp), DIMENSION(1-kexti:jpi+kexti,nn_hls+kextj,2) :: r2dns, r2dsn 349 REAL(wp), DIMENSION(1-kextj:jpj+kextj,nn_hls+kexti,2) :: r2dwe, r2dew 350 !!---------------------------------------------------------------------- 351 352 ipreci = nn_hls + kexti ! take into account outer extra 2D overlap area 353 iprecj = nn_hls + kextj 354 355 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, 1, 1, 1, ld_lbc = .TRUE. ) 356 357 ! 1. standard boundary treatment 358 ! ------------------------------ 359 ! Order matters Here !!!! 360 ! 361 ! ! East-West boundaries 362 ! !* Cyclic east-west 363 IF( l_Iperio ) THEN 364 pt2d(1-kexti: 1 ,:) = pt2d(jpim1-kexti: jpim1 ,:) ! east 365 pt2d( jpi :jpi+kexti,:) = pt2d( 2 :2+kexti,:) ! west 366 ! 367 ELSE !* closed 368 IF( .NOT. cd_type == 'F' ) pt2d( 1-kexti :nn_hls ,:) = 0._wp ! east except at F-point 369 pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp ! west 370 ENDIF 371 ! ! North-South boundaries 372 IF( l_Jperio ) THEN !* cyclic (only with no mpp j-split) 373 pt2d(:,1-kextj: 1 ) = pt2d(:,jpjm1-kextj: jpjm1) ! north 374 pt2d(:, jpj :jpj+kextj) = pt2d(:, 2 :2+kextj) ! south 375 ELSE !* closed 376 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-kextj :nn_hls ) = 0._wp ! north except at F-point 377 pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._wp ! south 378 ENDIF 379 ! 380 381 ! north fold treatment 382 ! ----------------------- 383 IF( npolj /= 0 ) THEN 384 ! 385 SELECT CASE ( jpni ) 386 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) 387 CASE DEFAULT ; CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) 388 END SELECT 389 ! 390 ENDIF 391 392 ! 2. East and west directions exchange 393 ! ------------------------------------ 394 ! we play with the neigbours AND the row number because of the periodicity 395 ! 396 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 397 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 398 iihom = jpi-nreci-kexti 399 DO jl = 1, ipreci 400 r2dew(:,jl,1) = pt2d(nn_hls+jl,:) 401 r2dwe(:,jl,1) = pt2d(iihom +jl,:) 402 END DO 403 END SELECT 404 ! 405 ! ! Migrations 406 imigr = ipreci * ( jpj + 2*kextj ) 407 ! 408 IF( ln_timing ) CALL tic_tac(.TRUE.) 409 ! 410 SELECT CASE ( nbondi ) 411 CASE ( -1 ) 412 CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 ) 413 CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 414 CALL mpi_wait(ml_req1,ml_stat,ml_err) 415 CASE ( 0 ) 416 CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 417 CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 ) 418 CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 419 CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 420 CALL mpi_wait(ml_req1,ml_stat,ml_err) 421 CALL mpi_wait(ml_req2,ml_stat,ml_err) 422 CASE ( 1 ) 423 CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 424 CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 425 CALL mpi_wait(ml_req1,ml_stat,ml_err) 426 END SELECT 427 ! 428 IF( ln_timing ) CALL tic_tac(.FALSE.) 429 ! 430 ! ! Write Dirichlet lateral conditions 431 iihom = jpi - nn_hls 432 ! 433 SELECT CASE ( nbondi ) 434 CASE ( -1 ) 435 DO jl = 1, ipreci 436 pt2d(iihom+jl,:) = r2dew(:,jl,2) 437 END DO 438 CASE ( 0 ) 439 DO jl = 1, ipreci 440 pt2d(jl-kexti,:) = r2dwe(:,jl,2) 441 pt2d(iihom+jl,:) = r2dew(:,jl,2) 442 END DO 443 CASE ( 1 ) 444 DO jl = 1, ipreci 445 pt2d(jl-kexti,:) = r2dwe(:,jl,2) 446 END DO 447 END SELECT 448 449 450 ! 3. North and south directions 451 ! ----------------------------- 452 ! always closed : we play only with the neigbours 453 ! 454 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 455 ijhom = jpj-nrecj-kextj 456 DO jl = 1, iprecj 457 r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 458 r2dns(:,jl,1) = pt2d(:,nn_hls+jl) 459 END DO 460 ENDIF 461 ! 462 ! ! Migrations 463 imigr = iprecj * ( jpi + 2*kexti ) 464 ! 465 IF( ln_timing ) CALL tic_tac(.TRUE.) 466 ! 467 SELECT CASE ( nbondj ) 468 CASE ( -1 ) 469 CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 ) 470 CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 471 CALL mpi_wait(ml_req1,ml_stat,ml_err) 472 CASE ( 0 ) 473 CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 474 CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 ) 475 CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 476 CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 477 CALL mpi_wait(ml_req1,ml_stat,ml_err) 478 CALL mpi_wait(ml_req2,ml_stat,ml_err) 479 CASE ( 1 ) 480 CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 481 CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 482 CALL mpi_wait(ml_req1,ml_stat,ml_err) 483 END SELECT 484 ! 485 IF( ln_timing ) CALL tic_tac(.FALSE.) 486 ! 487 ! ! Write Dirichlet lateral conditions 488 ijhom = jpj - nn_hls 489 ! 490 SELECT CASE ( nbondj ) 491 CASE ( -1 ) 492 DO jl = 1, iprecj 493 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 494 END DO 495 CASE ( 0 ) 496 DO jl = 1, iprecj 497 pt2d(:,jl-kextj) = r2dsn(:,jl,2) 498 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 499 END DO 500 CASE ( 1 ) 501 DO jl = 1, iprecj 502 pt2d(:,jl-kextj) = r2dsn(:,jl,2) 503 END DO 504 END SELECT 505 ! 506 END SUBROUTINE mpp_lnk_2d_icb 507 400 401 # define SINGLE_PRECISION 402 # define ROUTINE_LNK mpp_lnk_2d_icb_sp 403 # include "mpp_lnk_icb_generic.h90" 404 # undef ROUTINE_LNK 405 # undef SINGLE_PRECISION 406 # define ROUTINE_LNK mpp_lnk_2d_icb_dp 407 # include "mpp_lnk_icb_generic.h90" 408 # undef ROUTINE_LNK 409 508 410 END MODULE lbclnk 509 411 -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lbcnfd.F90
r11536 r12603 26 26 27 27 INTERFACE lbc_nfd 28 MODULE PROCEDURE lbc_nfd_2d , lbc_nfd_3d , lbc_nfd_4d 29 MODULE PROCEDURE lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr 30 MODULE PROCEDURE lbc_nfd_2d_ext 28 MODULE PROCEDURE lbc_nfd_2d_sp , lbc_nfd_3d_sp , lbc_nfd_4d_sp 29 MODULE PROCEDURE lbc_nfd_2d_ptr_sp, lbc_nfd_3d_ptr_sp, lbc_nfd_4d_ptr_sp 30 MODULE PROCEDURE lbc_nfd_2d_ext_sp 31 MODULE PROCEDURE lbc_nfd_2d_dp , lbc_nfd_3d_dp , lbc_nfd_4d_dp 32 MODULE PROCEDURE lbc_nfd_2d_ptr_dp, lbc_nfd_3d_ptr_dp, lbc_nfd_4d_ptr_dp 33 MODULE PROCEDURE lbc_nfd_2d_ext_dp 31 34 END INTERFACE 32 35 ! 33 36 INTERFACE lbc_nfd_nogather 34 37 ! ! Currently only 4d array version is needed 35 MODULE PROCEDURE lbc_nfd_nogather_2d , lbc_nfd_nogather_3d 36 MODULE PROCEDURE lbc_nfd_nogather_4d 37 MODULE PROCEDURE lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr 38 MODULE PROCEDURE lbc_nfd_nogather_2d_sp , lbc_nfd_nogather_3d_sp 39 MODULE PROCEDURE lbc_nfd_nogather_4d_sp 40 MODULE PROCEDURE lbc_nfd_nogather_2d_ptr_sp, lbc_nfd_nogather_3d_ptr_sp 41 MODULE PROCEDURE lbc_nfd_nogather_2d_dp , lbc_nfd_nogather_3d_dp 42 MODULE PROCEDURE lbc_nfd_nogather_4d_dp 43 MODULE PROCEDURE lbc_nfd_nogather_2d_ptr_dp, lbc_nfd_nogather_3d_ptr_dp 38 44 ! MODULE PROCEDURE lbc_nfd_nogather_4d_ptr 39 45 END INTERFACE 40 46 41 TYPE, PUBLIC :: PTR_2D !: array of 2D pointers (also used in lib_mpp) 42 REAL(wp), DIMENSION (:,:) , POINTER :: pt2d 43 END TYPE PTR_2D 44 TYPE, PUBLIC :: PTR_3D !: array of 3D pointers (also used in lib_mpp) 45 REAL(wp), DIMENSION (:,:,:) , POINTER :: pt3d 46 END TYPE PTR_3D 47 TYPE, PUBLIC :: PTR_4D !: array of 4D pointers (also used in lib_mpp) 48 REAL(wp), DIMENSION (:,:,:,:), POINTER :: pt4d 49 END TYPE PTR_4D 47 TYPE, PUBLIC :: PTR_2D_dp !: array of 2D pointers (also used in lib_mpp) 48 REAL(dp), DIMENSION (:,:) , POINTER :: pt2d 49 END TYPE PTR_2D_dp 50 TYPE, PUBLIC :: PTR_3D_dp !: array of 3D pointers (also used in lib_mpp) 51 REAL(dp), DIMENSION (:,:,:) , POINTER :: pt3d 52 END TYPE PTR_3D_dp 53 TYPE, PUBLIC :: PTR_4D_dp !: array of 4D pointers (also used in lib_mpp) 54 REAL(dp), DIMENSION (:,:,:,:), POINTER :: pt4d 55 END TYPE PTR_4D_dp 56 57 TYPE, PUBLIC :: PTR_2D_sp !: array of 2D pointers (also used in lib_mpp) 58 REAL(sp), DIMENSION (:,:) , POINTER :: pt2d 59 END TYPE PTR_2D_sp 60 TYPE, PUBLIC :: PTR_3D_sp !: array of 3D pointers (also used in lib_mpp) 61 REAL(sp), DIMENSION (:,:,:) , POINTER :: pt3d 62 END TYPE PTR_3D_sp 63 TYPE, PUBLIC :: PTR_4D_sp !: array of 4D pointers (also used in lib_mpp) 64 REAL(sp), DIMENSION (:,:,:,:), POINTER :: pt4d 65 END TYPE PTR_4D_sp 66 50 67 51 68 PUBLIC lbc_nfd ! north fold conditions … … 75 92 !!---------------------------------------------------------------------- 76 93 ! 77 ! !== 2D array and array of 2D pointer ==! 78 ! 79 # define DIM_2d 80 # define ROUTINE_NFD lbc_nfd_2d 81 # include "lbc_nfd_generic.h90" 82 # undef ROUTINE_NFD 83 # define MULTI 84 # define ROUTINE_NFD lbc_nfd_2d_ptr 94 ! !== SINGLE PRECISION VERSIONS 95 ! 96 ! 97 ! !== 2D array and array of 2D pointer ==! 98 ! 99 # define SINGLE_PRECISION 100 # define DIM_2d 101 # define ROUTINE_NFD lbc_nfd_2d_sp 102 # include "lbc_nfd_generic.h90" 103 # undef ROUTINE_NFD 104 # define MULTI 105 # define ROUTINE_NFD lbc_nfd_2d_ptr_sp 85 106 # include "lbc_nfd_generic.h90" 86 107 # undef ROUTINE_NFD … … 91 112 ! 92 113 # define DIM_2d 93 # define ROUTINE_NFD lbc_nfd_2d_ext 114 # define ROUTINE_NFD lbc_nfd_2d_ext_sp 94 115 # include "lbc_nfd_ext_generic.h90" 95 116 # undef ROUTINE_NFD … … 99 120 ! 100 121 # define DIM_3d 101 # define ROUTINE_NFD lbc_nfd_3d 102 # include "lbc_nfd_generic.h90" 103 # undef ROUTINE_NFD 104 # define MULTI 105 # define ROUTINE_NFD lbc_nfd_3d_ptr 106 # include "lbc_nfd_generic.h90" 107 # undef ROUTINE_NFD 108 # undef MULTI 109 # undef DIM_3d 110 ! 111 ! !== 4D array and array of 4D pointer ==! 112 ! 113 # define DIM_4d 114 # define ROUTINE_NFD lbc_nfd_4d 115 # include "lbc_nfd_generic.h90" 116 # undef ROUTINE_NFD 117 # define MULTI 118 # define ROUTINE_NFD lbc_nfd_4d_ptr 122 # define ROUTINE_NFD lbc_nfd_3d_sp 123 # include "lbc_nfd_generic.h90" 124 # undef ROUTINE_NFD 125 # define MULTI 126 # define ROUTINE_NFD lbc_nfd_3d_ptr_sp 127 # include "lbc_nfd_generic.h90" 128 # undef ROUTINE_NFD 129 # undef MULTI 130 # undef DIM_3d 131 ! 132 ! !== 4D array and array of 4D pointer ==! 133 ! 134 # define DIM_4d 135 # define ROUTINE_NFD lbc_nfd_4d_sp 136 # include "lbc_nfd_generic.h90" 137 # undef ROUTINE_NFD 138 # define MULTI 139 # define ROUTINE_NFD lbc_nfd_4d_ptr_sp 119 140 # include "lbc_nfd_generic.h90" 120 141 # undef ROUTINE_NFD … … 127 148 ! 128 149 # define DIM_2d 129 # define ROUTINE_NFD lbc_nfd_nogather_2d 130 # include "lbc_nfd_nogather_generic.h90" 131 # undef ROUTINE_NFD 132 # define MULTI 133 # define ROUTINE_NFD lbc_nfd_nogather_2d_ptr 134 # include "lbc_nfd_nogather_generic.h90" 135 # undef ROUTINE_NFD 136 # undef MULTI 137 # undef DIM_2d 138 ! 139 ! !== 3D array and array of 3D pointer ==! 140 ! 141 # define DIM_3d 142 # define ROUTINE_NFD lbc_nfd_nogather_3d 143 # include "lbc_nfd_nogather_generic.h90" 144 # undef ROUTINE_NFD 145 # define MULTI 146 # define ROUTINE_NFD lbc_nfd_nogather_3d_ptr 147 # include "lbc_nfd_nogather_generic.h90" 148 # undef ROUTINE_NFD 149 # undef MULTI 150 # undef DIM_3d 151 ! 152 ! !== 4D array and array of 4D pointer ==! 153 ! 154 # define DIM_4d 155 # define ROUTINE_NFD lbc_nfd_nogather_4d 150 # define ROUTINE_NFD lbc_nfd_nogather_2d_sp 151 # include "lbc_nfd_nogather_generic.h90" 152 # undef ROUTINE_NFD 153 # define MULTI 154 # define ROUTINE_NFD lbc_nfd_nogather_2d_ptr_sp 155 # include "lbc_nfd_nogather_generic.h90" 156 # undef ROUTINE_NFD 157 # undef MULTI 158 # undef DIM_2d 159 ! 160 ! !== 3D array and array of 3D pointer ==! 161 ! 162 # define DIM_3d 163 # define ROUTINE_NFD lbc_nfd_nogather_3d_sp 164 # include "lbc_nfd_nogather_generic.h90" 165 # undef ROUTINE_NFD 166 # define MULTI 167 # define ROUTINE_NFD lbc_nfd_nogather_3d_ptr_sp 168 # include "lbc_nfd_nogather_generic.h90" 169 # undef ROUTINE_NFD 170 # undef MULTI 171 # undef DIM_3d 172 ! 173 ! !== 4D array and array of 4D pointer ==! 174 ! 175 # define DIM_4d 176 # define ROUTINE_NFD lbc_nfd_nogather_4d_sp 156 177 # include "lbc_nfd_nogather_generic.h90" 157 178 # undef ROUTINE_NFD … … 162 183 !# undef MULTI 163 184 # undef DIM_4d 164 165 !!---------------------------------------------------------------------- 185 # undef SINGLE_PRECISION 186 187 !!---------------------------------------------------------------------- 188 ! 189 ! !== DOUBLE PRECISION VERSIONS 190 ! 191 ! 192 ! !== 2D array and array of 2D pointer ==! 193 ! 194 # define DIM_2d 195 # define ROUTINE_NFD lbc_nfd_2d_dp 196 # include "lbc_nfd_generic.h90" 197 # undef ROUTINE_NFD 198 # define MULTI 199 # define ROUTINE_NFD lbc_nfd_2d_ptr_dp 200 # include "lbc_nfd_generic.h90" 201 # undef ROUTINE_NFD 202 # undef MULTI 203 # undef DIM_2d 204 ! 205 ! !== 2D array with extra haloes ==! 206 ! 207 # define DIM_2d 208 # define ROUTINE_NFD lbc_nfd_2d_ext_dp 209 # include "lbc_nfd_ext_generic.h90" 210 # undef ROUTINE_NFD 211 # undef DIM_2d 212 ! 213 ! !== 3D array and array of 3D pointer ==! 214 ! 215 # define DIM_3d 216 # define ROUTINE_NFD lbc_nfd_3d_dp 217 # include "lbc_nfd_generic.h90" 218 # undef ROUTINE_NFD 219 # define MULTI 220 # define ROUTINE_NFD lbc_nfd_3d_ptr_dp 221 # include "lbc_nfd_generic.h90" 222 # undef ROUTINE_NFD 223 # undef MULTI 224 # undef DIM_3d 225 ! 226 ! !== 4D array and array of 4D pointer ==! 227 ! 228 # define DIM_4d 229 # define ROUTINE_NFD lbc_nfd_4d_dp 230 # include "lbc_nfd_generic.h90" 231 # undef ROUTINE_NFD 232 # define MULTI 233 # define ROUTINE_NFD lbc_nfd_4d_ptr_dp 234 # include "lbc_nfd_generic.h90" 235 # undef ROUTINE_NFD 236 # undef MULTI 237 # undef DIM_4d 238 ! 239 ! lbc_nfd_nogather routines 240 ! 241 ! !== 2D array and array of 2D pointer ==! 242 ! 243 # define DIM_2d 244 # define ROUTINE_NFD lbc_nfd_nogather_2d_dp 245 # include "lbc_nfd_nogather_generic.h90" 246 # undef ROUTINE_NFD 247 # define MULTI 248 # define ROUTINE_NFD lbc_nfd_nogather_2d_ptr_dp 249 # include "lbc_nfd_nogather_generic.h90" 250 # undef ROUTINE_NFD 251 # undef MULTI 252 # undef DIM_2d 253 ! 254 ! !== 3D array and array of 3D pointer ==! 255 ! 256 # define DIM_3d 257 # define ROUTINE_NFD lbc_nfd_nogather_3d_dp 258 # include "lbc_nfd_nogather_generic.h90" 259 # undef ROUTINE_NFD 260 # define MULTI 261 # define ROUTINE_NFD lbc_nfd_nogather_3d_ptr_dp 262 # include "lbc_nfd_nogather_generic.h90" 263 # undef ROUTINE_NFD 264 # undef MULTI 265 # undef DIM_3d 266 ! 267 ! !== 4D array and array of 4D pointer ==! 268 ! 269 # define DIM_4d 270 # define ROUTINE_NFD lbc_nfd_nogather_4d_dp 271 # include "lbc_nfd_nogather_generic.h90" 272 # undef ROUTINE_NFD 273 !# define MULTI 274 !# define ROUTINE_NFD lbc_nfd_nogather_4d_ptr 275 !# include "lbc_nfd_nogather_generic.h90" 276 !# undef ROUTINE_NFD 277 !# undef MULTI 278 # undef DIM_4d 279 280 !!---------------------------------------------------------------------- 281 166 282 167 283 -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lib_mpp.F90
r12512 r12603 67 67 PUBLIC mpp_ini_znl 68 68 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 69 PUBLIC mppsend_sp, mpprecv_sp ! needed by TAM and ICB routines 70 PUBLIC mppsend_dp, mpprecv_dp ! needed by TAM and ICB routines 69 71 PUBLIC mpp_report 70 72 PUBLIC mpp_bcast_nml … … 79 81 !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ 80 82 INTERFACE mpp_min 81 MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 83 MODULE PROCEDURE mppmin_a_int, mppmin_int 84 MODULE PROCEDURE mppmin_a_real_sp, mppmin_real_sp 85 MODULE PROCEDURE mppmin_a_real_dp, mppmin_real_dp 82 86 END INTERFACE 83 87 INTERFACE mpp_max 84 MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real 88 MODULE PROCEDURE mppmax_a_int, mppmax_int 89 MODULE PROCEDURE mppmax_a_real_sp, mppmax_real_sp 90 MODULE PROCEDURE mppmax_a_real_dp, mppmax_real_dp 85 91 END INTERFACE 86 92 INTERFACE mpp_sum 87 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 88 & mppsum_realdd, mppsum_a_realdd 93 MODULE PROCEDURE mppsum_a_int, mppsum_int 94 MODULE PROCEDURE mppsum_realdd, mppsum_a_realdd 95 MODULE PROCEDURE mppsum_a_real_sp, mppsum_real_sp 96 MODULE PROCEDURE mppsum_a_real_dp, mppsum_real_dp 89 97 END INTERFACE 90 98 INTERFACE mpp_minloc 91 MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 99 MODULE PROCEDURE mpp_minloc2d_sp ,mpp_minloc3d_sp 100 MODULE PROCEDURE mpp_minloc2d_dp ,mpp_minloc3d_dp 92 101 END INTERFACE 93 102 INTERFACE mpp_maxloc 94 MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 103 MODULE PROCEDURE mpp_maxloc2d_sp ,mpp_maxloc3d_sp 104 MODULE PROCEDURE mpp_maxloc2d_dp ,mpp_maxloc3d_dp 95 105 END INTERFACE 96 106 … … 158 168 TYPE, PUBLIC :: DELAYARR 159 169 REAL( wp), POINTER, DIMENSION(:) :: z1d => NULL() 160 COMPLEX( wp), POINTER, DIMENSION(:) :: y1d => NULL()170 COMPLEX(dp), POINTER, DIMENSION(:) :: y1d => NULL() 161 171 END TYPE DELAYARR 162 172 TYPE( DELAYARR ), DIMENSION(nbdelay), PUBLIC, SAVE :: todelay !: must have SAVE for default initialization of DELAYARR … … 164 174 165 175 ! timing summary report 166 REAL( wp), DIMENSION(2), PUBLIC :: waiting_time = 0._wp167 REAL( wp) , PUBLIC :: compute_time = 0._wp, elapsed_time = 0._wp176 REAL(dp), DIMENSION(2), PUBLIC :: waiting_time = 0._dp 177 REAL(dp) , PUBLIC :: compute_time = 0._dp, elapsed_time = 0._dp 168 178 169 179 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend … … 260 270 261 271 272 SUBROUTINE mppsend_dp( ktyp, pmess, kbytes, kdest, md_req ) 273 !!---------------------------------------------------------------------- 274 !! *** routine mppsend *** 275 !! 276 !! ** Purpose : Send messag passing array 277 !! 278 !!---------------------------------------------------------------------- 279 REAL(dp), INTENT(inout) :: pmess(*) ! array of real 280 INTEGER , INTENT(in ) :: kbytes ! size of the array pmess 281 INTEGER , INTENT(in ) :: kdest ! receive process number 282 INTEGER , INTENT(in ) :: ktyp ! tag of the message 283 INTEGER , INTENT(in ) :: md_req ! argument for isend 284 !! 285 INTEGER :: iflag 286 !!---------------------------------------------------------------------- 287 ! 288 #if defined key_mpp_mpi 289 CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 290 #endif 291 ! 292 END SUBROUTINE mppsend_dp 293 294 295 SUBROUTINE mppsend_sp( ktyp, pmess, kbytes, kdest, md_req ) 296 !!---------------------------------------------------------------------- 297 !! *** routine mppsend *** 298 !! 299 !! ** Purpose : Send messag passing array 300 !! 301 !!---------------------------------------------------------------------- 302 REAL(sp), INTENT(inout) :: pmess(*) ! array of real 303 INTEGER , INTENT(in ) :: kbytes ! size of the array pmess 304 INTEGER , INTENT(in ) :: kdest ! receive process number 305 INTEGER , INTENT(in ) :: ktyp ! tag of the message 306 INTEGER , INTENT(in ) :: md_req ! argument for isend 307 !! 308 INTEGER :: iflag 309 !!---------------------------------------------------------------------- 310 ! 311 #if defined key_mpp_mpi 312 CALL mpi_isend( pmess, kbytes, mpi_real, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 313 #endif 314 ! 315 END SUBROUTINE mppsend_sp 316 317 262 318 SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource ) 263 319 !!---------------------------------------------------------------------- … … 288 344 END SUBROUTINE mpprecv 289 345 346 SUBROUTINE mpprecv_dp( ktyp, pmess, kbytes, ksource ) 347 !!---------------------------------------------------------------------- 348 !! *** routine mpprecv *** 349 !! 350 !! ** Purpose : Receive messag passing array 351 !! 352 !!---------------------------------------------------------------------- 353 REAL(dp), INTENT(inout) :: pmess(*) ! array of real 354 INTEGER , INTENT(in ) :: kbytes ! suze of the array pmess 355 INTEGER , INTENT(in ) :: ktyp ! Tag of the recevied message 356 INTEGER, OPTIONAL, INTENT(in) :: ksource ! source process number 357 !! 358 INTEGER :: istatus(mpi_status_size) 359 INTEGER :: iflag 360 INTEGER :: use_source 361 !!---------------------------------------------------------------------- 362 ! 363 #if defined key_mpp_mpi 364 ! If a specific process number has been passed to the receive call, 365 ! use that one. Default is to use mpi_any_source 366 use_source = mpi_any_source 367 IF( PRESENT(ksource) ) use_source = ksource 368 ! 369 CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 370 #endif 371 ! 372 END SUBROUTINE mpprecv_dp 373 374 375 SUBROUTINE mpprecv_sp( ktyp, pmess, kbytes, ksource ) 376 !!---------------------------------------------------------------------- 377 !! *** routine mpprecv *** 378 !! 379 !! ** Purpose : Receive messag passing array 380 !! 381 !!---------------------------------------------------------------------- 382 REAL(sp), INTENT(inout) :: pmess(*) ! array of real 383 INTEGER , INTENT(in ) :: kbytes ! suze of the array pmess 384 INTEGER , INTENT(in ) :: ktyp ! Tag of the recevied message 385 INTEGER, OPTIONAL, INTENT(in) :: ksource ! source process number 386 !! 387 INTEGER :: istatus(mpi_status_size) 388 INTEGER :: iflag 389 INTEGER :: use_source 390 !!---------------------------------------------------------------------- 391 ! 392 #if defined key_mpp_mpi 393 ! If a specific process number has been passed to the receive call, 394 ! use that one. Default is to use mpi_any_source 395 use_source = mpi_any_source 396 IF( PRESENT(ksource) ) use_source = ksource 397 ! 398 CALL mpi_recv( pmess, kbytes, mpi_real, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 399 #endif 400 ! 401 END SUBROUTINE mpprecv_sp 402 290 403 291 404 SUBROUTINE mppgather( ptab, kp, pio ) … … 351 464 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 352 465 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 353 COMPLEX( wp), INTENT(in ), DIMENSION(:) :: y_in466 COMPLEX(dp), INTENT(in ), DIMENSION(:) :: y_in 354 467 REAL(wp), INTENT( out), DIMENSION(:) :: pout 355 468 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine … … 359 472 INTEGER :: idvar 360 473 INTEGER :: ierr, ilocalcomm 361 COMPLEX( wp), ALLOCATABLE, DIMENSION(:) :: ytmp474 COMPLEX(dp), ALLOCATABLE, DIMENSION(:) :: ytmp 362 475 !!---------------------------------------------------------------------- 363 476 #if defined key_mpp_mpi … … 432 545 INTEGER :: idvar 433 546 INTEGER :: ierr, ilocalcomm 434 !!---------------------------------------------------------------------- 435 #if defined key_mpp_mpi 547 INTEGER :: MPI_TYPE 548 !!---------------------------------------------------------------------- 549 550 #if defined key_mpp_mpi 551 if( wp == dp ) then 552 MPI_TYPE = MPI_DOUBLE_PRECISION 553 else if ( wp == sp ) then 554 MPI_TYPE = MPI_REAL 555 else 556 CALL ctl_stop( "Error defining type, wp is neither dp nor sp" ) 557 558 end if 559 436 560 ilocalcomm = mpi_comm_oce 437 561 IF( PRESENT(kcom) ) ilocalcomm = kcom … … 470 594 # if defined key_mpi2 471 595 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 472 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) 473 ndelayid(idvar) = 1 596 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar), ierr ) 474 597 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 475 598 # else 476 CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_ DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )599 CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar), ierr ) 477 600 # endif 478 601 #else … … 551 674 # undef INTEGER_TYPE 552 675 ! 676 !! 677 !! ---- SINGLE PRECISION VERSIONS 678 !! 679 # define SINGLE_PRECISION 553 680 # define REAL_TYPE 554 681 # define DIM_0d 555 # define ROUTINE_ALLREDUCE mppmax_real 682 # define ROUTINE_ALLREDUCE mppmax_real_sp 556 683 # include "mpp_allreduce_generic.h90" 557 684 # undef ROUTINE_ALLREDUCE 558 685 # undef DIM_0d 559 686 # define DIM_1d 560 # define ROUTINE_ALLREDUCE mppmax_a_real 687 # define ROUTINE_ALLREDUCE mppmax_a_real_sp 688 # include "mpp_allreduce_generic.h90" 689 # undef ROUTINE_ALLREDUCE 690 # undef DIM_1d 691 # undef SINGLE_PRECISION 692 !! 693 !! 694 !! ---- DOUBLE PRECISION VERSIONS 695 !! 696 ! 697 # define DIM_0d 698 # define ROUTINE_ALLREDUCE mppmax_real_dp 699 # include "mpp_allreduce_generic.h90" 700 # undef ROUTINE_ALLREDUCE 701 # undef DIM_0d 702 # define DIM_1d 703 # define ROUTINE_ALLREDUCE mppmax_a_real_dp 561 704 # include "mpp_allreduce_generic.h90" 562 705 # undef ROUTINE_ALLREDUCE … … 583 726 # undef INTEGER_TYPE 584 727 ! 728 !! 729 !! ---- SINGLE PRECISION VERSIONS 730 !! 731 # define SINGLE_PRECISION 585 732 # define REAL_TYPE 586 733 # define DIM_0d 587 # define ROUTINE_ALLREDUCE mppmin_real 734 # define ROUTINE_ALLREDUCE mppmin_real_sp 588 735 # include "mpp_allreduce_generic.h90" 589 736 # undef ROUTINE_ALLREDUCE 590 737 # undef DIM_0d 591 738 # define DIM_1d 592 # define ROUTINE_ALLREDUCE mppmin_a_real 739 # define ROUTINE_ALLREDUCE mppmin_a_real_sp 740 # include "mpp_allreduce_generic.h90" 741 # undef ROUTINE_ALLREDUCE 742 # undef DIM_1d 743 # undef SINGLE_PRECISION 744 !! 745 !! ---- DOUBLE PRECISION VERSIONS 746 !! 747 748 # define DIM_0d 749 # define ROUTINE_ALLREDUCE mppmin_real_dp 750 # include "mpp_allreduce_generic.h90" 751 # undef ROUTINE_ALLREDUCE 752 # undef DIM_0d 753 # define DIM_1d 754 # define ROUTINE_ALLREDUCE mppmin_a_real_dp 593 755 # include "mpp_allreduce_generic.h90" 594 756 # undef ROUTINE_ALLREDUCE … … 616 778 # undef DIM_1d 617 779 # undef INTEGER_TYPE 618 ! 780 781 !! 782 !! ---- SINGLE PRECISION VERSIONS 783 !! 784 # define OPERATION_SUM 785 # define SINGLE_PRECISION 619 786 # define REAL_TYPE 620 787 # define DIM_0d 621 # define ROUTINE_ALLREDUCE mppsum_real 788 # define ROUTINE_ALLREDUCE mppsum_real_sp 622 789 # include "mpp_allreduce_generic.h90" 623 790 # undef ROUTINE_ALLREDUCE 624 791 # undef DIM_0d 625 792 # define DIM_1d 626 # define ROUTINE_ALLREDUCE mppsum_a_real 793 # define ROUTINE_ALLREDUCE mppsum_a_real_sp 794 # include "mpp_allreduce_generic.h90" 795 # undef ROUTINE_ALLREDUCE 796 # undef DIM_1d 797 # undef REAL_TYPE 798 # undef OPERATION_SUM 799 800 # undef SINGLE_PRECISION 801 802 !! 803 !! ---- DOUBLE PRECISION VERSIONS 804 !! 805 # define OPERATION_SUM 806 # define REAL_TYPE 807 # define DIM_0d 808 # define ROUTINE_ALLREDUCE mppsum_real_dp 809 # include "mpp_allreduce_generic.h90" 810 # undef ROUTINE_ALLREDUCE 811 # undef DIM_0d 812 # define DIM_1d 813 # define ROUTINE_ALLREDUCE mppsum_a_real_dp 627 814 # include "mpp_allreduce_generic.h90" 628 815 # undef ROUTINE_ALLREDUCE … … 651 838 !!---------------------------------------------------------------------- 652 839 !! 840 !! 841 !! ---- SINGLE PRECISION VERSIONS 842 !! 843 # define SINGLE_PRECISION 653 844 # define OPERATION_MINLOC 654 845 # define DIM_2d 655 # define ROUTINE_LOC mpp_minloc2d 846 # define ROUTINE_LOC mpp_minloc2d_sp 656 847 # include "mpp_loc_generic.h90" 657 848 # undef ROUTINE_LOC 658 849 # undef DIM_2d 659 850 # define DIM_3d 660 # define ROUTINE_LOC mpp_minloc3d 851 # define ROUTINE_LOC mpp_minloc3d_sp 661 852 # include "mpp_loc_generic.h90" 662 853 # undef ROUTINE_LOC … … 666 857 # define OPERATION_MAXLOC 667 858 # define DIM_2d 668 # define ROUTINE_LOC mpp_maxloc2d 859 # define ROUTINE_LOC mpp_maxloc2d_sp 669 860 # include "mpp_loc_generic.h90" 670 861 # undef ROUTINE_LOC 671 862 # undef DIM_2d 672 863 # define DIM_3d 673 # define ROUTINE_LOC mpp_maxloc3d 864 # define ROUTINE_LOC mpp_maxloc3d_sp 674 865 # include "mpp_loc_generic.h90" 675 866 # undef ROUTINE_LOC 676 867 # undef DIM_3d 677 868 # undef OPERATION_MAXLOC 869 # undef SINGLE_PRECISION 870 !! 871 !! ---- DOUBLE PRECISION VERSIONS 872 !! 873 # define OPERATION_MINLOC 874 # define DIM_2d 875 # define ROUTINE_LOC mpp_minloc2d_dp 876 # include "mpp_loc_generic.h90" 877 # undef ROUTINE_LOC 878 # undef DIM_2d 879 # define DIM_3d 880 # define ROUTINE_LOC mpp_minloc3d_dp 881 # include "mpp_loc_generic.h90" 882 # undef ROUTINE_LOC 883 # undef DIM_3d 884 # undef OPERATION_MINLOC 885 886 # define OPERATION_MAXLOC 887 # define DIM_2d 888 # define ROUTINE_LOC mpp_maxloc2d_dp 889 # include "mpp_loc_generic.h90" 890 # undef ROUTINE_LOC 891 # undef DIM_2d 892 # define DIM_3d 893 # define ROUTINE_LOC mpp_maxloc3d_dp 894 # include "mpp_loc_generic.h90" 895 # undef ROUTINE_LOC 896 # undef DIM_3d 897 # undef OPERATION_MAXLOC 898 678 899 679 900 SUBROUTINE mppsync() … … 904 1125 !!--------------------------------------------------------------------- 905 1126 INTEGER , INTENT(in) :: ilen, itype 906 COMPLEX( wp), DIMENSION(ilen), INTENT(in) :: ydda907 COMPLEX( wp), DIMENSION(ilen), INTENT(inout) :: yddb908 ! 909 REAL( wp) :: zerr, zt1, zt2 ! local work variables1127 COMPLEX(dp), DIMENSION(ilen), INTENT(in) :: ydda 1128 COMPLEX(dp), DIMENSION(ilen), INTENT(inout) :: yddb 1129 ! 1130 REAL(dp) :: zerr, zt1, zt2 ! local work variables 910 1131 INTEGER :: ji, ztmp ! local scalar 911 1132 !!--------------------------------------------------------------------- … … 1060 1281 LOGICAL, INTENT(IN) :: ld_tic 1061 1282 LOGICAL, OPTIONAL, INTENT(IN) :: ld_global 1062 REAL( wp), DIMENSION(2), SAVE :: tic_wt1063 REAL( wp), SAVE :: tic_ct = 0._wp1283 REAL(dp), DIMENSION(2), SAVE :: tic_wt 1284 REAL(dp), SAVE :: tic_ct = 0._dp 1064 1285 INTEGER :: ii 1065 1286 #if defined key_mpp_mpi … … 1074 1295 IF ( ld_tic ) THEN 1075 1296 tic_wt(ii) = MPI_Wtime() ! start count tic->tac (waiting time) 1076 IF ( tic_ct > 0.0_ wp ) compute_time = compute_time + MPI_Wtime() - tic_ct ! cumulate count tac->tic1297 IF ( tic_ct > 0.0_dp ) compute_time = compute_time + MPI_Wtime() - tic_ct ! cumulate count tac->tic 1077 1298 ELSE 1078 1299 waiting_time(ii) = waiting_time(ii) + MPI_Wtime() - tic_wt(ii) ! cumulate count tic->tac -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/mpp_allreduce_generic.h90
r12546 r12603 1 1 ! !== IN: ptab is an array ==! 2 2 # if defined REAL_TYPE 3 # define ARRAY_TYPE(i) REAL(wp) , INTENT(inout) :: ARRAY_IN(i) 4 # define TMP_TYPE(i) REAL(wp) , ALLOCATABLE :: work(i) 5 # define MPI_TYPE mpi_double_precision 3 # if defined SINGLE_PRECISION 4 # define ARRAY_TYPE(i) REAL(sp) , INTENT(inout) :: ARRAY_IN(i) 5 # define TMP_TYPE(i) REAL(sp) , ALLOCATABLE :: work(i) 6 # define MPI_TYPE mpi_real 7 # else 8 # define ARRAY_TYPE(i) REAL(dp) , INTENT(inout) :: ARRAY_IN(i) 9 # define TMP_TYPE(i) REAL(dp) , ALLOCATABLE :: work(i) 10 # define MPI_TYPE mpi_double_precision 11 # endif 6 12 # endif 7 13 # if defined INTEGER_TYPE … … 11 17 # endif 12 18 # if defined COMPLEX_TYPE 13 # define ARRAY_TYPE(i) COMPLEX( wp) , INTENT(inout) :: ARRAY_IN(i)14 # define TMP_TYPE(i) COMPLEX( wp) , ALLOCATABLE :: work(i)19 # define ARRAY_TYPE(i) COMPLEX(dp) , INTENT(inout) :: ARRAY_IN(i) 20 # define TMP_TYPE(i) COMPLEX(dp) , ALLOCATABLE :: work(i) 15 21 # define MPI_TYPE mpi_double_complex 16 22 # endif … … 75 81 END SUBROUTINE ROUTINE_ALLREDUCE 76 82 83 #undef PRECISION 77 84 #undef ARRAY_TYPE 78 85 #undef ARRAY_IN -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/mpp_lnk_generic.h90
r11536 r12603 5 5 # define OPT_K(k) ,ipf 6 6 # if defined DIM_2d 7 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D) , INTENT(inout) :: ptab(f) 7 # if defined SINGLE_PRECISION 8 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp) , INTENT(inout) :: ptab(f) 9 # else 10 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp) , INTENT(inout) :: ptab(f) 11 # endif 8 12 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 9 13 # define K_SIZE(ptab) 1 … … 11 15 # endif 12 16 # if defined DIM_3d 13 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D) , INTENT(inout) :: ptab(f) 17 # if defined SINGLE_PRECISION 18 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp) , INTENT(inout) :: ptab(f) 19 # else 20 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp) , INTENT(inout) :: ptab(f) 21 # endif 14 22 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 15 23 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) … … 17 25 # endif 18 26 # if defined DIM_4d 19 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D) , INTENT(inout) :: ptab(f) 27 # if defined SINGLE_PRECISION 28 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp) , INTENT(inout) :: ptab(f) 29 # else 30 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp) , INTENT(inout) :: ptab(f) 31 # endif 20 32 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 21 33 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) … … 23 35 # endif 24 36 #else 25 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 37 # if defined SINGLE_PRECISION 38 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 39 # else 40 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 41 # endif 26 42 # define NAT_IN(k) cd_nat 27 43 # define SGN_IN(k) psgn … … 44 60 # endif 45 61 #endif 62 63 # if defined SINGLE_PRECISION 64 # define PRECISION sp 65 # define SENDROUTINE mppsend_sp 66 # define RECVROUTINE mpprecv_sp 67 # else 68 # define PRECISION dp 69 # define SENDROUTINE mppsend_dp 70 # define RECVROUTINE mpprecv_dp 71 # endif 46 72 47 73 #if defined MULTI … … 67 93 INTEGER :: ifill_we, ifill_ea, ifill_so, ifill_no 68 94 INTEGER :: ihl ! number of ranks and rows to be communicated 69 REAL( wp) :: zland95 REAL(PRECISION) :: zland 70 96 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: istat ! for mpi_isend 71 REAL( wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsnd_we, zrcv_we, zsnd_ea, zrcv_ea ! east -west & west - east halos72 REAL( wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsnd_so, zrcv_so, zsnd_no, zrcv_no ! north-south & south-north halos97 REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsnd_we, zrcv_we, zsnd_ea, zrcv_ea ! east -west & west - east halos 98 REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsnd_so, zrcv_so, zsnd_no, zrcv_no ! north-south & south-north halos 73 99 LOGICAL :: llsend_we, llsend_ea, llsend_no, llsend_so ! communication send 74 100 LOGICAL :: llrecv_we, llrecv_ea, llrecv_no, llrecv_so ! communication receive … … 174 200 ! 175 201 ! non-blocking send of the western/eastern side using local temporary arrays 176 IF( llsend_we ) CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we )177 IF( llsend_ea ) CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea )202 IF( llsend_we ) CALL SENDROUTINE( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 203 IF( llsend_ea ) CALL SENDROUTINE( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 178 204 ! blocking receive of the western/eastern halo in local temporary arrays 179 IF( llrecv_we ) CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe )180 IF( llrecv_ea ) CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea )205 IF( llrecv_we ) CALL RECVROUTINE( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 206 IF( llrecv_ea ) CALL RECVROUTINE( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 181 207 ! 182 208 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 289 315 ! 290 316 ! non-blocking send of the southern/northern side 291 IF( llsend_so ) CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so )292 IF( llsend_no ) CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no )317 IF( llsend_so ) CALL SENDROUTINE( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 318 IF( llsend_no ) CALL SENDROUTINE( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 293 319 ! blocking receive of the southern/northern halo 294 IF( llrecv_so ) CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso )295 IF( llrecv_no ) CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono )320 IF( llrecv_so ) CALL RECVROUTINE( 4, zrcv_so(1,1,1,1,1), isize, noso ) 321 IF( llrecv_no ) CALL RECVROUTINE( 3, zrcv_no(1,1,1,1,1), isize, nono ) 296 322 ! 297 323 IF( ln_timing ) CALL tic_tac(.FALSE.) -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/mpp_loc_generic.h90
r10716 r12603 1 1 !== IN: ptab is an array ==! 2 # define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k) 3 # define MASK_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: MASK_IN(i,j,k) 2 # if defined SINGLE_PRECISION 3 # define ARRAY_TYPE(i,j,k) REAL(sp) , INTENT(in ) :: ARRAY_IN(i,j,k) 4 # define MASK_TYPE(i,j,k) REAL(sp) , INTENT(in ) :: MASK_IN(i,j,k) 5 # define PRECISION sp 6 # else 7 # define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k) 8 # define MASK_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: MASK_IN(i,j,k) 9 # define PRECISION dp 10 # endif 11 4 12 # if defined DIM_2d 5 13 # define ARRAY_IN(i,j,k) ptab(i,j) … … 30 38 ARRAY_TYPE(:,:,:) ! array on which loctrans operation is applied 31 39 MASK_TYPE(:,:,:) ! local mask 32 REAL( wp) , INTENT( out) :: pmin ! Global minimum of ptab40 REAL(PRECISION) , INTENT( out) :: pmin ! Global minimum of ptab 33 41 INDEX_TYPE(:) ! index of minimum in global frame 34 42 # if defined key_mpp_mpi … … 36 44 INTEGER :: ierror, ii, idim 37 45 INTEGER :: index0 38 REAL( wp) :: zmin ! local minimum46 REAL(PRECISION) :: zmin ! local minimum 39 47 INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs 40 REAL( wp), DIMENSION(2,1) :: zain, zaout48 REAL(dp), DIMENSION(2,1) :: zain, zaout 41 49 !!----------------------------------------------------------------------- 42 50 ! … … 99 107 END SUBROUTINE ROUTINE_LOC 100 108 109 110 #undef PRECISION 101 111 #undef ARRAY_TYPE 102 112 #undef MAX_TYPE -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/mpp_nfd_generic.h90
r11536 r12603 5 5 # define LBC_ARG (jf) 6 6 # if defined DIM_2d 7 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D) , INTENT(inout) :: ptab(f) 7 # if defined SINGLE_PRECISION 8 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp) , INTENT(inout) :: ptab(f) 9 # else 10 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp) , INTENT(inout) :: ptab(f) 11 # endif 8 12 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 9 13 # define K_SIZE(ptab) 1 … … 11 15 # endif 12 16 # if defined DIM_3d 13 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D) , INTENT(inout) :: ptab(f) 17 # if defined SINGLE_PRECISION 18 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp) , INTENT(inout) :: ptab(f) 19 # else 20 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp) , INTENT(inout) :: ptab(f) 21 # endif 14 22 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 15 23 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) … … 17 25 # endif 18 26 # if defined DIM_4d 19 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D) , INTENT(inout) :: ptab(f) 27 # if defined SINGLE_PRECISION 28 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp) , INTENT(inout) :: ptab(f) 29 # else 30 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp) , INTENT(inout) :: ptab(f) 31 # endif 20 32 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 21 33 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) … … 24 36 #else 25 37 ! !== IN: ptab is an array ==! 26 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 38 # if defined SINGLE_PRECISION 39 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 40 # else 41 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 42 # endif 27 43 # define NAT_IN(k) cd_nat 28 44 # define SGN_IN(k) psgn … … 45 61 # endif 46 62 #endif 63 64 # if defined SINGLE_PRECISION 65 # define PRECISION sp 66 # define SENDROUTINE mppsend_sp 67 # define RECVROUTINE mpprecv_sp 68 # define MPI_TYPE MPI_REAL 69 # else 70 # define PRECISION dp 71 # define SENDROUTINE mppsend_dp 72 # define RECVROUTINE mpprecv_dp 73 # define MPI_TYPE MPI_DOUBLE_PRECISION 74 # endif 47 75 48 76 SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld ) … … 66 94 INTEGER, DIMENSION(:,:), ALLOCATABLE :: jj_s ! position of sent lines 67 95 INTEGER, DIMENSION(:), ALLOCATABLE :: ipj_s ! number of sent lines 68 REAL( wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztabl69 REAL( wp), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: ztab, ztabr70 REAL( wp), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk71 REAL( wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthgloio96 REAL(PRECISION), DIMENSION(:,:,:) , ALLOCATABLE :: ztabl 97 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: ztab, ztabr 98 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk 99 REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthgloio 72 100 !!---------------------------------------------------------------------- 73 101 ! … … 160 188 DO jr = 1, nsndto 161 189 IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 162 CALL mppsend( 5, znorthloc, ibuffsize, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )190 CALL SENDROUTINE( 5, znorthloc, ibuffsize, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 163 191 ENDIF 164 192 END DO … … 176 204 ENDIF 177 205 IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 178 CALL mpprecv(5, zfoldwk, ibuffsize, iproc)206 CALL RECVROUTINE(5, zfoldwk, ibuffsize, iproc) 179 207 js = 0 180 208 DO jf = 1, ipf ; DO jj = 1, ipj_s(jf) … … 246 274 ! start waiting time measurement 247 275 IF( ln_timing ) CALL tic_tac(.TRUE.) 248 CALL MPI_ALLGATHER( znorthloc , ibuffsize, MPI_ DOUBLE_PRECISION, &249 & znorthgloio, ibuffsize, MPI_ DOUBLE_PRECISION, ncomm_north, ierr )276 CALL MPI_ALLGATHER( znorthloc , ibuffsize, MPI_TYPE, & 277 & znorthgloio, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 250 278 ! 251 279 ! stop waiting time measurement … … 298 326 END SUBROUTINE ROUTINE_NFD 299 327 328 #undef PRECISION 329 #undef MPI_TYPE 330 #undef SENDROUTINE 331 #undef RECVROUTINE 300 332 #undef ARRAY_TYPE 301 333 #undef NAT_IN
Note: See TracChangeset
for help on using the changeset viewer.
