Index: LMDZ5/trunk/libf/phylmd/iophy.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/iophy.F90	(revision 1775)
+++ LMDZ5/trunk/libf/phylmd/iophy.F90	(revision 1791)
@@ -6,12 +6,15 @@
 ! 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
-  INTEGER, save :: npstn
-  INTEGER, allocatable, dimension(:), save :: nptabij
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon
+  INTEGER, SAVE :: phys_domain_id
+  INTEGER, SAVE :: npstn
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij
+  INTEGER, SAVE :: itau_iophy
+
+!$OMP THREADPRIVATE(itau_iophy)
   
   INTERFACE histwrite_phy
-    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
+    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old
   END INTERFACE
 
@@ -322,9 +325,10 @@
   end subroutine histbeg_phy_points
  
-  subroutine histwrite2d_phy(nid,lpoint,name,itau,field)
-  USE dimphy
-  USE mod_phys_lmdz_para
+  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  USE phys_output_var_mod
   USE ioipsl
-  implicit none
+  IMPLICIT NONE
   include 'dimensions.h'
   include 'iniprint.h'
@@ -341,4 +345,5 @@
     integer :: ip
     real,allocatable,dimension(:) :: fieldok
+
 
     IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
@@ -379,10 +384,13 @@
     deallocate(index2d)
     deallocate(fieldok)
-!$OMP END MASTER    
-  end subroutine histwrite2d_phy
-
-  subroutine histwrite3d_phy(nid,lpoint,name,itau,field)
-  USE dimphy
-  USE mod_phys_lmdz_para
+!$OMP END MASTER   
+
+ 
+  end subroutine histwrite2d_phy_old
+
+  subroutine histwrite3d_phy_old(nid,lpoint,name,itau,field)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  USE phys_output_var_mod
 
   use ioipsl
@@ -401,4 +409,5 @@
     INTEGER, ALLOCATABLE, dimension(:) :: index3d
     real,allocatable, dimension(:,:) :: fieldok
+
 
     IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
@@ -450,5 +459,197 @@
   deallocate(fieldok)
 !$OMP END MASTER    
