New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/LBC/mpp_loc_generic.h90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/LBC/mpp_loc_generic.h90

    r10716 r13463  
    11                          !==  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#if defined key_mpp_mpi 
     5#      define MPI_TYPE MPI_2REAL 
     6#endif 
     7#      define PRECISION sp 
     8#   else 
     9#      define ARRAY_TYPE(i,j,k)    REAL(dp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     10#if defined key_mpp_mpi 
     11#      define MPI_TYPE MPI_2DOUBLE_PRECISION 
     12#endif 
     13#      define PRECISION dp 
     14#   endif 
     15 
    416#   if defined DIM_2d 
    517#      define ARRAY_IN(i,j,k)   ptab(i,j) 
    6 #      define MASK_IN(i,j,k)    pmask(i,j) 
     18#      define MASK_IN(i,j,k)    ldmsk(i,j) 
    719#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2) 
    820#      define K_SIZE(ptab)      1 
    … …  
    1022#   if defined DIM_3d 
    1123#      define ARRAY_IN(i,j,k)   ptab(i,j,k) 
    12 #      define MASK_IN(i,j,k)    pmask(i,j,k) 
     24#      define MASK_IN(i,j,k)    ldmsk(i,j,k) 
    1325#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3) 
    1426#      define K_SIZE(ptab)      SIZE(ptab,3) 
    1527#   endif 
    1628#   if defined OPERATION_MAXLOC 
    17 #      define MPI_OPERATION mpi_maxloc 
     29#      define MPI_OPERATION MPI_MAXLOC 
    1830#      define LOC_OPERATION MAXLOC 
    1931#      define ERRVAL -HUGE 
    2032#   endif 
    2133#   if defined OPERATION_MINLOC 
    22 #      define MPI_OPERATION mpi_minloc 
     34#      define MPI_OPERATION MPI_MINLOC 
    2335#      define LOC_OPERATION MINLOC 
    2436#      define ERRVAL HUGE 
    2537#   endif 
    2638 
    27    SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex ) 
     39   SUBROUTINE ROUTINE_LOC( cdname, ptab, ldmsk, pmin, kindex, ldhalo ) 
    2840      !!---------------------------------------------------------------------- 
    29       CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     41      CHARACTER(len=*), INTENT(in    ) ::   cdname  ! name of the calling subroutine 
    3042      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied 
    31       MASK_TYPE(:,:,:)                             ! local mask 
    32       REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab 
     43      LOGICAL          , INTENT(in   ) ::   MASK_IN(:,:,:)                     ! local mask 
     44      REAL(PRECISION)  , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    3345      INDEX_TYPE(:)                                ! index of minimum in global frame 
    34 # if defined key_mpp_mpi 
     46      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldhalo  ! If .false. (default) excludes halos in kindex  
    3547      ! 
    3648      INTEGER  ::   ierror, ii, idim 
    3749      INTEGER  ::   index0 
    38       REAL(wp) ::   zmin     ! local minimum 
    3950      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs 
    40       REAL(wp), DIMENSION(2,1) ::   zain, zaout 
     51      REAL(PRECISION) ::   zmin     ! local minimum 
     52      REAL(PRECISION), DIMENSION(2,1) ::   zain, zaout 
     53      LOGICAL  ::   llhalo 
    4154      !!----------------------------------------------------------------------- 
    4255      ! 
    4356      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 
    4457      ! 
     58      IF( PRESENT(ldhalo) ) THEN   ;   llhalo = ldhalo 
     59      ELSE                         ;   llhalo = .FALSE. 
     60      ENDIF 
     61      ! 
    4562      idim = SIZE(kindex) 
    4663      ! 
    47       IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN 
    48          ! special case for land processors 
    49          zmin = ERRVAL(zmin) 
    50          index0 = 0 
    51       ELSE 
     64      IF ( ANY( MASK_IN(:,:,:) ) ) THEN   ! there is at least 1 valid point... 
     65         ! 
    5266         ALLOCATE ( ilocs(idim) ) 
    5367         ! 
    54          ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp ) 
     68         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) ) 
    5569         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3)) 
    5670         ! 
    5771         kindex(1) = mig( ilocs(1) ) 
    58 #  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
     72#if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
    5973         kindex(2) = mjg( ilocs(2) ) 
    60 #  endif 
    61 #  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
     74#endif 
     75#if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
    6276         kindex(3) = ilocs(3) 
    63 #  endif 
     77#endif 
    6478         !  
    6579         DEALLOCATE (ilocs) 
    6680         ! 
    6781         index0 = kindex(1)-1   ! 1d index starting at 0 
    68 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     82#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    6983         index0 = index0 + jpiglo * (kindex(2)-1) 
    70 #  endif 
    71 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     84#endif 
     85#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    7286         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 
    73 #  endif 
     87#endif 
     88      ELSE 
     89         ! special case for land processors 
     90         zmin = ERRVAL(zmin) 
     91         index0 = 0 
    7492      END IF 
     93      ! 
    7594      zain(1,:) = zmin 
    76       zain(2,:) = REAL(index0, wp) 
     95      zain(2,:) = REAL(index0, PRECISION) 
    7796      ! 
     97#if defined key_mpp_mpi 
    7898      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
    79       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) 
    80100      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
     101#else 
     102      zaout(:,:) = zain(:,:) 
     103#endif 
    81104      ! 
    82105      pmin      = zaout(1,1) 
    83106      index0    = NINT( zaout(2,1) ) 
    84 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     107#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    85108      kindex(3) = index0 / (jpiglo*jpjglo) 
    86109      index0    = index0 - kindex(3) * (jpiglo*jpjglo) 
    87 #  endif 
    88 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     110#endif 
     111#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    89112      kindex(2) = index0 / jpiglo 
    90113      index0 = index0 - kindex(2) * jpiglo 
    91 #  endif 
     114#endif 
    92115      kindex(1) = index0 
    93116      kindex(:) = kindex(:) + 1   ! start indices at 1 
    94 #else 
    95       kindex = 0 ; pmin = 0. 
    96       WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?' 
     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 
    97122#endif 
    98  
     123      ENDIF 
     124       
    99125   END SUBROUTINE ROUTINE_LOC 
    100126 
     127 
     128#undef PRECISION 
    101129#undef ARRAY_TYPE 
    102 #undef MAX_TYPE 
    103130#undef ARRAY_IN 
    104131#undef MASK_IN 
    105132#undef K_SIZE 
     133#if defined key_mpp_mpi 
     134#   undef MPI_TYPE 
     135#endif 
    106136#undef MPI_OPERATION 
    107137#undef LOC_OPERATION 
Note: See TracChangeset for help on using the changeset viewer.