source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/phyredem.F @ 3756

!
! $Id: phyredem.F 1322 2010-03-12 10:54:11Z oboucher $
!
c
      SUBROUTINE phyredem (fichnom)

      USE dimphy
      USE mod_grid_phy_lmdz
      USE mod_phys_lmdz_para
      USE fonte_neige_mod,  ONLY : fonte_neige_final
      USE pbl_surface_mod,  ONLY : pbl_surface_final
      USE phys_state_var_mod
      USE iostart
      USE traclmdz_mod, ONLY : traclmdz_to_restart
      USE infotrac
      USE control_mod


      IMPLICIT none
c======================================================================
c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
c Objet: Ecriture de l'etat de redemarrage pour la physique
c======================================================================
#include "netcdf.inc"
#include "indicesol.h"
#include "dimsoil.h"
#include "clesphys.h"
#include "temps.h"
#include "thermcell.h"
#include "compbl.h"
c======================================================================
      CHARACTER*(*) fichnom

c les variables globales ecrites dans le fichier restart

      
      REAL tsoil(klon,nsoilmx,nbsrf)
      REAL tslab(klon), seaice(klon)
      REAL qsurf(klon,nbsrf)
      REAL qsol(klon)
      REAL snow(klon,nbsrf)
      REAL evap(klon,nbsrf)
      real fder(klon)
      REAL frugs(klon,nbsrf)
      REAL agesno(klon,nbsrf)
      REAL run_off_lic_0(klon)
      REAL trs(klon,nbtr)
c
      INTEGER nid, nvarid, idim1, idim2, idim3
      INTEGER ierr
      INTEGER length
      PARAMETER (length=100)
      REAL tab_cntrl(length)
c
      INTEGER isoil, nsrf
      CHARACTER (len=7) :: str7
      CHARACTER (len=2) :: str2
      INTEGER           :: it, iiq
      
c======================================================================
c 
c Get variables which will be written to restart file from module 
c pbl_surface_mod
      CALL pbl_surface_final(qsol, fder, snow, qsurf, 
     $     evap, frugs, agesno, tsoil)

c Get a variable calculated in module fonte_neige_mod
      CALL fonte_neige_final(run_off_lic_0)

c======================================================================

      CALL open_restartphy(fichnom)
      
      DO ierr = 1, length
         tab_cntrl(ierr) = 0.0
      ENDDO
      tab_cntrl(1) = dtime
      tab_cntrl(2) = radpas
c co2_ppm : current value of atmospheric CO2
      tab_cntrl(3) = co2_ppm
      tab_cntrl(4) = solaire
      tab_cntrl(5) = iflag_con
      tab_cntrl(6) = nbapp_rad

      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
      IF(   soil_model ) tab_cntrl( 8 ) = 1.
      IF(     new_oliq ) tab_cntrl( 9 ) = 1.
      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
      IF(     ok_orolf ) tab_cntrl(11 ) = 1.

      tab_cntrl(13) = day_end
      tab_cntrl(14) = annee_ref
      tab_cntrl(15) = itau_phy

c co2_ppm0 : initial value of atmospheric CO2
      tab_cntrl(16) = co2_ppm0
c
      CALL put_var("controle","Parametres de controle",tab_cntrl)
c

      CALL put_field("longitude",
     .               "Longitudes de la grille physique",rlon)
     
      CALL put_field("latitude","Latitudes de la grille physique",rlat)

c
C PB ajout du masque terre/mer
C
      CALL put_field("masque","masque terre mer",zmasq)

c BP ajout des fraction de chaque sous-surface
C
C 1. fraction de terre 
C
      CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
C 
C 2. Fraction de glace de terre
C 
      CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
C
C 3. fraction ocean
C
      CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
C
C 4. Fraction glace de mer
C
      CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
C
C
c
      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
        ENDIF
      ENDDO
c
      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
          ENDIF
        ENDDO
      ENDDO
c
      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
        ENDIF
      END DO
C
      CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
c
      DO nsrf = 1, nbsrf
        IF (nsrf.LE.99) THEN
          WRITE(str2,'(i2.2)') nsrf
          CALL put_field("ALBE"//str2,"albedo de surface No."//str2,
     .                   falb1(:,nsrf))
        ELSE
          PRINT*, "Trop de sous-mailles"
          CALL abort
        ENDIF
      ENDDO

      DO nsrf = 1, nbsrf
        IF (nsrf.LE.99) THEN
          WRITE(str2,'(i2.2)') nsrf
          CALL put_field("ALBLW"//str2,"albedo LW de surface No."//str2,
     .                   falb2(:,nsrf))
        ELSE
          PRINT*, "Trop de sous-mailles"
          CALL abort
        ENDIF
      ENDDO
