Changeset 1345 for trunk/NEMO/OPA_SRC/lib_mpp.F90
- Timestamp:
- 2009-03-27T15:49:55+01:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/lib_mpp.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lib_mpp.F90
r1344 r1345 17 17 !! - ! 2008 (R. Benshila) add mpp_ini_ice 18 18 !! 3.2 ! 2009 (R. Benshila) SHMEM suppression, north fold in lbc_nfd 19 !! 3.2 ! 2009 (O. Marti) add mpp_ini_znl 19 20 !!---------------------------------------------------------------------- 20 21 #if defined key_mpp_mpi … … 27 28 !! mpp_lnk_e : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 28 29 !! mpprecv : 29 !! mppsend : 30 !! mppsend : SUBROUTINE mpp_ini_znl 30 31 !! mppscatter : 31 32 !! mppgather : … … 70 71 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 71 72 PUBLIC mpprecv, mppsend, mppscatter, mppgather 72 PUBLIC mppobc, mpp_ini_ice, mpp_isl 73 PUBLIC mppobc, mpp_ini_ice, mpp_isl, mpp_ini_znl 73 74 #if defined key_oasis3 || defined key_oasis4 74 75 PUBLIC mppsize, mpprank … … 119 120 !!gm question : Pourquoi toutes les variables ice sont public??? 120 121 ! variables used in case of sea-ice 121 INTEGER, PUBLIC :: ngrp_ice !: group ID for the ice processors (for rheology)122 122 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice 123 INTEGER, PUBLIC :: ndim_rank_ice !: number of 'ice' processors 124 INTEGER, PUBLIC :: n_ice_root !: number (in the comm_ice) of proc 0 in the ice comm 123 INTEGER :: ngrp_ice ! group ID for the ice processors (for rheology) 124 INTEGER :: ndim_rank_ice ! number of 'ice' processors 125 INTEGER :: n_ice_root ! number (in the comm_ice) of proc 0 in the ice comm 125 126 INTEGER, DIMENSION(:), ALLOCATABLE :: nrank_ice ! dimension ndim_rank_ice 127 128 ! variables used for zonal integration 129 INTEGER, PUBLIC :: ncomm_znl !: communicator made by the processors on the same zonal average 130 LOGICAL, PUBLIC :: l_znl_root ! True on the 'left'most processor on the same row 131 INTEGER :: ngrp_znl ! group ID for the znl processors 132 INTEGER :: ndim_rank_znl ! number of processors on the same zonal average 133 INTEGER, DIMENSION(:), ALLOCATABLE :: nrank_znl ! dimension ndim_rank_znl, number of the procs into the same znl domain 126 134 127 135 ! North fold condition in mpp_mpi with jpni > 1 128 136 INTEGER :: ngrp_world ! group ID for the world processors 137 INTEGER :: ngrp_opa ! group ID for the opa processors 129 138 INTEGER :: ngrp_north ! group ID for the northern processors (to be fold) 130 139 INTEGER :: ncomm_north ! communicator made by the processors belonging to ngrp_north … … 355 364 t3we(:,jl,:,1) = ptab(iihom +jl,:,:) 356 365 END DO 357 END SELECT 366 END SELECT 358 367 ! 359 368 ! ! Migrations … … 1244 1253 1245 1254 1246 SUBROUTINE mppmin_int( ktab )1255 SUBROUTINE mppmin_int( ktab, kcom ) 1247 1256 !!---------------------------------------------------------------------- 1248 1257 !! *** routine mppmin_int *** … … 1252 1261 !!---------------------------------------------------------------------- 1253 1262 INTEGER, INTENT(inout) :: ktab ! ??? 1254 !! 1255 INTEGER :: ierror, iwork 1256 !!---------------------------------------------------------------------- 1257 ! 1258 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, mpi_comm_opa, ierror ) 1263 INTEGER , INTENT( in ), OPTIONAL :: kcom ! input array 1264 !! 1265 INTEGER :: ierror, iwork, localcomm 1266 !!---------------------------------------------------------------------- 1267 ! 1268 localcomm = mpi_comm_opa 1269 IF( PRESENT(kcom) ) localcomm = kcom 1270 ! 1271 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror ) 1259 1272 ! 1260 1273 ktab = iwork … … 1983 1996 1984 1997 1998 SUBROUTINE mpp_ini_znl 1999 !!---------------------------------------------------------------------- 2000 !! *** routine mpp_ini_znl *** 2001 !! 2002 !! ** Purpose : Initialize special communicator for computing zonal sum 2003 !! 2004 !! ** Method : - Look for processors in the same row 2005 !! - Put their number in nrank_znl 2006 !! - Create group for the znl processors 2007 !! - Create a communicator for znl processors 2008 !! - Determine if processor should write znl files 2009 !! 2010 !! ** output 2011 !! ndim_rank_znl = number of processors on the same row 2012 !! ngrp_znl = group ID for the znl processors 2013 !! ncomm_znl = communicator for the ice procs. 2014 !! n_znl_root = number (in the world) of proc 0 in the ice comm. 2015 !! 2016 !!---------------------------------------------------------------------- 2017 INTEGER :: ierr 2018 INTEGER :: jproc 2019 INTEGER :: ii 2020 INTEGER, DIMENSION(jpnij) :: kwork 2021 ! 2022 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world : ', ngrp_world 2023 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world 2024 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa : ', mpi_comm_opa 2025 ! 2026 IF ( jpnj == 1 ) THEN 2027 ngrp_znl = ngrp_world 2028 ncomm_znl = mpi_comm_opa 2029 ELSE 2030 ! 2031 CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr ) 2032 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork 2033 !-$$ CALL flush(numout) 2034 ! 2035 ! Count number of processors on the same row 2036 ndim_rank_znl = 0 2037 DO jproc=1,jpnij 2038 IF ( kwork(jproc) == njmpp ) THEN 2039 ndim_rank_znl = ndim_rank_znl + 1 2040 ENDIF 2041 END DO 2042 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl 2043 !-$$ CALL flush(numout) 2044 ! Allocate the right size to nrank_znl 2045 #if ! defined key_agrif 2046 IF (ALLOCATED(nrank_znl)) DEALLOCATE(nrank_znl) 2047 #else 2048 DEALLOCATE(nrank_znl) 2049 #endif 2050 ALLOCATE(nrank_znl(ndim_rank_znl)) 2051 ii = 0 2052 nrank_znl (:) = 0 2053 DO jproc=1,jpnij 2054 IF ( kwork(jproc) == njmpp) THEN 2055 ii = ii + 1 2056 nrank_znl(ii) = jproc -1 2057 ENDIF 2058 END DO 2059 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl 2060 !-$$ CALL flush(numout) 2061 2062 ! Create the opa group 2063 CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr) 2064 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa 2065 !-$$ CALL flush(numout) 2066 2067 ! Create the znl group from the opa group 2068 CALL MPI_GROUP_INCL ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr ) 2069 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl 2070 !-$$ CALL flush(numout) 2071 2072 ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row 2073 CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr ) 2074 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl 2075 !-$$ CALL flush(numout) 2076 ! 2077 END IF 2078 2079 ! Determines if processor if the first (starting from i=1) on the row 2080 IF ( jpni == 1 ) THEN 2081 l_znl_root = .TRUE. 2082 ELSE 2083 l_znl_root = .FALSE. 2084 kwork (1) = nimpp 2085 CALL mpp_min ( kwork(1), kcom = ncomm_znl) 2086 IF ( nimpp == kwork(1)) l_znl_root = .TRUE. 2087 END IF 2088 2089 END SUBROUTINE mpp_ini_znl 2090 2091 1985 2092 SUBROUTINE mpp_ini_north 1986 2093 !!---------------------------------------------------------------------- … … 2493 2600 END SUBROUTINE mpp_ini_ice 2494 2601 2602 SUBROUTINE mpp_ini_znl 2603 INTEGER :: kcom 2604 WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?' 2605 END SUBROUTINE mpp_ini_znl 2606 2495 2607 SUBROUTINE mpp_comm_free( kcom ) 2496 2608 INTEGER :: kcom
Note: See TracChangeset
for help on using the changeset viewer.
