Index: LMDZ5/trunk/libf/phylmd/phyredem.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/phyredem.F90	(revision 2265)
+++ LMDZ5/trunk/libf/phylmd/phyredem.F90	(revision 2293)
@@ -1,6 +1,9 @@
-! $Id$
-
 SUBROUTINE phyredem (fichnom)
-
+!
+!-------------------------------------------------------------------------------
+! Author: Z.X. Li (LMD/CNRS), 1993/08/18
+!-------------------------------------------------------------------------------
+! Purpose: Write restart state for physics.
+!-------------------------------------------------------------------------------
   USE dimphy
   USE mod_grid_phy_lmdz
@@ -19,9 +22,6 @@
 
   IMPLICIT none
-  !======================================================================
-  ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-  ! Objet: Ecriture de l'etat de redemarrage pour la physique
-  !======================================================================
-  include "netcdf.inc"
+
+  include "iniprint.h"
   include "dimsoil.h"
   include "clesphys.h"
@@ -49,5 +49,5 @@
   INTEGER isoil, nsrf,isw
   CHARACTER (len=7) :: str7
-  CHARACTER (len=2) :: str2
+  CHARACTER (len=256) :: nam, lnam
   INTEGER           :: it, iiq
 
@@ -126,81 +126,28 @@
   CALL put_field("FSIC", "fraction glace mer", pctsrf(:, is_sic))
 
-  DO nsrf = 1, nbsrf
-     IF (nsrf.LE.99) THEN
-        WRITE(str2, '(i2.2)') nsrf
-        CALL put_field("TS"//str2, "Temperature de surface No."//str2, &
-             ftsol(:, nsrf))
-     ELSE
-        PRINT*, "Trop de sous-mailles"
-        call abort_gcm("phyredem", "", 1)
-     ENDIF
-  ENDDO
+  IF(nbsrf>99) THEN
+    PRINT*, "Trop de sous-mailles";  CALL abort_gcm("phyredem", "", 1)
+  END IF
+  IF(nsoilmx>99) THEN
+    PRINT*, "Trop de sous-surfaces"; CALL abort_gcm("phyredem", "", 1)
+  END IF
+
+  CALL put_field_srf1("TS","Temperature",ftsol(:,:))
 
 ! ================== Albedo =======================================
   print*,'PHYREDEM NOUVEAU'
-  DO nsrf = 1, nbsrf
-     DO isw=1, nsw
-        IF (isw.LE.99 .AND. nsrf.LE.99) THEN
-           WRITE(str7, '(i2.2, "srf", i2.2)') isw, nsrf
-  print*,'PHYREDEM ',"A_dir_SW"//str7
-           CALL put_field("A_dir_SW"//str7, "Albedo direct du sol bande "//str7, &
-                falb_dir(:, isw, nsrf))
-           CALL put_field("A_dif_SW"//str7, "Albedo difus du sol bande "//str7, &
-                falb_dif(:, isw, nsrf))
-        ELSE
-           PRINT*, "Trop de couches"
-           call abort_gcm("phyredem", "", 1)
-        ENDIF
-     ENDDO
-  ENDDO
-
-! ================== Tsoil =======================================
-  DO nsrf = 1, nbsrf
-     DO isoil=1, nsoilmx
-        IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
-           WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf
-           CALL put_field("Tsoil"//str7, "Temperature du sol No."//str7, &
-                tsoil(:, isoil, nsrf))
-        ELSE
-           PRINT*, "Trop de couches"
-           call abort_gcm("phyredem", "", 1)
-        ENDIF
-     ENDDO
-  ENDDO
-
-  DO nsrf = 1, nbsrf
-     IF (nsrf.LE.99) THEN
-        WRITE(str2, '(i2.2)') nsrf
-        CALL put_field("QS"//str2, "Humidite de surface No."//str2, &
-             qsurf(:, nsrf))
-     ELSE
-        PRINT*, "Trop de sous-mailles"
-        call abort_gcm("phyredem", "", 1)
-     ENDIF
-  END DO
-
-  CALL put_field("QSOL", "Eau dans le sol (mm)", qsol)
-
-  DO nsrf = 1, nbsrf
-     IF (nsrf.LE.99) THEN
-        WRITE(str2, '(i2.2)') nsrf
-        CALL put_field("EVAP"//str2, "Evaporation de surface No."//str2 &
-             , fevap(:, nsrf))
-     ELSE
-        PRINT*, "Trop de sous-mailles"
-        call abort_gcm("phyredem", "", 1)
-     ENDIF
-  ENDDO
-
-  DO nsrf = 1, nbsrf
-     IF (nsrf.LE.99) THEN
-        WRITE(str2, '(i2.2)') nsrf
-        CALL put_field("SNOW"//str2, "Neige de surface No."//str2, &
-             snow(:, nsrf))
-     ELSE
-        PRINT*, "Trop de sous-mailles"
-        call abort_gcm("phyredem", "", 1)
-     ENDIF
-  ENDDO
+  CALL put_field_srf2("A_dir_SW","Albedo direct",falb_dir(:,:,:))
+  CALL put_field_srf2("A_dif_SW","Albedo diffus",falb_dif(:,:,:))
+
+! ================== Tsoil =========================================
+  CALL put_field_srf2("Tsoil","Temperature",tsoil(:,:,:))
+
+  CALL put_field_srf1("QS"  , "Humidite",qsurf(:,:))
+
+  CALL put_field     ("QSOL", "Eau dans le sol (mm)", qsol)
+
+  CALL put_field_srf1("EVAP", "Evaporation", fevap(:,:))
+
+  CALL put_field_srf1("SNOW", "Neige", fevap(:,:))
 
   CALL put_field("RADS", "Rayonnement net a la surface", radsol)
