source: LMDZ4/trunk/libf/phylmd/iophy.F90 @ 674

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
  
  INTERFACE histwrite_phy
    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
  END INTERFACE 

contains

  subroutine init_iophy(lat,lon)
  use dimphy
  implicit none
  include 'dimensions90.h'   
    real,dimension(iim),intent(in) :: lon
    real,dimension(jjm+1),intent(in) :: lat
  
    allocate(io_lat(jjm+1))
    io_lat(:)=lat(:)
    allocate(io_lon(iim))
    io_lon(:)=lon(:)
    allocate(tmp_tab2d(iim,jjphy_nb))
    allocate(tmp_tab3d(iim,jjphy_nb,klev))
    allocate(ndex2d(iim*jjphy_nb))
    allocate(ndex3d(iim*jjphy_nb*klev))
    ndex2d(:)=0
    ndex3d(:)=0

  end subroutine init_iophy
  
  subroutine histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
  use dimphy
  use ioipsl
  use write_field
  implicit none
  include 'dimensions90.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
    
    if (monocpu) then
      call histbeg(name,iim,io_lon, jjphy_nb,io_lat(jjphy_begin:jjphy_end), &
                   1,iim,1,jjphy_nb,itau0, zjulian, dtime, nhori, nid_day)
    else
      call histbeg(name//'_'//trim(int2str(phy_rank)),iim,io_lon, jjphy_nb,io_lat(jjphy_begin:jjphy_end), &
                   1,iim,1,jjphy_nb,itau0, zjulian, dtime, nhori, nid_day)
    endif
  
  end subroutine histbeg_phy
  
  subroutine histwrite2d_phy(nid,name,itau,field)
  use dimphy
  use ioipsl
  implicit none
  include 'dimensions90.h'
    
    integer,intent(in) :: nid
    character*(*), intent(IN) :: name
    integer, intent(in) :: itau
    real,dimension(klon),intent(in) :: field
    
    CALL phy2dyn(field,tmp_tab2d,1)
    CALL histwrite(nid,name,itau,tmp_tab2d,iim*jjphy_nb,ndex2d)
    
  end subroutine histwrite2d_phy
  
  subroutine histwrite3d_phy(nid,name,itau,field)
  use dimphy
  use ioipsl
  implicit none
  include 'dimensions90.h'
    
    integer,intent(in) :: nid
    character*(*), intent(IN) :: name
    integer, intent(in) :: itau
    real,dimension(klon,klev),intent(in) :: field
    
    CALL phy2dyn(field,tmp_tab3d,klev)
    CALL histwrite(nid,name,itau,tmp_tab3d,iim*jjphy_nb*klev,ndex3d)
    
  end subroutine histwrite3d_phy
  
  
  subroutine phy2dyn(field_phy,field_dyn,nlev)
  use dimphy
  implicit none
  include 'dimensions90.h'
  
    real,dimension(klon,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,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+1
           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,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