Index: /LMDZ4/trunk/libf/phylmd/comgeomphy.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/comgeomphy.F90	(revision 629)
+++ /LMDZ4/trunk/libf/phylmd/comgeomphy.F90	(revision 629)
@@ -0,0 +1,20 @@
+module comgeomphy
+   real,save,allocatable :: airephy(:)
+   real,save,allocatable :: cuphy(:)
+   real,save,allocatable :: cvphy(:)
+   real,save,allocatable :: rlatd(:)
+   real,save,allocatable :: rlond(:)
+contains
+  
+  subroutine InitComgeomphy
+  use dimphy
+  implicit none
+    
+    allocate(airephy(klon))
+    allocate(cuphy(klon))
+    allocate(cvphy(klon))
+    allocate(rlatd(klon))
+    allocate(rlond(klon))
+  end subroutine InitComgeomphy
+  
+end module comgeomphy
Index: /LMDZ4/trunk/libf/phylmd/dimphy.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/dimphy.F90	(revision 629)
+++ /LMDZ4/trunk/libf/phylmd/dimphy.F90	(revision 629)
@@ -0,0 +1,313 @@
+module dimphy
+
+  
+  logical, save :: monocpu
+!  logical, save :: parallel
+   
+  INTEGER,SAVE :: iiphy_begin
+  INTEGER,SAVE :: iiphy_end
+  INTEGER,SAVE :: jjphy_begin
+  INTEGER,SAVE :: jjphy_end
+  INTEGER,SAVE :: jjphy_nb
+  INTEGER,SAVE :: ijphy_begin
+  INTEGER,SAVE :: ijphy_end
+  INTEGER,SAVE :: ijphy_nb
+  INTEGER,SAVE :: klon_begin
+  INTEGER,SAVE :: klon_end
+  
+  
+  INTEGER,SAVE,allocatable,dimension(:) :: jjphy_para_nb
+  INTEGER,SAVE,allocatable,dimension(:) :: jjphy_para_begin
+  INTEGER,SAVE,allocatable,dimension(:) :: jjphy_para_end
+  INTEGER,SAVE,dimension(:),allocatable :: Liste_i
+  INTEGER,SAVE,dimension(:),allocatable :: Liste_j
+  INTEGER,SAVE,dimension(:),allocatable :: klon_para_nb
+  INTEGER,SAVE,dimension(:),allocatable :: klon_para_begin
+  INTEGER,SAVE,dimension(:),allocatable :: klon_para_end 
+
+  
+  INTEGER,save :: phy_rank
+  INTEGER,save :: phy_size
+  
+
+  INTEGER,save :: klev, klevp1,klevm1,klon,kfdia,kidia
+  INTEGER,save :: klon2
+  INTEGER,save :: nbtr 
+  INTEGER,save :: kdlon, kflev
+  REAL,save,allocatable,dimension(:) :: zmasq
+  
+
+  
+contains
+  
+   subroutine InitDimphy
+   use parallel
+   implicit none
+#include "dimensions90.h"
+#include "paramet90.h" 
+    integer :: rank
+    integer :: i,j,Pos,Index
+    logical,save :: First=.true.
+
+#ifdef CPP_PARALLEL      
+      monocpu=.false.
+#else
+      monocpu = .true.
+#endif
+      
+      if (monocpu) then
+        
+	phy_rank=0
+	phy_size=1
+	
+#ifdef CPP_PARALLEL      
+      else
+ 
+        phy_rank=mpi_rank
+	phy_size=mpi_size
+#endif
+      
+      endif
+
+      if (First) then
+        allocate(jjphy_para_nb(0:phy_size-1))
+        allocate(jjphy_para_begin(0:phy_size-1))
+        allocate(jjphy_para_end(0:phy_size-1))
+        allocate(klon_para_nb(0:phy_size-1))
+        allocate(klon_para_begin(0:phy_size-1))
+        allocate(klon_para_end(0:phy_size-1))
+      endif
+	
+      klev=llm
+      klevp1=klev+1
+      klevm1=klev-1
+      klon2=iim*(jjm-1)+2
+      
+     
+!        do i=0,phy_size-1
+!          klon_para_nb(i)=(klon2/phy_size)
+!          if (i<MOD(klon2,phy_size)) klon_para_nb(i)=klon_para_nb(i)+1
+!          if (i==0) then 
+!            klon_para_begin(i)=1
+!          else 
+!            klon_para_begin(i)=klon_para_end(i-1)+1
+!          endif
+!          klon_para_end(i)=klon_para_begin(i)+klon_para_nb(i)-1
+!        enddo
+      
+      if (First) then
+        do i=0,phy_size-1
+          klon_para_nb(i)=(klon2/phy_size)
+          if (i<MOD(klon2,phy_size)) klon_para_nb(i)=klon_para_nb(i)+1
+        enddo
+      endif
+        
+      do i=0,phy_size-1
+        if (i==0) then 
+          klon_para_begin(i)=1
+        else 
+          klon_para_begin(i)=klon_para_end(i-1)+1
+        endif
+        klon_para_end(i)=klon_para_begin(i)+klon_para_nb(i)-1
+      enddo
+	
+      klon=klon_para_nb(phy_rank)
+      klon_begin=klon_para_begin(phy_rank)
+      klon_end=klon_para_end(phy_rank)
+	
+      nbtr=nqmx-2+1/(nqmx-1)
+
+      kidia=1
+      kfdia=klon
+      
+      if (klon==6818 .and. monocpu) then
+        kdlon=487
+      else
+        kdlon=klon
+      endif
+      kflev=klev
+    
+      if (.not.first) then
+        deallocate(zmasq,liste_i,liste_j)
+      endif
+      
+      allocate(zmasq(klon))
+
+      
+      allocate(Liste_i(klon))
+      allocate(Liste_j(klon))
+    
+      Index=1
+      if (Pole_Nord) then
+        Liste_i(1)=1
+        Liste_j(1)=1
+        iiphy_begin=1
+        jjphy_begin=1
+	ijphy_begin=1
+        Index=Index+1
+      endif
+    
+      Pos=2
+      do j=2,jjm
+        do i=1,iim
+      
+	  if (Pos==klon_begin) then
+            iiphy_begin=i
+            jjphy_begin=j
+	    ijphy_begin=j*iip1+i
+          endif
+       
+          if (Pos==klon_end) then
+            iiphy_end=i
+            jjphy_end=j
+	    ijphy_end=j*iip1+i
+          endif
+        
+          if (Pos>=klon_begin .AND. Pos<=klon_end) then
+            Liste_i(Index)=i
+            Liste_j(Index)=j
+            Index=Index+1
+          endif
+          Pos=Pos+1
+        enddo
+      enddo
+    
+      if (pole_sud) then
+        Liste_i(Index)=1
+        Liste_j(Index)=jjp1
+        iiphy_end=1
+        jjphy_end=jjp1
+	ijphy_end=jjp1*iip1+1
+      endif
+    
+      ijphy_nb=ijphy_end-ijphy_begin+1
+      jjphy_nb=jjphy_end-jjphy_begin+1
+	
+	    
+      Pos=2
+      rank=0
+      jjphy_para_begin(rank)=1
+    
+      do j=2,jjm
+        do i=1,iim
+          if (Pos==klon_para_begin(rank)) then
+            jjphy_para_begin(rank)=j
+          endif
+          if (Pos==klon_para_end(rank)) then
+            jjphy_para_end(rank)=j
+            rank=rank+1
+          endif
+          Pos=Pos+1
+        enddo
+      enddo
+      jjphy_para_end(rank)=jjp1
+      
+      First=.false.    
+   end subroutine InitDimphy
+   
+
+   subroutine GatherField(Fields,Fieldr,ll)
+     implicit none
+#ifdef CPP_PARALLEL      
+     include 'mpif.h'
+#endif
+     INTEGER :: ll
+     REAL, dimension(klon,ll) :: Fields
+     REAL, dimension(klon2,ll) :: Fieldr     
+     REAL, dimension(klon2*ll) :: Field_tmp     
+     INTEGER, dimension(0:phy_size-1) :: displs
+     INTEGER, dimension(0:phy_size-1) :: sendcounts
+     INTEGER :: l,Pos,rank,ierr
+     INTEGER :: klon_b,klon_e, Nb
+     
+     Pos=1     
+     do rank=0,phy_size-1
+       klon_b=klon_para_begin(rank)
+       klon_e=klon_para_end(rank)
+       Nb=klon_para_nb(rank)
+       displs(rank)=Pos-1
+       sendcounts(rank)=Nb*ll
+       Pos=Pos+Nb*ll
+     enddo
+         
+      if (monocpu) then
+        Fieldr(:,:)=Fields(:,:)
+#ifdef CPP_PARALLEL      
+      else
+        call MPI_Gatherv(Fields,klon*ll,MPI_REAL8,Field_tmp,sendcounts,  &
+	                 displs,MPI_REAL8,0,MPI_COMM_WORLD,ierr)
+#endif
+      endif
+      
+     Pos=1     
+     do rank=0,phy_size-1
+       klon_b=klon_para_begin(rank)
+       klon_e=klon_para_end(rank)
+       Nb=klon_para_nb(rank)
+       do l=1,ll
+         Fieldr(klon_b:klon_e,l)=Field_tmp(Pos:Pos+Nb-1)
+	 Pos=Pos+Nb
+       enddo
+     enddo
+      
+   end subroutine GatherField
+
+   subroutine AllGatherField(Fields,Fieldr,ll)
+     implicit none
+#ifdef CPP_PARALLEL      
+     include 'mpif.h'
+#endif   
+     INTEGER :: ll
+     REAL, dimension(klon,ll) :: Fields
+     REAL, dimension(klon2,ll) :: Fieldr     
+     
+     INTEGER :: ierr
+
+#ifdef CPP_PARALLEL             
+     call GatherField(Fields,Fieldr,ll)
+     call MPI_BCAST(Fieldr,klon2*ll,MPI_REAL8,0,MPI_COMM_WORLD,ierr)
+#endif   
+   end subroutine AllGatherField
+   
+           
+   subroutine ScatterField(Fields,Fieldr,ll)
+     implicit none
+#ifdef CPP_PARALLEL      
+     include 'mpif.h'
+#endif
+     INTEGER :: ll
+     REAL, dimension(klon2,ll) :: Fields
+     REAL, dimension(klon,ll) :: Fieldr     
+     REAL, dimension(klon2*ll) :: Field_tmp     
+     INTEGER, dimension(0:phy_size-1) :: displs
+     INTEGER, dimension(0:phy_size-1) :: sendcounts
+     INTEGER :: l,Pos,rank,ierr
+     INTEGER :: klon_b,klon_e, Nb
+
+     Pos=1    
+     do rank=0,phy_size-1
+       klon_b=klon_para_begin(rank)
+       klon_e=klon_para_end(rank)
+       Nb=klon_para_nb(rank)
+       displs(rank)=Pos-1
+       sendcounts(rank)=Nb*ll
+       do l=1,ll
+         Field_tmp(Pos:Pos+Nb-1)=Fields(klon_b:klon_e,l)
+	 Pos=Pos+Nb
+       enddo
+     enddo
+           
+     if (monocpu) then
+       Fieldr(:,:)=Fields(:,:)
+     else
+#ifdef CPP_PARALLEL      
+       call MPI_Scatterv(Field_tmp,sendcounts,displs,MPI_REAL8,         &
+	                 Fieldr,klon*ll,MPI_REAL8,0,MPI_COMM_WORLD,ierr)
+#endif
+     endif
+      
+        
+   end subroutine ScatterField
+   
+   
+end module dimphy
Index: /LMDZ4/trunk/libf/phylmd/iophy.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/iophy.F90	(revision 629)
+++ /LMDZ4/trunk/libf/phylmd/iophy.F90	(revision 629)
@@ -0,0 +1,140 @@
+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
