Changeset 74 for codes

Timestamp:

08/02/12 21:37:39 (12 years ago)

Author:

ymipsl

Message:

add mpi transfert for 4-dim tracers

YM

File:

• codes/icosagcm/trunk/src/transfert_mpi.f90 (modified) (2 diffs)

codes/icosagcm/trunk/src/transfert_mpi.f90

@@ -578 +578 @@
     INTEGER :: ireq,nreq
     INTEGER :: ind,n
-    INTEGER :: dim3
+    INTEGER :: dim3,dim4
 
     IF (field(1)%data_type==type_real) THEN
@@ -704 +704 @@
         
         ENDDO
-      
-      ENDIF
-      
+
+      ELSE  IF (field(1)%ndim==4) THEN
+      
+        nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
+        ALLOCATE(mpi_req(nreq))
+        ALLOCATE(status(MPI_STATUS_SIZE,nreq))
+    
+        ireq=0
+        DO ind=1,ndomain
+          dim3=size(field(ind)%rval4d,2)
+          dim4=size(field(ind)%rval4d,3)
+          rval4d=>field(ind)%rval4d
+        
+          req=>request(ind)
+          DO isend=1,req%nsend
+            send=>req%send(isend)
+
+            ALLOCATE(send%buffer_r4(send%size,dim3,dim4))
+            buffer_r4=>send%buffer_r4
+            value=>send%value
+            DO n=1,send%size
+              buffer_r4(n,:,:)=rval4d(value(n),:,:)
+            ENDDO
+
+            ireq=ireq+1
+            CALL MPI_ISEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind,comm_icosa, mpi_req(ireq),ierr)
+          ENDDO
+        
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            ALLOCATE(recv%buffer_r4(recv%size,dim3,dim4))
+           
+            ireq=ireq+1
+            CALL MPI_IRECV(recv%buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain,comm_icosa, mpi_req(ireq),ierr)
+          ENDDO
+        
+        ENDDO
+        
+        CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+!        DO ind=1,ndomain
+!          field(ind)%rval2d(:)=0.
+!        ENDDO
+        
+        DO ind=1,ndomain
+          rval4d=>field(ind)%rval4d
+        
+          req=>request(ind)
+          DO isend=1,req%nsend
+            send=>req%send(isend)
+            DEALLOCATE(send%buffer_r4)
+          ENDDO
+        
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            buffer_r4=>recv%buffer_r4
+            value=>recv%value
+            DO n=1,recv%size
+              rval4d(value(n),:,:)=buffer_r4(n,:,:)  
+            ENDDO        
+            DEALLOCATE(recv%buffer_r4)
+          ENDDO
+        
+        ENDDO
+      
+      ENDIF      
       
     ENDIF