! ! $Header$ ! 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 ! abd REAL,private,allocatable,dimension(:),save :: io_lat ! abd REAL,private,allocatable,dimension(:),save :: io_lon REAL,allocatable,dimension(:),save :: io_lat REAL,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-1/iim),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-1/iim)) 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-1/iim /) 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-1/iim) 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