write_field_loc.F90

Go to the documentation of this file.

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 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 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