! $Id: phyredem.F90 2057 2014-06-16 14:33:38Z fairhead $ 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 USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send USE indice_sol_mod USE surface_data USE ocean_slab_mod, ONLY : tslab 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 "dimsoil.h" include "clesphys.h" include "temps.h" include "thermcell.h" include "compbl.h" !====================================================================== CHARACTER*(*) fichnom ! les variables globales ecrites dans le fichier restart REAL tsoil(klon, nsoilmx, nbsrf) 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) INTEGER nid, nvarid, idim1, idim2, idim3 INTEGER ierr INTEGER length PARAMETER (length=100) REAL tab_cntrl(length) INTEGER isoil, nsrf CHARACTER (len=7) :: str7 CHARACTER (len=2) :: str2 INTEGER :: it, iiq !====================================================================== ! Get variables which will be written to restart file from module ! pbl_surface_mod CALL pbl_surface_final(qsol, fder, snow, qsurf, & evap, frugs, agesno, tsoil) ! Get a variable calculated in module fonte_neige_mod CALL fonte_neige_final(run_off_lic_0) !====================================================================== CALL open_restartphy(fichnom) DO ierr = 1, length tab_cntrl(ierr) = 0.0 ENDDO tab_cntrl(1) = dtime tab_cntrl(2) = radpas ! 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 ! co2_ppm0 : initial value of atmospheric CO2 tab_cntrl(16) = co2_ppm0 CALL put_var("controle", "Parametres de controle", tab_cntrl) CALL put_field("longitude", & "Longitudes de la grille physique", rlon) CALL put_field("latitude", "Latitudes de la grille physique", rlat) ! PB ajout du masque terre/mer CALL put_field("masque", "masque terre mer", zmasq) ! BP ajout des fraction de chaque sous-surface ! 1. fraction de terre CALL put_field("FTER", "fraction de continent", pctsrf(:, is_ter)) ! 2. Fraction de glace de terre CALL put_field("FLIC", "fraction glace de terre", pctsrf(:, is_lic)) ! 3. fraction ocean CALL put_field("FOCE", "fraction ocean", pctsrf(:, is_oce)) ! 4. Fraction glace de mer 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 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("ALBE"//str2, "albedo de surface No."//str2, & falb1(:, 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("ALBLW"//str2, "albedo LW de surface No."//str2, & falb2(:, 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("EVAP"//str2, "Evaporation de surface No."//str2 & , evap(:, 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("RADS", "Rayonnement net a la surface", radsol) CALL put_field("solsw", "Rayonnement solaire a la surface", solsw) CALL put_field("sollw", "Rayonnement IF a la surface", sollw) CALL put_field("fder", "Derive de flux", fder) CALL put_field("rain_f", "precipitation liquide", rain_fall) 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("RUG"//str2, "rugosite de surface No."//str2, & frugs(:, 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("ZMEA", "ZMEA", zmea) 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("UANCIEN", "", u_ancien) CALL put_field("VANCIEN", "", v_ancien) CALL put_field("RUGMER", "Longueur de rugosite sur mer", & frugs(:, is_oce)) CALL put_field("CLWCON", "Eau liquide convective", clwcon) CALL put_field("RNEBCON", "Nebulosite convective", rnebcon) CALL put_field("RATQS", "Ratqs", ratqs) ! run_off_lic_0 CALL put_field("RUNOFFLIC0", "Runofflic0", run_off_lic_0) ! DEB TKE PBL ! 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)) ELSE PRINT*, "Trop de sous-mailles" call abort_gcm("phyredem", "", 1) ENDIF ENDDO ENDIF ! FIN TKE PBL ! !IM ajout zmax0, f0, sig1, w01 !IM 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("sig1", "sig1 Emanuel", sig1) CALL put_field("w01", "w01 Emanuel", w01) ! 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) ! 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 IF (carbon_cycle_cpl) THEN IF (.NOT. ALLOCATED(co2_send)) THEN ! This is the case of create_etat0_limit, ce0l ALLOCATE(co2_send(klon)) co2_send(:) = co2_ppm0 END IF CALL put_field("co2_send", "co2_ppm for coupling", co2_send) END IF END IF ! Restart variables for Slab ocean IF (type_ocean == 'slab') THEN CALL put_field("tslab", "Slab ocean temperature", tslab) END IF if (ok_gwd_rando) then call put_field("du_gwd_rando", & "tendency on zonal wind due to gravity waves", & du_gwd_rando) call put_field("dv_gwd_rando", & "tendency on meriodional wind due to gravity waves", & dv_gwd_rando) end if CALL close_restartphy !$OMP BARRIER END SUBROUTINE phyredem