@@ -218,28 +165,9 @@
   CALL put_field("snow_f", "precipitation solide", snow_fall)
 
-  DO nsrf = 1, nbsrf
-     IF (nsrf.LE.99) THEN
-        WRITE(str2, '(i2.2)') nsrf
-        CALL put_field("Z0m"//str2, "rugosite de surface No."//str2, &
-             z0m(:, nsrf))
-        CALL put_field("Z0h"//str2, "rugosite de surface No."//str2, &
-             z0h(:, nsrf))
-     ELSE
-        PRINT*, "Trop de sous-mailles"
-        call abort_gcm("phyredem", "", 1)
-     ENDIF
-  ENDDO
-
-  DO nsrf = 1, nbsrf
-     IF (nsrf.LE.99) THEN
-        WRITE(str2, '(i2.2)') nsrf
-        CALL put_field("AGESNO"//str2, &
-             "Age de la neige surface No."//str2, &
-             agesno(:, nsrf))
-     ELSE
-        PRINT*, "Trop de sous-mailles"
-        call abort_gcm("phyredem", "", 1)
-     ENDIF
-  ENDDO
+  CALL put_field_srf1("Z0m", "rugosite", z0m(:,:))
+
+  CALL put_field_srf1("Z0h", "rugosite", z0h(:,:))
+
+  CALL put_field_srf1("AGESNO", "Age de la neige", agesno(:,:))
 
   CALL put_field("ZMEA", "ZMEA", zmea)
@@ -280,17 +208,9 @@
 
   IF (iflag_pbl>1) then
-     DO nsrf = 1, nbsrf
-        IF (nsrf.LE.99) THEN
-           WRITE(str2, '(i2.2)') nsrf
-           CALL put_field("TKE"//str2, "Energ. Cineti. Turb."//str2, &
-                pbl_tke(:, 1:klev+1, nsrf))
-           CALL put_field("DELTATKE"//str2, "Del TKE wk/env."//str2, &
-                wake_delta_pbl_tke(:, 1:klev+1, nsrf))
-        ELSE
-           PRINT*, "Trop de sous-mailles"
-           call abort_gcm("phyredem", "", 1)
-        ENDIF
-     ENDDO
-  ENDIF
+    CALL put_field_srf3("TKE", "Energ. Cineti. Turb.", &
+         pbl_tke(:,:,:))
+    CALL put_field_srf3("DELTATKE", "Del TKE wk/env.", &
+         wake_delta_pbl_tke(:,:,:))
+  END IF
 
   ! FIN TKE PBL !
@@ -372,3 +292,58 @@
   !$OMP BARRIER
 
+
+  CONTAINS
+
+
+SUBROUTINE put_field_srf1(nam,lnam,field)
+
+  IMPLICIT NONE
+  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
+  REAL,              INTENT(IN) :: field(:,:)
+  CHARACTER(LEN=256) :: nm, lm, str
+  DO nsrf = 1, nbsrf
+    WRITE(str, '(i2.2)') nsrf
+    nm=TRIM(nam)//TRIM(str)
+    lm=TRIM(lnam)//" de surface No. "//TRIM(str)
+    CALL put_field(nm,lm,field(:,nsrf))
+  END DO
+
+END SUBROUTINE put_field_srf1
+
+
+SUBROUTINE put_field_srf2(nam,lnam,field)
+
+  IMPLICIT NONE
+  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
+  REAL,              INTENT(IN) :: field(:,:,:)
+  CHARACTER(LEN=256) :: nm, lm, str
+  DO nsrf = 1, nbsrf
+    DO isoil=1, nsw
+      WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf
+!      WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str)
+      nm=TRIM(nam)//TRIM(str)
+      lm=TRIM(lnam)//" du sol No. "//TRIM(str)
+      CALL put_field(nm,lm,field(:,isoil,nsrf))
+    END DO
+  END DO
+
+END SUBROUTINE put_field_srf2
+
+
+SUBROUTINE put_field_srf3(nam,lnam,field)
+
+  IMPLICIT NONE
+  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
+  REAL,              INTENT(IN) :: field(:,:,:)
+  CHARACTER(LEN=256) :: nm, lm, str
+  DO nsrf = 1, nbsrf
+    WRITE(str, '(i2.2)') nsrf
+    nm=TRIM(nam)//TRIM(str)
+    lm=TRIM(lnam)//TRIM(str)
+    CALL put_field(nm,lm,field(:,1:klev+1,nsrf))
+  END DO
+
+END SUBROUTINE put_field_srf3
+
+
 END SUBROUTINE phyredem