c
c
      DO nsrf = 1, nbsrf
        IF (nsrf.LE.99) THEN
          WRITE(str2,'(i2.2)') nsrf
          CALL put_field("EVAP"//str2,"Evaporation de surface No."//str2
     .                   ,evap(:,nsrf))
        ELSE
          PRINT*, "Trop de sous-mailles"
          CALL abort
        ENDIF
      ENDDO

c
      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
        ENDIF
      ENDDO

c
      CALL put_field("RADS","Rayonnement net a la surface",radsol)
c
      CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
c
      CALL put_field("sollw","Rayonnement IF a la surface",sollw)
c
      CALL put_field("fder","Derive de flux",fder)
c
      CALL put_field("rain_f","precipitation liquide",rain_fall)
c
      CALL put_field("snow_f", "precipitation solide",snow_fall)
c
      DO nsrf = 1, nbsrf
        IF (nsrf.LE.99) THEN
        WRITE(str2,'(i2.2)') nsrf
          CALL put_field("RUG"//str2,"rugosite de surface No."//str2,
     .         frugs(:,nsrf))
        ELSE
          PRINT*, "Trop de sous-mailles"
          CALL abort
        ENDIF
      ENDDO
c
      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
        ENDIF
      ENDDO
c
      CALL put_field("ZMEA","ZMEA",zmea)
c
      CALL put_field("ZSTD","ZSTD",zstd)
      
      CALL put_field("ZSIG","ZSIG",zsig)
      
      CALL put_field("ZGAM","ZGAM",zgam)
      
      CALL put_field("ZTHE","ZTHE",zthe)
      
      CALL put_field("ZPIC","ZPIC",zpic)
      
      CALL put_field("ZVAL","ZVAL",zval)
      
      CALL put_field("RUGSREL","RUGSREL",rugoro)
      
      CALL put_field("TANCIEN","TANCIEN",t_ancien)
      
      CALL put_field("QANCIEN","QANCIEN",q_ancien)
      
      CALL put_field("RUGMER","Longueur de rugosite sur mer",
     .               frugs(:,is_oce))
      
      CALL put_field("CLWCON","Eau liquide convective",clwcon(:,1))
      
      CALL put_field("RNEBCON","Nebulosite convective",rnebcon(:,1))
      
      CALL put_field("RATQS", "Ratqs",ratqs(:,1))
c
c run_off_lic_0
c
      CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
c
c
!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
c
      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,nsrf))
          ELSE
            PRINT*, "Trop de sous-mailles"
            CALL abort
          ENDIF
        ENDDO
      ENDIF

!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
cIM ajout zmax0, f0, ema_work1, ema_work2
cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
      
      CALL put_field("ZMAX0","ZMAX0",zmax0)
      
      CALL put_field("F0","F0",f0)
      
      CALL put_field("EMA_WORK1","EMA_WORK1",ema_work1)
      
      CALL put_field("EMA_WORK2","EMA_WORK2",ema_work2)
      
c wake_deltat
      CALL put_field("WAKE_DELTAT","WAKE_DELTAT",wake_deltat)

      CALL put_field("WAKE_DELTAQ","WAKE_DELTAQ",wake_deltaq)
      
      CALL put_field("WAKE_S","WAKE_S",wake_s)
      
      CALL put_field("WAKE_CSTAR","WAKE_CSTAR",wake_cstar)
      
      CALL put_field("WAKE_PE","WAKE_PE",wake_pe)

      CALL put_field("WAKE_FIP","WAKE_FIP",wake_fip)

c thermiques

      CALL put_field("FM_THERM","FM_THERM",fm_therm)

      CALL put_field("ENTR_THERM","ENTR_THERM",entr_therm)

      CALL put_field("DETR_THERM","DETR_THERM",detr_therm)

! trs from traclmdz_mod
      IF (type_trac == 'lmdz') THEN
         CALL traclmdz_to_restart(trs)
         DO it=1,nbtr
            iiq=niadv(it+2)
            CALL put_field("trs_"//tname(iiq),"",trs(:,it))
         END DO
      END IF

      CALL close_restartphy
!$OMP BARRIER
      RETURN
      END