Changeset 1543 for trunk/LMDZ.COMMON/libf/phy_common
- Timestamp:
- Apr 22, 2016, 9:02:11 AM (9 years ago)
- Location:
- trunk/LMDZ.COMMON/libf/phy_common
- Files:
-
- 2 added
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/phy_common/ioipsl_getin_p_mod.F90
r1521 r1543 12 12 USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root 13 13 USE mod_phys_lmdz_omp_data, ONLY : is_omp_root 14 use mod_phys_lmdz_para, only: bcast14 USE mod_phys_lmdz_transfert_para, ONLY : bcast 15 15 !- 16 16 IMPLICIT NONE -
trunk/LMDZ.COMMON/libf/phy_common/mod_grid_phy_lmdz.F90
r1534 r1543 1 1 ! 2 !$ Header$2 !$Id $ 3 3 ! 4 4 MODULE mod_grid_phy_lmdz … … 7 7 PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, & 8 8 grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen 9 9 10 INTEGER,PARAMETER :: unstructured=0 11 INTEGER,PARAMETER :: regular_lonlat=1 12 13 INTEGER,SAVE :: grid_type 14 INTEGER,SAVE :: nvertex 10 15 INTEGER,SAVE :: nbp_lon ! == iim 11 INTEGER,SAVE :: nbp_lat ! == jjmp1 16 INTEGER,SAVE :: nbp_lat ! == jjmp1 (or == 1 if running 1D model) 12 17 INTEGER,SAVE :: nbp_lev ! == llm 13 INTEGER,SAVE :: klon_glo 18 INTEGER,SAVE :: klon_glo ! total number of atmospheric columns 14 19 15 20 INTERFACE grid1dTo2d_glo … … 32 37 33 38 34 SUBROUTINE init_grid_phy_lmdz( iim,jjp1,llm)39 SUBROUTINE init_grid_phy_lmdz(grid_type_,nvertex_,nbp_lon_,nbp_lat_,nbp_lev_) 35 40 IMPLICIT NONE 36 INTEGER, INTENT(in) :: iim 37 INTEGER, INTENT(in) :: jjp1 38 INTEGER, INTENT(in) :: llm 39 40 nbp_lon=iim 41 nbp_lat=jjp1 42 nbp_lev=llm 43 44 ! Ehouarn: handle 1D case: 41 INTEGER,INTENT(IN) :: grid_type_ 42 INTEGER,INTENT(IN) :: nvertex_ 43 INTEGER, INTENT(IN) :: nbp_lon_ 44 INTEGER, INTENT(IN) :: nbp_lat_ 45 INTEGER, INTENT(IN) :: nbp_lev_ 46 47 grid_type = grid_type_ 48 nvertex = nvertex_ 49 nbp_lon = nbp_lon_ 50 nbp_lat = nbp_lat_ 51 nbp_lev = nbp_lev_ 52 45 53 IF (nbp_lon*nbp_lat==1) THEN 46 54 klon_glo=1 … … 283 291 284 292 !---------------------------------------------------------------- 285 ! fonctions generiques (privees)293 ! Generic (private) fonctions 286 294 !---------------------------------------------------------------- 295 287 296 SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize) 297 288 298 IMPLICIT NONE 289 299 … … 320 330 321 331 SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize) 332 322 333 IMPLICIT NONE 323 334 … … 353 364 354 365 SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize) 366 355 367 IMPLICIT NONE 356 368 … … 386 398 387 399 SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize) 400 388 401 IMPLICIT NONE 389 402 … … 408 421 409 422 SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize) 423 410 424 IMPLICIT NONE 411 425 … … 430 444 431 445 SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize) 446 432 447 IMPLICIT NONE 433 448 -
trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_mpi_data.F90
r1521 r1543 3 3 ! 4 4 MODULE mod_phys_lmdz_mpi_data 5 USE mod_const_mpi5 ! USE mod_const_mpi 6 6 7 7 INTEGER,SAVE :: ii_begin … … 35 35 INTEGER,SAVE :: mpi_rank 36 36 INTEGER,SAVE :: mpi_size 37 INTEGER,SAVE :: mpi_root 37 INTEGER,SAVE :: mpi_master 38 ! INTEGER,SAVE :: mpi_root 38 39 LOGICAL,SAVE :: is_mpi_root 39 40 LOGICAL,SAVE :: is_using_mpi … … 43 44 LOGICAL,SAVE :: is_south_pole 44 45 INTEGER,SAVE :: COMM_LMDZ_PHY 46 INTEGER,SAVE :: MPI_REAL_LMDZ ! MPI_REAL8 45 47 46 48 CONTAINS 47 49 48 SUBROUTINE init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib) 49 USE mod_const_mpi, ONLY : COMM_LMDZ 50 ! SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib) 51 SUBROUTINE init_phys_lmdz_mpi_data(nbp, nbp_lon, nbp_lat, communicator) 52 ! USE mod_const_mpi, ONLY : COMM_LMDZ 50 53 IMPLICIT NONE 51 INTEGER,INTENT(in) :: iim 52 INTEGER,INTENT(in) :: jjp1 53 INTEGER,INTENT(in) :: nb_proc 54 INTEGER,INTENT(in) :: distrib(0:nb_proc-1) 55 54 #ifdef CPP_MPI 55 INCLUDE 'mpif.h' 56 #endif 57 INTEGER,INTENT(in) :: nbp 58 INTEGER,INTENT(in) :: nbp_lon 59 INTEGER,INTENT(in) :: nbp_lat 60 INTEGER,INTENT(in) :: communicator 61 62 INTEGER,ALLOCATABLE :: distrib(:) 56 63 INTEGER :: ierr 57 64 INTEGER :: klon_glo … … 64 71 #endif 65 72 66 if ( iim.eq.1) then73 if ((nbp_lon.eq.1).and.(nbp_lat.eq.1)) then ! running 1D column model 67 74 klon_glo=1 68 75 else 69 klon_glo=iim*(jjp1-2)+2 76 ! The usual global physics grid: 1 point for each pole and nbp_lon points 77 ! for all other latitudes 78 klon_glo=nbp_lon*(nbp_lat-2)+2 70 79 endif 71 80 72 COMM_LMDZ_PHY= COMM_LMDZ81 COMM_LMDZ_PHY=communicator 73 82 74 83 IF (is_using_mpi) THEN 75 84 #ifdef CPP_MPI 85 MPI_REAL_LMDZ=MPI_REAL8 76 86 CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr) 77 87 CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr) … … 82 92 ENDIF 83 93 94 ALLOCATE(distrib(0:mpi_size-1)) 95 96 IF (is_using_mpi) THEN 97 #ifdef CPP_MPI 98 CALL MPI_ALLGATHER(nbp,1,MPI_INTEGER,distrib,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr) 99 #endif 100 ELSE 101 distrib(:)=nbp 102 ENDIF 103 104 84 105 IF (mpi_rank == 0) THEN 85 mpi_ root= 0106 mpi_master = 0 86 107 is_mpi_root = .true. 87 108 ENDIF … … 115 136 116 137 117 klon_mpi_para_nb(0:mpi_size-1)=distrib(0: nb_proc-1)138 klon_mpi_para_nb(0:mpi_size-1)=distrib(0:mpi_size-1) 118 139 119 140 DO i=0,mpi_size-1 … … 132 153 ij_para_begin(i) = 1 133 154 ELSE 134 ij_para_begin(i) = klon_mpi_para_begin(i)+ iim-1155 ij_para_begin(i) = klon_mpi_para_begin(i)+nbp_lon-1 135 156 ENDIF 136 157 137 jj_para_begin(i) = (ij_para_begin(i)-1)/ iim+ 1138 ii_para_begin(i) = MOD(ij_para_begin(i)-1, iim) + 1158 jj_para_begin(i) = (ij_para_begin(i)-1)/nbp_lon + 1 159 ii_para_begin(i) = MOD(ij_para_begin(i)-1,nbp_lon) + 1 139 160 140 161 141 ij_para_end(i) = klon_mpi_para_end(i)+ iim-1142 jj_para_end(i) = (ij_para_end(i)-1)/ iim+ 1143 ii_para_end(i) = MOD(ij_para_end(i)-1, iim) + 1162 ij_para_end(i) = klon_mpi_para_end(i)+nbp_lon-1 163 jj_para_end(i) = (ij_para_end(i)-1)/nbp_lon + 1 164 ii_para_end(i) = MOD(ij_para_end(i)-1,nbp_lon) + 1 144 165 145 166 … … 161 182 klon_mpi = klon_mpi_para_nb(mpi_rank) 162 183 163 CALL print_module_data164 165 END SUBROUTINE init_phys_lmdz_mpi_data184 CALL Print_module_data 185 186 END SUBROUTINE Init_phys_lmdz_mpi_data 166 187 167 188 SUBROUTINE print_module_data 189 ! USE print_control_mod, ONLY: lunout 168 190 IMPLICIT NONE 169 191 INCLUDE "iniprint.h" … … 193 215 WRITE(lunout,*) 'mpi_rank =', mpi_rank 194 216 WRITE(lunout,*) 'mpi_size =', mpi_size 195 WRITE(lunout,*) 'mpi_ root =', mpi_root217 WRITE(lunout,*) 'mpi_master =', mpi_master 196 218 WRITE(lunout,*) 'is_mpi_root =', is_mpi_root 197 219 WRITE(lunout,*) 'is_north_pole =', is_north_pole -
trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90
r1521 r1543 9 9 bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, & 10 10 bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, & 11 11 bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4 12 12 END INTERFACE 13 13 … … 15 15 MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, & 16 16 scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, & 17 17 scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3 18 18 END INTERFACE 19 19 … … 22 22 MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, & 23 23 gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, & 24 24 gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3 25 25 END INTERFACE 26 26 … … 28 28 MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, & 29 29 scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, & 30 30 scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3 31 31 END INTERFACE 32 32 … … 34 34 MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, & 35 35 gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, & 36 36 gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3 37 37 END INTERFACE 38 38 … … 45 45 MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, & 46 46 grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, & 47 47 grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3 48 48 END INTERFACE 49 49 … … 51 51 MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, & 52 52 grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, & 53 53 grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3 54 54 END INTERFACE 55 55 … … 1236 1236 1237 1237 SUBROUTINE bcast_mpi_cgen(var,nb) 1238 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1238 USE mod_phys_lmdz_mpi_data 1239 1239 IMPLICIT NONE 1240 1240 … … 1250 1250 1251 1251 #ifdef CPP_MPI 1252 CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_ root_x,COMM_LMDZ_PHY,ierr)1252 CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,COMM_LMDZ_PHY,ierr) 1253 1253 #endif 1254 1254 … … 1258 1258 1259 1259 SUBROUTINE bcast_mpi_igen(var,nb) 1260 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root 1261 IMPLICIT NONE 1262 1260 USE mod_phys_lmdz_mpi_data 1261 IMPLICIT NONE 1262 1263 INTEGER,INTENT(IN) :: nb 1263 1264 INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var 1264 INTEGER,INTENT(IN) :: nb1265 1265 1266 1266 #ifdef CPP_MPI … … 1272 1272 1273 1273 #ifdef CPP_MPI 1274 CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_ root_x,COMM_LMDZ_PHY,ierr)1274 CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,COMM_LMDZ_PHY,ierr) 1275 1275 #endif 1276 1276 … … 1281 1281 1282 1282 SUBROUTINE bcast_mpi_rgen(var,nb) 1283 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root 1284 IMPLICIT NONE 1285 1283 USE mod_phys_lmdz_mpi_data 1284 IMPLICIT NONE 1285 1286 INTEGER,INTENT(IN) :: nb 1286 1287 REAL,DIMENSION(nb),INTENT(INOUT) :: Var 1288 1289 #ifdef CPP_MPI 1290 INCLUDE 'mpif.h' 1291 #endif 1292 INTEGER :: ierr 1293 1294 IF (.not.is_using_mpi) RETURN 1295 1296 #ifdef CPP_MPI 1297 CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_master,COMM_LMDZ_PHY,ierr) 1298 #endif 1299 1300 END SUBROUTINE bcast_mpi_rgen 1301 1302 1303 1304 1305 SUBROUTINE bcast_mpi_lgen(var,nb) 1306 USE mod_phys_lmdz_mpi_data 1307 IMPLICIT NONE 1308 1287 1309 INTEGER,INTENT(IN) :: nb 1310 LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var 1288 1311 1289 1312 #ifdef CPP_MPI … … 1295 1318 1296 1319 #ifdef CPP_MPI 1297 CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr) 1298 #endif 1299 1300 END SUBROUTINE bcast_mpi_rgen 1301 1302 1303 1304 1305 SUBROUTINE bcast_mpi_lgen(var,nb) 1306 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root 1307 IMPLICIT NONE 1308 1309 LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var 1310 INTEGER,INTENT(IN) :: nb 1311 1312 #ifdef CPP_MPI 1313 INCLUDE 'mpif.h' 1314 #endif 1315 INTEGER :: ierr 1316 1317 IF (.not.is_using_mpi) RETURN 1318 1319 #ifdef CPP_MPI 1320 CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr) 1320 CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,COMM_LMDZ_PHY,ierr) 1321 1321 #endif 1322 1322 … … 1326 1326 1327 1327 SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize) 1328 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1328 USE mod_phys_lmdz_mpi_data 1329 1329 USE mod_grid_phy_lmdz 1330 1330 IMPLICIT NONE … … 1365 1365 #ifdef CPP_MPI 1366 1366 CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize, & 1367 MPI_INTEGER,mpi_ root_x, COMM_LMDZ_PHY,ierr)1367 MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr) 1368 1368 #endif 1369 1369 … … 1371 1371 1372 1372 SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize) 1373 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1373 USE mod_phys_lmdz_mpi_data 1374 1374 USE mod_grid_phy_lmdz 1375 1375 IMPLICIT NONE … … 1409 1409 #ifdef CPP_MPI 1410 1410 CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize, & 1411 MPI_REAL_LMDZ,mpi_ root_x, COMM_LMDZ_PHY,ierr)1411 MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr) 1412 1412 1413 1413 #endif … … 1417 1417 1418 1418 SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize) 1419 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1419 USE mod_phys_lmdz_mpi_data 1420 1420 USE mod_grid_phy_lmdz 1421 1421 IMPLICIT NONE … … 1455 1455 #ifdef CPP_MPI 1456 1456 CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize, & 1457 MPI_LOGICAL,mpi_ root_x, COMM_LMDZ_PHY,ierr)1457 MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr) 1458 1458 #endif 1459 1459 … … 1464 1464 1465 1465 SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize) 1466 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1466 USE mod_phys_lmdz_mpi_data 1467 1467 USE mod_grid_phy_lmdz 1468 1468 IMPLICIT NONE … … 1493 1493 displs(rank)=Index-1 1494 1494 counts(rank)=nb*dimsize 1495 1495 Index=Index+nb*dimsize 1496 1496 ENDDO 1497 1497 … … 1500 1500 #ifdef CPP_MPI 1501 1501 CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs, & 1502 MPI_INTEGER,mpi_ root_x, COMM_LMDZ_PHY,ierr)1503 #endif 1504 1505 1502 MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr) 1503 #endif 1504 1505 1506 1506 IF (is_mpi_root) THEN 1507 1507 Index=1 … … 1510 1510 DO i=1,dimsize 1511 1511 VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) 1512 1512 Index=Index+nb 1513 1513 ENDDO 1514 1514 ENDDO … … 1518 1518 1519 1519 SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize) 1520 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1520 USE mod_phys_lmdz_mpi_data 1521 1521 USE mod_grid_phy_lmdz 1522 1522 IMPLICIT NONE … … 1542 1542 displs(rank)=Index-1 1543 1543 counts(rank)=nb*dimsize 1544 1544 Index=Index+nb*dimsize 1545 1545 ENDDO 1546 1546 ENDIF … … 1553 1553 #ifdef CPP_MPI 1554 1554 CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs, & 1555 MPI_REAL_LMDZ,mpi_ root_x, COMM_LMDZ_PHY,ierr)1556 #endif 1557 1555 MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr) 1556 #endif 1557 1558 1558 IF (is_mpi_root) THEN 1559 1559 Index=1 … … 1562 1562 DO i=1,dimsize 1563 1563 VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) 1564 1564 Index=Index+nb 1565 1565 ENDDO 1566 1566 ENDDO … … 1570 1570 1571 1571 SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize) 1572 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1572 USE mod_phys_lmdz_mpi_data 1573 1573 USE mod_grid_phy_lmdz 1574 1574 IMPLICIT NONE … … 1599 1599 displs(rank)=Index-1 1600 1600 counts(rank)=nb*dimsize 1601 1601 Index=Index+nb*dimsize 1602 1602 ENDDO 1603 1603 ENDIF … … 1606 1606 #ifdef CPP_MPI 1607 1607 CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs, & 1608 MPI_LOGICAL,mpi_ root_x, COMM_LMDZ_PHY,ierr)1609 #endif 1610 1608 MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr) 1609 #endif 1610 1611 1611 IF (is_mpi_root) THEN 1612 1612 Index=1 … … 1615 1615 DO i=1,dimsize 1616 1616 VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) 1617 1617 Index=Index+nb 1618 1618 ENDDO 1619 1619 ENDDO … … 1625 1625 1626 1626 SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb) 1627 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1627 USE mod_phys_lmdz_mpi_data 1628 1628 USE mod_grid_phy_lmdz 1629 1629 IMPLICIT NONE … … 1633 1633 #endif 1634 1634 1635 INTEGER,INTENT(IN) :: nb 1635 1636 INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn 1636 1637 INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut 1637 INTEGER,INTENT(IN) :: nb1638 1638 INTEGER :: ierr 1639 1639 … … 1645 1645 1646 1646 #ifdef CPP_MPI 1647 CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_ root_x,COMM_LMDZ_PHY,ierr)1647 CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr) 1648 1648 #endif 1649 1649 … … 1651 1651 1652 1652 SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb) 1653 USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root1653 USE mod_phys_lmdz_mpi_data 1654 1654 USE mod_grid_phy_lmdz 1655 1655 … … 1660 1660 #endif 1661 1661 1662 INTEGER,INTENT(IN) :: nb 1662 1663 REAL,DIMENSION(nb),INTENT(IN) :: VarIn 1663 1664 REAL,DIMENSION(nb),INTENT(OUT) :: VarOut 1664 INTEGER,INTENT(IN) :: nb1665 1665 INTEGER :: ierr 1666 1666 … … 1671 1671 1672 1672 #ifdef CPP_MPI 1673 CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_ root_x,COMM_LMDZ_PHY,ierr)1673 CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr) 1674 1674 #endif 1675 1675 … … 1707 1707 DO ij=1,nbp_lon 1708 1708 VarOut(ij,i)=VarIn(1,i) 1709 1709 ENDDO 1710 1710 ENDDO 1711 1711 ENDIF … … 1715 1715 DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb 1716 1716 VarOut(ij,i)=VarIn(klon_mpi,i) 1717 1717 ENDDO 1718 1718 ENDDO 1719 1719 ENDIF … … 1751 1751 DO ij=1,nbp_lon 1752 1752 VarOut(ij,i)=VarIn(1,i) 1753 1753 ENDDO 1754 1754 ENDDO 1755 1755 ENDIF … … 1759 1759 DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb 1760 1760 VarOut(ij,i)=VarIn(klon_mpi,i) 1761 1761 ENDDO 1762 1762 ENDDO 1763 1763 ENDIF … … 1796 1796 DO ij=1,nbp_lon 1797 1797 VarOut(ij,i)=VarIn(1,i) 1798 1798 ENDDO 1799 1799 ENDDO 1800 1800 ENDIF … … 1804 1804 DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb 1805 1805 VarOut(ij,i)=VarIn(klon_mpi,i) 1806 1806 ENDDO 1807 1807 ENDDO 1808 1808 ENDIF … … 1901 1901 1902 1902 END MODULE mod_phys_lmdz_mpi_transfert 1903 -
trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_omp_data.F90
r1521 r1543 1 1 ! 2 !$Id: mod_phys_lmdz_omp_data.F90 1575 2011-09-21 13:57:48Z jghattas$2 !$Id: mod_phys_lmdz_omp_data.F90 2326 2015-07-10 12:24:29Z emillour $ 3 3 ! 4 4 MODULE mod_phys_lmdz_omp_data … … 20 20 CONTAINS 21 21 22 SUBROUTINE init_phys_lmdz_omp_data(klon_mpi)22 SUBROUTINE Init_phys_lmdz_omp_data(klon_mpi) 23 23 USE dimphy 24 24 IMPLICIT NONE … … 85 85 klon_omp_end=klon_omp_para_end(omp_rank) 86 86 87 CALL print_module_data87 CALL Print_module_data 88 88 89 END SUBROUTINE init_phys_lmdz_omp_data89 END SUBROUTINE Init_phys_lmdz_omp_data 90 90 91 SUBROUTINE print_module_data91 SUBROUTINE Print_module_data 92 92 IMPLICIT NONE 93 93 INCLUDE "iniprint.h" … … 106 106 !$OMP END CRITICAL 107 107 108 END SUBROUTINE print_module_data108 END SUBROUTINE Print_module_data 109 109 END MODULE mod_phys_lmdz_omp_data -
trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_omp_transfert.F90
r1521 r1543 25 25 bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, & 26 26 bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, & 27 27 bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4 28 28 END INTERFACE 29 29 … … 31 31 MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, & 32 32 scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, & 33 33 scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3 34 34 END INTERFACE 35 35 … … 38 38 MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, & 39 39 gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, & 40 40 gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3 41 41 END INTERFACE 42 42 … … 48 48 49 49 50 PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp 50 PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, omp_barrier 51 51 52 52 CONTAINS 53 53 54 SUBROUTINE omp_barrier 55 IMPLICIT NONE 56 57 !$OMP BARRIER 58 59 END SUBROUTINE omp_barrier 60 54 61 SUBROUTINE check_buffer_i(buff_size) 55 62 IMPLICIT NONE … … 733 740 IMPLICIT NONE 734 741 742 INTEGER,INTENT(IN) :: Nb 735 743 INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var 736 744 INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff 737 INTEGER,INTENT(IN) :: Nb738 745 739 746 INTEGER :: i … … 757 764 IMPLICIT NONE 758 765 766 INTEGER,INTENT(IN) :: Nb 759 767 REAL,DIMENSION(Nb),INTENT(INOUT) :: Var 760 768 REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff 761 INTEGER,INTENT(IN) :: Nb762 769 763 770 INTEGER :: i … … 780 787 IMPLICIT NONE 781 788 789 INTEGER,INTENT(IN) :: Nb 782 790 LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var 783 791 LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff 784 INTEGER,INTENT(IN) :: Nb785 792 786 793 INTEGER :: i -
trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_para.F90
r1521 r1543 16 16 CONTAINS 17 17 18 SUBROUTINE init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)18 SUBROUTINE Init_phys_lmdz_para(nbp,nbp_lon,nbp_lat,communicator) 19 19 IMPLICIT NONE 20 INTEGER,INTENT(in) :: iim21 INTEGER,INTENT(in) :: jjp122 INTEGER,INTENT(in) :: nb _proc23 INTEGER,INTENT(in) :: distrib(0:nb_proc-1)20 INTEGER,INTENT(in) :: nbp 21 INTEGER,INTENT(in) :: nbp_lon 22 INTEGER,INTENT(in) :: nbp_lat 23 INTEGER,INTENT(in) :: communicator 24 24 25 CALL init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)25 CALL Init_phys_lmdz_mpi_data(nbp,nbp_lon,nbp_lat,communicator) 26 26 !$OMP PARALLEL 27 CALL init_phys_lmdz_omp_data(klon_mpi)27 CALL Init_phys_lmdz_omp_data(klon_mpi) 28 28 klon_loc=klon_omp 29 29 IF (is_mpi_root .AND. is_omp_root) THEN … … 32 32 is_master=.FALSE. 33 33 ENDIF 34 CALL test_transfert34 CALL Test_transfert 35 35 !$OMP END PARALLEL 36 36 IF (is_using_mpi .OR. is_using_omp) THEN … … 42 42 ENDIF 43 43 44 END SUBROUTINE init_phys_lmdz_para44 END SUBROUTINE Init_phys_lmdz_para 45 45 46 SUBROUTINE test_transfert46 SUBROUTINE Test_transfert 47 47 USE mod_grid_phy_lmdz 48 48 IMPLICIT NONE … … 108 108 109 109 110 END SUBROUTINE test_transfert110 END SUBROUTINE Test_transfert 111 111 112 112 END MODULE mod_phys_lmdz_para -
trunk/LMDZ.COMMON/libf/phy_common/write_field_phy.F90
r1523 r1543 1 1 ! 2 ! $ Header$2 ! $Id: write_field_phy.F90 2342 2015-08-19 13:21:38Z emillour $ 3 3 ! 4 4 MODULE write_field_phy 5 5 6 ! Dump a field on the global (nbp_lon by nbp_lat) physics grid 7 6 8 CONTAINS 7 9 8 10 SUBROUTINE WriteField_phy(name,Field,ll) 9 USE dimphy 10 USE mod_phys_lmdz_para 11 USE mod_grid_phy_lmdz 12 USE Write_Field 11 USE mod_phys_lmdz_para, ONLY: klon_omp, is_mpi_root, & 12 Gather 13 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, & 14 Grid1Dto2D_glo 15 USE Write_Field, ONLY: WriteField 13 16 14 17 IMPLICIT NONE 15 include 'dimensions.h'16 include 'paramet.h'17 18 18 character(len=*):: name19 INTEGER :: ll20 real, dimension(klon_omp,ll) :: Field21 real,save,allocatable :: Field_tmp(:,:) 19 CHARACTER(len=*),INTENT(IN) :: name 20 INTEGER,INTENT(IN) :: ll 21 REAL,INTENT(IN) :: Field(klon_omp,ll) 22 22 23 real, dimension(klon_glo,ll):: New_Field 23 real, dimension( iim,jjp1,ll):: Field_2d24 real, dimension(nbp_lon,nbp_lat,ll):: Field_2d 24 25 25 26 CALL Gather(Field,New_Field)
Note: See TracChangeset
for help on using the changeset viewer.