source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90

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
USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  USE lmdz_paramet
    IMPLICIT NONE


      
    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
USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  USE lmdz_paramet
    IMPLICIT NONE


      
    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