Changeset 13942 for NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/mpp_loc_generic.h90
- Timestamp:
- 2020-12-01T17:14:18+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette@13 292sette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/mpp_loc_generic.h90
r13286 r13942 2 2 # if defined SINGLE_PRECISION 3 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) 4 #if defined key_mpp_mpi 5 # define MPI_TYPE MPI_2REAL 6 #endif 5 7 # define PRECISION sp 6 8 # else 7 9 # 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) 10 #if defined key_mpp_mpi 11 # define MPI_TYPE MPI_2DOUBLE_PRECISION 12 #endif 9 13 # define PRECISION dp 10 14 # endif … … 12 16 # if defined DIM_2d 13 17 # define ARRAY_IN(i,j,k) ptab(i,j) 14 # define MASK_IN(i,j,k) pmask(i,j)18 # define MASK_IN(i,j,k) ldmsk(i,j) 15 19 # define INDEX_TYPE(k) INTEGER , INTENT( out) :: kindex(2) 16 20 # define K_SIZE(ptab) 1 … … 18 22 # if defined DIM_3d 19 23 # define ARRAY_IN(i,j,k) ptab(i,j,k) 20 # define MASK_IN(i,j,k) pmask(i,j,k)24 # define MASK_IN(i,j,k) ldmsk(i,j,k) 21 25 # define INDEX_TYPE(k) INTEGER , INTENT( out) :: kindex(3) 22 26 # define K_SIZE(ptab) SIZE(ptab,3) 23 27 # endif 24 28 # if defined OPERATION_MAXLOC 25 # define MPI_OPERATION mpi_maxloc29 # define MPI_OPERATION MPI_MAXLOC 26 30 # define LOC_OPERATION MAXLOC 27 31 # define ERRVAL -HUGE 28 32 # endif 29 33 # if defined OPERATION_MINLOC 30 # define MPI_OPERATION mpi_minloc34 # define MPI_OPERATION MPI_MINLOC 31 35 # define LOC_OPERATION MINLOC 32 36 # define ERRVAL HUGE 33 37 # endif 34 38 35 SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex)39 SUBROUTINE ROUTINE_LOC( cdname, ptab, ldmsk, pmin, kindex, ldhalo ) 36 40 !!---------------------------------------------------------------------- 37 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine41 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 38 42 ARRAY_TYPE(:,:,:) ! array on which loctrans operation is applied 39 MASK_TYPE(:,:,:)! local mask40 REAL(PRECISION) 43 LOGICAL , INTENT(in ) :: MASK_IN(:,:,:) ! local mask 44 REAL(PRECISION) , INTENT( out) :: pmin ! Global minimum of ptab 41 45 INDEX_TYPE(:) ! index of minimum in global frame 46 LOGICAL, OPTIONAL, INTENT(in ) :: ldhalo ! If .false. (default) excludes halos in kindex 42 47 ! 43 48 INTEGER :: ierror, ii, idim 44 49 INTEGER :: index0 50 INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs 45 51 REAL(PRECISION) :: zmin ! local minimum 46 INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs47 REAL(dp), DIMENSION(2,1) :: zain, zaout52 REAL(PRECISION), DIMENSION(2,1) :: zain, zaout 53 LOGICAL :: llhalo 48 54 !!----------------------------------------------------------------------- 49 55 ! 50 56 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 51 57 ! 58 IF( PRESENT(ldhalo) ) THEN ; llhalo = ldhalo 59 ELSE ; llhalo = .FALSE. 60 ENDIF 61 ! 52 62 idim = SIZE(kindex) 53 63 ! 54 IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN 55 ! special case for land processors 56 zmin = ERRVAL(zmin) 57 index0 = 0 58 ELSE 64 IF ( ANY( MASK_IN(:,:,:) ) ) THEN ! there is at least 1 valid point... 65 ! 59 66 ALLOCATE ( ilocs(idim) ) 60 67 ! 61 ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp)68 ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) ) 62 69 zmin = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3)) 63 70 ! … … 79 86 index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 80 87 #endif 88 ELSE 89 ! special case for land processors 90 zmin = ERRVAL(zmin) 91 index0 = 0 81 92 END IF 93 ! 82 94 zain(1,:) = zmin 83 zain(2,:) = REAL(index0, wp)95 zain(2,:) = REAL(index0, PRECISION) 84 96 ! 97 #if defined key_mpp_mpi 85 98 IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 86 #if defined key_mpp_mpi 87 CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)99 CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_TYPE, MPI_OPERATION ,MPI_COMM_OCE, ierror) 100 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 88 101 #else 89 102 zaout(:,:) = zain(:,:) 90 103 #endif 91 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)92 104 ! 93 105 pmin = zaout(1,1) … … 104 116 kindex(:) = kindex(:) + 1 ! start indices at 1 105 117 118 IF( .NOT. llhalo ) THEN 119 kindex(1) = kindex(1) - nn_hls 120 #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ 121 kindex(2) = kindex(2) - nn_hls 122 #endif 123 ENDIF 124 106 125 END SUBROUTINE ROUTINE_LOC 107 126 … … 109 128 #undef PRECISION 110 129 #undef ARRAY_TYPE 111 #undef MASK_TYPE112 130 #undef ARRAY_IN 113 131 #undef MASK_IN 114 132 #undef K_SIZE 133 #if defined key_mpp_mpi 134 # undef MPI_TYPE 135 #endif 115 136 #undef MPI_OPERATION 116 137 #undef LOC_OPERATION
Note: See TracChangeset
for help on using the changeset viewer.