MODULE checksum_mod ! simple function to perform checksum on T field ! works only on 1 process ! usefull to check openMP synchronisation problem ! need to be enhanced... CONTAINS SUBROUTINE checksum(field) USE icosa USE mpi_mod USE mpipara IMPLICIT NONE TYPE(t_field) :: field(:) INTEGER :: intval(2) INTEGER :: ind,i,j,ij,l,k INTEGER :: tot_sum INTEGER :: tot_sum_mpi(mpi_size) !$OMP BARRIER !$OMP MASTER tot_sum=0 DO ind=1,ndomain CALL swap_dimensions(ind) CALL swap_geometry(ind) IF (field(ind)%field_type==field_T) THEN IF (field(ind)%ndim==2) THEN DO j=jj_begin,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i IF (domain(ind)%own(i,j)) THEN intval=transfer(field(ind)%rval2d(ij),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDIF ENDDO ENDDO ELSE IF (field(ind)%ndim==3) THEN DO l=1,size(field(ind)%rval3d,2) DO j=jj_begin,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i IF (domain(ind)%own(i,j)) THEN intval=transfer(field(ind)%rval3d(ij,l),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDIF ENDDO ENDDO ENDDO ELSE IF (field(ind)%ndim==4) THEN DO k=1,size(field(ind)%rval4d,3) DO l=1,size(field(ind)%rval4d,2) DO j=jj_begin,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i IF (domain(ind)%own(i,j)) THEN intval=transfer(field(ind)%rval4d(ij,l,k),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDIF ENDDO ENDDO ENDDO ENDDO ENDIF ELSE IF (field(ind)%field_type==field_U) THEN IF (field(ind)%ndim==2) THEN DO j=jj_begin,jj_end DO i=ii_begin,ii_end-1 ij=(j-1)*iim+i intval=transfer(field(ind)%rval2d(ij+u_right),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDDO ENDDO DO j=jj_begin,jj_end-1 DO i=ii_begin+1,ii_end ij=(j-1)*iim+i intval=transfer(field(ind)%rval2d(ij+u_lup),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDDO ENDDO DO j=jj_begin+1,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i intval=transfer(field(ind)%rval2d(ij+u_ldown),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDDO ENDDO ELSE IF (field(ind)%ndim==3) THEN DO l=1,size(field(ind)%rval3d,2) DO j=jj_begin,jj_end DO i=ii_begin,ii_end-1 ij=(j-1)*iim+i intval=transfer(field(ind)%rval3d(ij+u_right,l),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDDO ENDDO DO j=jj_begin,jj_end-1 DO i=ii_begin+1,ii_end ij=(j-1)*iim+i intval=transfer(field(ind)%rval3d(ij+u_lup,l),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDDO ENDDO DO j=jj_begin+1,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i intval=transfer(field(ind)%rval3d(ij+u_ldown,l),intval,2) tot_sum=tot_sum+intval(1)+intval(2) ENDDO ENDDO ENDDO ENDIF ENDIF ENDDO !$OMP END MASTER !$OMP BARRIER !$OMP MASTER CALL MPI_Gather(tot_sum,1,MPI_INTEGER,tot_sum_mpi,1,MPI_INTEGER,0,comm_icosa,ierr) IF (mpi_rank==0) PRINT*,"CheckSum Field : ",field(1)%name,sum(tot_sum_mpi), tot_sum_mpi !$OMP END MASTER END SUBROUTINE checksum END MODULE checksum_mod