-  end subroutine histwrite3d_phy
+
+  end subroutine histwrite3d_phy_old
+
+
+! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
+  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  USE ioipsl
+!Pour avoir nfiles, nidfiles tout ça tout ça...
+  USE phys_output_var_mod
+  
+  
+
+#ifdef CPP_XIOS
+!  USE WXIOS
+#endif
+
+  IMPLICIT NONE
+  include 'dimensions.h'
+    
+!    integer,intent(in) :: nid
+!    logical,intent(in) :: lpoint 
+!    character*(*), intent(IN) :: name
+!    integer, intent(in) :: itau
+!    real,dimension(:),intent(in) :: field
+
+      TYPE(ctrl_out), INTENT(IN) :: var
+      REAL, DIMENSION(:), INTENT(IN) :: field
+      INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
+      
+      INTEGER :: iff, iff_beg, iff_end
+      
+    REAL,dimension(klon_mpi) :: buffer_omp
+    INTEGER, allocatable, dimension(:) :: index2d
+    REAL :: Field2d(iim,jj_nb)
+
+    INTEGER :: ip
+    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
+
+! ug RUSTINE POUR LES STD LEVS.....
+      IF (PRESENT(STD_iff)) THEN
+            iff_beg = STD_iff
+            iff_end = STD_iff
+      ELSE
+            iff_beg = 1
+            iff_end = nfiles
+      END IF
+
+    IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
+    
+    CALL Gather_omp(field,buffer_omp)    
+!$OMP MASTER
+    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
+    
+! La boucle sur les fichiers:
+      DO iff=iff_beg, iff_end
+            IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN 
+    
+                  IF(.NOT.clef_stations(iff)) THEN
+                        ALLOCATE(index2d(iim*jj_nb))
+                        ALLOCATE(fieldok(iim*jj_nb))
+     
+                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,iim*jj_nb,index2d)
+#ifdef CPP_XIOS
+!                        IF (iff .EQ. 1) THEN
+!                              CALL wxios_write_2D(var%name, Field2d)
+!                        ENDIF
+#endif
+                  ELSE 
+                        ALLOCATE(fieldok(npstn))
+                        ALLOCATE(index2d(npstn))
+
+                        IF (is_sequential) THEN
+!                            klon_mpi_begin=1
+!                             klon_mpi_end=klon
+                              DO ip=1, npstn
+                                    fieldok(ip)=buffer_omp(nptabij(ip))
+                              ENDDO
+                             ELSE
+                              DO ip=1, npstn
+!                                   print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
+                                     IF(nptabij(ip).GE.klon_mpi_begin.AND. &
+                                        nptabij(ip).LE.klon_mpi_end) THEN
+                                       fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
+                                     ENDIF
+                              ENDDO
+                       ENDIF
+     
+                       CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
+                  ENDIF
+                  
+                deallocate(index2d)
+                deallocate(fieldok)
+            ENDIF !levfiles
+      ENDDO
+!$OMP END MASTER   
+
+  END SUBROUTINE histwrite2d_phy
+
+
+! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
+  SUBROUTINE histwrite3d_phy(var, field)
+  USE dimphy
+  USE mod_phys_lmdz_para
+
+  use ioipsl
+!Pour avoir nfiles, nidfiles tout ça tout ça...
+  USE phys_output_var_mod  
+  
+
+#ifdef CPP_XIOS
+! USE WXIOS
+#endif
+
+
+  IMPLICIT NONE
+  include 'dimensions.h'
+    
+!    integer,intent(in) :: nid
+!    logical,intent(in) :: lpoint
+!    character*(*), intent(IN) :: name
+!    integer, intent(in) :: itau
+!    real,dimension(:,:),intent(in) :: field  ! --> field(klon,:)
+
+      TYPE(ctrl_out), INTENT(IN) :: var
+      REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
+
+
+    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
+    REAL :: Field3d(iim,jj_nb,SIZE(field,2))
+    INTEGER :: ip, n, nlev, iff
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
+    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
+
+    IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
+    nlev=size(field,2)
+
+!   print*,'hist3d_phy mpi_rank npstn=',mpi_rank,npstn
+
+!   DO ip=1, npstn
+!    print*,'hist3d_phy mpi_rank nptabij',mpi_rank,nptabij(ip)
+!   ENDDO
+
+    CALL Gather_omp(field,buffer_omp)
+!$OMP MASTER
+    CALL grid1Dto2D_mpi(buffer_omp,field3d)
+
+
+! BOUCLE SUR LES FICHIERS
+      DO iff=1, nfiles
+            IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
+                IF (.NOT.clef_stations(iff)) THEN
+                        ALLOCATE(index3d(iim*jj_nb*nlev))
+                        ALLOCATE(fieldok(iim*jj_nb,nlev))
+                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,iim*jj_nb*nlev,index3d)
+#ifdef CPP_XIOS
+!                        IF (iff .EQ. 1) THEN
+!                              CALL wxios_write_3D(var%name, Field3d(:,:,1:klev))
+!                        ENDIF
+#endif
+                        
+                ELSE 
+                        nlev=size(field,2)
+                        ALLOCATE(index3d(npstn*nlev))
+                        ALLOCATE(fieldok(npstn,nlev))
+
+                        IF (is_sequential) THEN
+            !                  klon_mpi_begin=1
+            !                  klon_mpi_end=klon
+                              DO n=1, nlev
+                                    DO ip=1, npstn
+                                          fieldok(ip,n)=buffer_omp(nptabij(ip),n)
+                                    ENDDO
+                              ENDDO
+                        ELSE
+                              DO n=1, nlev
+                                    DO ip=1, npstn
+                                                IF(nptabij(ip).GE.klon_mpi_begin.AND. &
+                                                      nptabij(ip).LE.klon_mpi_end) THEN
+                                                fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
+                                          ENDIF
+                                    ENDDO
+                              ENDDO
+                        ENDIF
+                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
+                  ENDIF 
+                  deallocate(index3d)
+                  deallocate(fieldok)
+            ENDIF
+      ENDDO
+!$OMP END MASTER   
+  END SUBROUTINE histwrite3d_phy
   
 end module iophy
