--- trunk/Sources/phylmd/gr_fi_ecrit.f	2016/03/21 15:36:26	186
+++ trunk/Sources/phylmd/gr_phy_write.f	2016/03/29 15:20:23	189
@@ -1,39 +1,73 @@
-module gr_fi_ecrit_m
+module gr_phy_write_m
+
+  use dimens_m, only: iim, jjm
+  use dimphy, only: klon
 
   IMPLICIT none
 
+  interface gr_phy_write
+     module procedure gr_phy_write_2d, gr_phy_write_3d
+  end interface gr_phy_write
+
+  private
+  public gr_phy_write
+
 contains
 
-  SUBROUTINE gr_fi_ecrit(nfield, nlon, iim, jjmp1, fi, ecrit)
+  function gr_phy_write_2d(pfi)
 
     ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
+    ! Transforme une variable de la grille physique \`a la grille d'\'ecriture.
+    ! The grid for output files does not duplicate the first longitude
+    ! in the last longitude.
+
+    use grid_change, only: dyn_phy
+
+    REAL, intent(in):: pfi(:) ! (klon)
+    real gr_phy_write_2d(iim, jjm + 1)
+
+    ! Variable local to the procedure:
+    real field(iim, jjm + 1)
+
+    !-----------------------------------------------------------------------
+
+    if (size(pfi) /= klon) stop "gr_phy_write_2d"
+
+    ! Traitement des p\^oles :
+    field(2:, 1) = pfi(1)
+    field(2:, jjm + 1) = pfi(klon)
 
-    ! Transforme une variable de la grille physique \`a la grille
-    ! d'\'ecriture.  Cf. version moderne "gr_phy_write_2d", dans le
-    ! cas o\`u "nfield" vaut 1.
-
-    INTEGER, intent(in):: nfield, nlon, iim, jjmp1
-    REAL, intent(in):: fi(nlon, nfield)
-    real ecrit(iim*jjmp1, nfield)
+    gr_phy_write_2d = unpack(pfi, dyn_phy(:iim, :), field)
 
-    ! Variables local to the procedure:
+  END function gr_phy_write_2d
 
-    integer jjm
-    INTEGER i, n, ig
+  !********************************************
+
+  function gr_phy_write_3d(fi)
+
+    ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
+
+    ! Transforme une variable tri-dimensionnelle de la grille physique
+    ! \`a la grille d'\'ecriture. The grid for output files does not
+    ! duplicate the first longitude in the last longitude. Input array
+    ! has rank 2. Horizontal index is in the first dimension.
+
+    use nr_util, only: assert
+
+    REAL, intent(in):: fi(:, :) ! (klon, :)
+    real gr_phy_write_3d(iim, jjm + 1, size(fi, 2))
+
+    ! Local:
+    INTEGER l
 
     !---------------
 
-    jjm = jjmp1 - 1
-    DO n = 1, nfield
-       DO i=1, iim
-          ecrit(i, n) = fi(1, n)
-          ecrit(i+jjm*iim, n) = fi(nlon, n)
-       ENDDO
-       DO ig = 1, nlon - 2
-          ecrit(iim+ig, n) = fi(1+ig, n)
-       ENDDO
-    ENDDO
+    call assert(size(fi, 1) == klon, "gr_phy_write_3d")
+
+    DO l = 1, size(fi, 2)
+       gr_phy_write_3d(:, :, l) = gr_phy_write_2d(fi(:, l))
+    END DO
 
-  END SUBROUTINE gr_fi_ecrit
+  END function gr_phy_write_3d
 
-end module gr_fi_ecrit_m
+end module gr_phy_write_m