module write_field_loc IMPLICIT NONE interface WriteField_u module procedure Write_field1d_u,Write_Field2d_u end interface WriteField_u interface WriteField_v module procedure Write_field1d_v,Write_Field2d_v end interface WriteField_v CONTAINS SUBROUTINE write_field1D_u(name,Field) CHARACTER(LEN=*) :: name REAL, DIMENSION(:) :: Field CALL write_field_u_gen(name,Field,1) END SUBROUTINE write_field1D_u SUBROUTINE write_field2D_u(name,Field) IMPLICIT NONE CHARACTER(LEN=*) :: name REAL, DIMENSION(:,:) :: Field INTEGER :: ll ll=size(field,2) CALL write_field_u_gen(name,Field,ll) END SUBROUTINE write_field2D_u SUBROUTINE write_field_u_gen(name,Field,ll) USE parallel_lmdz USE lmdz_write_field USE mod_hallo IMPLICIT NONE include 'dimensions.h' include 'paramet.h' CHARACTER(LEN=*) :: name REAL, DIMENSION(ijb_u:ije_u,ll) :: Field REAL, ALLOCATABLE,SAVE :: New_Field(:,:,:) INTEGER,DIMENSION(0:mpi_size-1) :: jj_nb_master type(Request),SAVE :: Request_write !$OMP THREADPRIVATE(Request_write) INTEGER :: ll,i jj_nb_master(:)=0 jj_nb_master(0)=jjp1 !$OMP BARRIER !$OMP MASTER allocate(New_Field(iip1,jjp1,ll)) !$OMP END MASTER !$OMP BARRIER !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO i=1,ll New_Field(:,jj_begin:jj_end,i)=reshape(Field(ij_begin:ij_end,i),(/iip1,jj_nb/)) ENDDO !$OMP BARRIER CALL Register_SwapField(new_field,new_field,ip1jmp1,ll,jj_Nb_master,Request_write) CALL SendRequest(Request_write) !$OMP BARRIER CALL WaitRequest(Request_write) !$OMP BARRIER !$OMP MASTER IF (MPI_Rank==0) CALL WriteField(name,New_Field) DEALLOCATE(New_Field) !$OMP END MASTER !$OMP BARRIER END SUBROUTINE write_field_u_gen SUBROUTINE write_field1D_v(name,Field) CHARACTER(LEN=*) :: name REAL, DIMENSION(:) :: Field CALL write_field_v_gen(name,Field,1) END SUBROUTINE write_field1D_v SUBROUTINE write_field2D_v(name,Field) IMPLICIT NONE CHARACTER(LEN=*) :: name REAL, DIMENSION(:,:) :: Field INTEGER :: ll ll=size(field,2) CALL write_field_v_gen(name,Field,ll) END SUBROUTINE write_field2D_v SUBROUTINE write_field_v_gen(name,Field,ll) USE parallel_lmdz USE lmdz_write_field USE mod_hallo IMPLICIT NONE include 'dimensions.h' include 'paramet.h' CHARACTER(LEN=*) :: name REAL, DIMENSION(ijb_v:ije_v,ll) :: Field REAL, ALLOCATABLE,SAVE :: New_Field(:,:,:) INTEGER,DIMENSION(0:mpi_size-1) :: jj_nb_master type(Request),SAVE :: Request_write !$OMP THREADPRIVATE(Request_write) INTEGER :: ll,i,jje,ije,jjn jj_nb_master(:)=0 jj_nb_master(0)=jjp1 !$OMP BARRIER !$OMP MASTER allocate(New_Field(iip1,jjm,ll)) !$OMP END MASTER !$OMP BARRIER IF (pole_sud) THEN jje=jj_end-1 ije=ij_end-iip1 jjn=jj_nb-1 ELSE jje=jj_end ije=ij_end jjn=jj_nb ENDIF !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO i=1,ll New_Field(:,jj_begin:jje,i)=reshape(Field(ij_begin:ije,i),(/iip1,jjn/)) ENDDO !$OMP BARRIER CALL Register_SwapField(new_field,new_field,ip1jm,ll,jj_Nb_master,Request_write) CALL SendRequest(Request_write) !$OMP BARRIER CALL WaitRequest(Request_write) !$OMP BARRIER !$OMP MASTER IF (MPI_Rank==0) CALL WriteField(name,New_Field) DEALLOCATE(New_Field) !$OMP END MASTER !$OMP BARRIER END SUBROUTINE write_field_v_gen END MODULE write_field_loc