source: LMDZ4/trunk/libf/phy_IPCC_AR4/iophy.F90 @ 923

module iophy
  
  REAL,private,allocatable,dimension(:,:),save :: tmp_tab2d
  REAL,private,allocatable,dimension(:,:,:),save :: tmp_tab3d
  INTEGER,private,allocatable,dimension(:),save :: ndex2d
  INTEGER,private,allocatable,dimension(:),save :: ndex3d
  REAL,private,allocatable,dimension(:),save :: io_lat
  REAL,private,allocatable,dimension(:),save :: io_lon
  INTEGER, save :: phys_domain_id
  
  INTERFACE histwrite_phy
    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
  END INTERFACE 

contains

  subroutine init_iophy(lat,lon)
  USE dimphy
  USE mod_phys_lmdz_para
  use ioipsl
  implicit none
  include 'dimensions.h'   
    real,dimension(iim),intent(in) :: lon
    real,dimension(jjm+1),intent(in) :: lat

    INTEGER,DIMENSION(2) :: ddid
    INTEGER,DIMENSION(2) :: dsg
    INTEGER,DIMENSION(2) :: dsl
    INTEGER,DIMENSION(2) :: dpf
    INTEGER,DIMENSION(2) :: dpl
    INTEGER,DIMENSION(2) :: dhs
    INTEGER,DIMENSION(2) :: dhe 

!$OMP MASTER  
    allocate(io_lat(jjm+1))
    io_lat(:)=lat(:)
    allocate(io_lon(iim))
    io_lon(:)=lon(:)
    allocate(tmp_tab2d(iim,jj_nb))
    allocate(tmp_tab3d(iim,jj_nb,klev))
    allocate(ndex2d(iim*jj_nb))
    allocate(ndex3d(iim*jj_nb*klev))
    ndex2d(:)=0
    ndex3d(:)=0
    
    ddid=(/ 1,2 /)
    dsg=(/ iim, jjm+1 /)
    dsl=(/ iim, jj_nb /)
    dpf=(/ 1,jj_begin /)
    dpl=(/ iim, jj_end /)
    dhs=(/ ii_begin-1,0 /)
    if (mpi_rank==mpi_size-1) then
      dhe=(/0,0/)
    else
      dhe=(/ iim-ii_end,0 /)  
    endif
    
    call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
                      'APPLE',phys_domain_id)

!$OMP END MASTER
      
  end subroutine init_iophy
  
  subroutine histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
  USE dimphy
  USE mod_phys_lmdz_para
  use ioipsl
  use write_field
  implicit none
  include 'dimensions.h'
    
    character*(*), intent(IN) :: name
    integer, intent(in) :: itau0
    real,intent(in) :: zjulian
    real,intent(in) :: dtime
    integer,intent(out) :: nhori
    integer,intent(out) :: nid_day

!$OMP MASTER    
    if (is_sequential) then
      call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
                   1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    else
      call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
                   1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    endif
!$OMP END MASTER
  
  end subroutine histbeg_phy
  
  subroutine histwrite2d_phy(nid,name,itau,field)
  USE dimphy
  USE mod_phys_lmdz_para
  USE ioipsl
  implicit none
  include 'dimensions.h'
    
    integer,intent(in) :: nid
    character*(*), intent(IN) :: name
    integer, intent(in) :: itau
    real,dimension(klon),intent(in) :: field
    
    REAL,dimension(klon_mpi) :: buffer_omp
    
    CALL Gather_omp(field,buffer_omp)    
!$OMP MASTER
    CALL grid1Dto2D_mpi(buffer_omp,tmp_tab2d)
    CALL histwrite(nid,name,itau,tmp_tab2d,iim*jj_nb,ndex2d)
!$OMP END MASTER    
  end subroutine histwrite2d_phy
  
  subroutine histwrite3d_phy(nid,name,itau,field)
  USE dimphy
  USE mod_phys_lmdz_para

  use ioipsl
  implicit none
  include 'dimensions.h'
    
    integer,intent(in) :: nid
    character*(*), intent(IN) :: name
    integer, intent(in) :: itau
    real,dimension(klon,klev),intent(in) :: field

    REAL,dimension(klon_mpi,klev) :: buffer_omp
    
    CALL Gather_omp(field,buffer_omp)
!$OMP MASTER
    CALL grid1Dto2D_mpi(buffer_omp,tmp_tab3d)
    CALL histwrite(nid,name,itau,tmp_tab3d,iim*jj_nb*klev,ndex3d)
!$OMP END MASTER    
  end subroutine histwrite3d_phy
  
  
!  subroutine phy2dyn(field_phy,field_dyn,nlev)
!  USE dimphy_old
!  implicit none
!  include 'dimensions.h'
!  
!    real,dimension(klon_mpi,nlev),intent(in) :: field_phy
!    real,dimension(iim,jjphy_nb,nlev),intent(out) :: field_dyn
!    integer,intent(in) :: nlev
!    
!    integer :: next
!    integer :: j,l
!    
!      do l=1,nlev
!               
!       if (jjphy_begin==jjphy_end) then
!         field_dyn(:,1,l)=0.
!         field_dyn(iiphy_begin:iiphy_end,1,l)=field_phy(1:klon_mpi,l)
!       else
!       
!        if (jjphy_begin==1) then
!           field_dyn(:,1,l)=field_phy(1,l)
!           next=2
!        else
!          field_dyn(:,1,l)=0.
!          next=iim-iiphy_begin+2
!          field_dyn(iiphy_begin:iim,1,l)=field_phy(1:next-1,l)   
!        endif
!       
!         do j=2,jjphy_nb-1
!           field_dyn(:,j,l)=field_phy(next:next+iim-1,l)
!           next=next+iim
!         enddo
!         
!         if (jjphy_end==jjm+1) then
!             field_dyn(:,jjphy_nb,l)=field_phy(klon_mpi,l)
!         else
!          field_dyn(:,jjphy_nb,l)=0.
!          field_dyn(1:iiphy_end,jjphy_nb,l)=field_phy(next:next+iiphy_end-1,l)   
!         endif
!         
!       endif
!     
!     enddo
!        
!    end subroutine phy2dyn         
  
          
end module iophy