Ignore:
Timestamp:
02/09/15 20:18:34 (9 years ago)
Author:
ymipsl
Message:

Merge recent developments from saturn branch onto trunk.

  • lmdz generic physics interface
  • performance improvment on mix mpi/openmp
  • asynchrone and overlaping communication
  • best domain distribution between process and threads
  • ....

This version is compatible with the actual saturn version and the both branches are considered merged on dynamico component.

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/transfert_mpi.f90

    r295 r327  
    159159      DO j=jj_begin,jj_end 
    160160        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left) 
     161      ENDDO     
     162      DO j=jj_begin,jj_end 
    161163        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup) 
    162164      ENDDO     
    … …  
    169171      DO j=jj_begin,jj_end 
    170172        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right) 
     173      ENDDO    
     174      DO j=jj_begin,jj_end 
    171175        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown) 
    172176      ENDDO    
    … …  
    213217      DO j=jj_begin,jj_end 
    214218        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left) 
     219      ENDDO     
     220      DO j=jj_begin,jj_end 
    215221        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup) 
    216222      ENDDO     
    … …  
    223229      DO j=jj_begin,jj_end 
    224230        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right) 
     231      ENDDO    
     232      DO j=jj_begin,jj_end 
    225233        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown) 
    226234      ENDDO    
    … …  
    10961104    INTEGER,POINTER :: sign(:) 
    10971105    INTEGER :: offset,msize,rank 
    1098  
    1099     CALL trace_start("transfert_mpi") 
     1106    INTEGER :: lbegin, lend 
     1107 
     1108!    CALL trace_start("send_message_mpi") 
    11001109 
    11011110!$OMP BARRIER 
    … …  
    11921201       
    11931202        DO ind=1,ndomain 
    1194           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1203          IF (.NOT. assigned_domain(ind) ) CYCLE 
    11951204 
    11961205          dim3=size(field(ind)%rval3d,2) 
     1206          CALL distrib_level(dim3,lbegin,lend) 
     1207 
    11971208          rval3d=>field(ind)%rval3d 
    11981209          req=>message%request(ind) 
    … …  
    12051216              ireq=send%ireq 
    12061217              buffer_r=>message%buffers(ireq)%r 
    1207               offset=send%offset*dim3 
    1208  
    1209               DO d3=1,dim3 
     1218 
     1219              offset=send%offset*dim3 + (lbegin-1)*send%size 
     1220           
     1221              CALL trace_start("copy_to_buffer") 
     1222 
     1223              DO d3=lbegin,lend 
    12101224                DO n=1,send%size 
    12111225                  buffer_r(n+offset)=rval3d(value(n),d3) 
    … …  
    12131227                offset=offset+send%size 
    12141228              ENDDO 
    1215  
    1216               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1217                 !$OMP CRITICAL    
    1218                 CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
    1219                 !$OMP END CRITICAL 
    1220               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1221                 CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1229              CALL trace_end("copy_to_buffer") 
     1230 
     1231              IF (is_omp_level_master) THEN 
     1232                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1233                  !$OMP CRITICAL    
     1234                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1235                  !$OMP END CRITICAL 
     1236                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1237                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1238                ENDIF 
    12221239              ENDIF 
    12231240            ENDIF 
    … …  
    12261243          
    12271244        DO ind=1,ndomain 
    1228           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1245          IF (.NOT. assigned_domain(ind) ) CYCLE 
    12291246          dim3=size(field(ind)%rval3d,2) 
     1247          CALL distrib_level(dim3,lbegin,lend) 
    12301248          rval3d=>field(ind)%rval3d 
    12311249          req=>message%request(ind) 
    … …  
    12401258              sgn=>recv%sign 
    12411259 
    1242               DO n=1,recv%size 
    1243                 rval3d(value(n),:)=src_rval3d(src_value(n),:)*sgn(n) 
     1260              CALL trace_start("copy_data") 
     1261 
     1262              DO d3=lbegin,lend 
     1263                DO n=1,recv%size 
     1264                  rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n) 
     1265                ENDDO 
    12441266              ENDDO 
     1267              CALL trace_end("copy_data") 
    12451268 
    12461269            ELSE 
    … …  
    12481271              buffer_r=>message%buffers(ireq)%r 
    12491272  
    1250               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1251                 !$OMP CRITICAL 
    1252                 CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
    1253                 !$OMP END CRITICAL 
    1254               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1255                 CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1273              IF (is_omp_level_master) THEN 
     1274                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1275                  !$OMP CRITICAL 
     1276                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1277                  !$OMP END CRITICAL 
     1278                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1279                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1280                ENDIF 
    12561281              ENDIF 
    1257             ENDIF 
     1282            ENDIF   
    12581283          ENDDO 
    12591284         
    … …  
    12631288     
    12641289        DO ind=1,ndomain 
    1265           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master ) CYCLE 
     1290          IF (.NOT. assigned_domain(ind) ) CYCLE 
    12661291 
    12671292          dim3=size(field(ind)%rval4d,2) 
     1293          CALL distrib_level(dim3,lbegin,lend) 
    12681294          dim4=size(field(ind)%rval4d,3) 
    12691295          rval4d=>field(ind)%rval4d 
    … …  
    12781304              ireq=send%ireq 
    12791305              buffer_r=>message%buffers(ireq)%r 
    1280               offset=send%offset*dim3*dim4 
    1281  
     1306 
     1307              CALL trace_start("copy_to_buffer") 
    12821308              DO d4=1,dim4 
    1283                 DO d3=1,dim3 
     1309                offset=send%offset*dim3*dim4 + dim3*send%size*(d4-1) + (lbegin-1)*send%size 
     1310 
     1311                DO d3=lbegin,lend 
    12841312                  DO n=1,send%size 
    12851313                    buffer_r(n+offset)=rval4d(value(n),d3,d4) 
    … …  
    12881316                ENDDO 
    12891317              ENDDO 
    1290  
    1291               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1292                 !$OMP CRITICAL 
    1293                 CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
    1294                 !$OMP END CRITICAL 
    1295               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1296                 CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1318              CALL trace_end("copy_to_buffer") 
     1319 
     1320              IF (is_omp_level_master) THEN 
     1321                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1322                  !$OMP CRITICAL 
     1323                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1324                  !$OMP END CRITICAL 
     1325                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1326                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1327                ENDIF 
    12971328              ENDIF 
    12981329 
    … …  
    13021333         
    13031334        DO ind=1,ndomain 
    1304           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1335          IF (.NOT. assigned_domain(ind) ) CYCLE 
    13051336           
    13061337          dim3=size(field(ind)%rval4d,2) 
     1338          CALL distrib_level(dim3,lbegin,lend) 
    13071339          dim4=size(field(ind)%rval4d,3) 
    13081340          rval4d=>field(ind)%rval4d 
    … …  
    13171349              sgn=>recv%sign 
    13181350 
    1319               DO n=1,recv%size 
    1320                 rval4d(value(n),:,:)=src_rval4d(src_value(n),:,:)*sgn(n) 
     1351              CALL trace_start("copy_data") 
     1352              DO d4=1,dim4 
     1353                DO d3=lbegin,lend 
     1354                  DO n=1,recv%size 
     1355                    rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n) 
     1356                  ENDDO 
     1357                ENDDO 
    13211358              ENDDO 
     1359                 
     1360              CALL trace_end("copy_data") 
    13221361                    
    13231362            ELSE 
    … …  
    13251364              ireq=recv%ireq 
    13261365              buffer_r=>message%buffers(ireq)%r 
    1327               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1328                 !$OMP CRITICAL            
    1329                 CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
    1330                 !$OMP END CRITICAL 
    1331               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1332                 CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
     1366              IF (is_omp_level_master) THEN 
     1367                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1368                 !$OMP CRITICAL            
     1369                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
     1370                  !$OMP END CRITICAL 
     1371                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1372                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
     1373                ENDIF 
    13331374              ENDIF 
    1334      
    13351375            ENDIF 
    13361376          ENDDO 
    … …  
    13621402     
    13631403!$OMP BARRIER 
    1364     CALL trace_end("transfert_mpi") 
     1404!    CALL trace_end("send_message_mpi") 
    13651405     
    13661406  END SUBROUTINE send_message_mpi 
    … …  
    14021442    INTEGER :: ireq,nreq 
    14031443    INTEGER :: ind,n,l,m,i 
    1404     INTEGER :: dim3,dim4,d3,d4 
     1444    INTEGER :: dim3,dim4,d3,d4,lbegin,lend 
    14051445    INTEGER :: offset 
    14061446 
    14071447    IF (.NOT. message%pending) RETURN 
    14081448 
    1409     CALL trace_start("transfert_mpi") 
     1449!    CALL trace_start("wait_message_mpi") 
    14101450 
    14111451    field=>message%field 
    … …  
    14521492         
    14531493        DO ind=1,ndomain 
    1454           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1494          IF (.NOT. assigned_domain(ind) ) CYCLE 
    14551495 
    14561496          rval3d=>field(ind)%rval3d 
    … …  
    14651505               
    14661506              dim3=size(rval3d,2) 
    1467               offset=recv%offset*dim3 
    1468               DO d3=1,dim3 
    1469                 DO n=1,recv%size 
    1470                   rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)   
     1507     
     1508              CALL distrib_level(dim3,lbegin,lend) 
     1509              offset=recv%offset*dim3 + (lbegin-1)*recv%size 
     1510              CALL trace_start("copy_from_buffer") 
     1511               
     1512              IF (req%vector) THEN 
     1513                DO d3=lbegin,lend 
     1514                  DO n=1,recv%size 
     1515                    rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)   
     1516                  ENDDO 
     1517                  offset=offset+recv%size 
    14711518                ENDDO 
    1472                 offset=offset+recv%size 
    1473               ENDDO   
     1519              ELSE 
     1520                DO d3=lbegin,lend 
     1521                  DO n=1,recv%size 
     1522                    rval3d(value(n),d3)=buffer_r(n+offset)   
     1523                  ENDDO 
     1524                  offset=offset+recv%size 
     1525                ENDDO 
     1526              ENDIF 
     1527                 
     1528              CALL trace_end("copy_from_buffer") 
    14741529            ENDIF 
    14751530          ENDDO 
    … …  
    14851540                 
    14861541        DO ind=1,ndomain 
    1487           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1542          IF (.NOT. assigned_domain(ind) ) CYCLE 
    14881543 
    14891544          rval4d=>field(ind)%rval4d 
    … …  
    14981553 
    14991554              dim3=size(rval4d,2) 
     1555              CALL distrib_level(dim3,lbegin,lend) 
    15001556              dim4=size(rval4d,3) 
    1501               offset=recv%offset*dim3*dim4 
     1557              CALL trace_start("copy_from_buffer") 
    15021558              DO d4=1,dim4 
    1503                 DO d3=1,dim3 
     1559                offset=recv%offset*dim3*dim4 + dim3*recv%size*(d4-1) + (lbegin-1)*recv%size 
     1560                DO d3=lbegin,lend 
    15041561                  DO n=1,recv%size 
    15051562                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n)  
    … …  
    15081565                ENDDO 
    15091566              ENDDO 
     1567              CALL trace_end("copy_from_buffer") 
    15101568            ENDIF 
    15111569          ENDDO 
    … …  
    15211579!$OMP END MASTER 
    15221580 
    1523     CALL trace_end("transfert_mpi") 
     1581!    CALL trace_end("wait_message_mpi") 
    15241582!$OMP BARRIER 
    15251583     
    … …  
    17281786         
    17291787  END SUBROUTINE scatter_field 
    1730  
    1731  
    1732     
     1788   
    17331789  SUBROUTINE trace_in 
    17341790  USE trace 
    … …  
    17521808!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    17531809 
    1754 !! -- Les chaine de charactère -- !! 
     1810!! -- Les chaine de charactï¿œre -- !! 
    17551811 
    17561812  SUBROUTINE bcast_mpi_c(var1) 
    … …  
    19492005    IF (.NOT. using_mpi) RETURN 
    19502006 
    1951     CALL MPI_BCAST(Var,nb,MPI_REAL,mpi_master,comm_icosa,ierr) 
     2007    CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr) 
    19522008     
    19532009  END SUBROUTINE bcast_mpi_rgen 
Note: See TracChangeset for help on using the changeset viewer.