source: LMDZ5/trunk/libf/phylmd/phyredem.F @ 1634

Last change on this file since 1634 was 1619, checked in by jghattas, 13 years ago
  • Changed variable ratqs, clwcon and rnebcon in restartphy file : before they were saved only at surface layer, now the whole variables are saved. Added specific option in iostart to be able to restart with

old restart files.

  • Added variable uancien and vancien in restartphy.nc file. These variables are only needed for calculation of diagnostiques.

No change in result for standard physics (old or new).

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.6 KB
RevLine 
[524]1!
[1403]2! $Id: phyredem.F 1619 2012-03-27 08:16:51Z fairhead $
[524]3!
4c
[967]5      SUBROUTINE phyredem (fichnom)
[782]6
[766]7      USE dimphy
[776]8      USE mod_grid_phy_lmdz
9      USE mod_phys_lmdz_para
[782]10      USE fonte_neige_mod,  ONLY : fonte_neige_final
11      USE pbl_surface_mod,  ONLY : pbl_surface_final
[967]12      USE phys_state_var_mod
[1001]13      USE iostart
[1279]14      USE traclmdz_mod, ONLY : traclmdz_to_restart
15      USE infotrac
[1403]16      USE control_mod
[1454]17      USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
[782]18
[524]19      IMPLICIT none
20c======================================================================
21c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
22c Objet: Ecriture de l'etat de redemarrage pour la physique
23c======================================================================
24#include "netcdf.inc"
25#include "indicesol.h"
26#include "dimsoil.h"
27#include "clesphys.h"
28#include "temps.h"
[878]29#include "thermcell.h"
30#include "compbl.h"
[524]31c======================================================================
32      CHARACTER*(*) fichnom
[967]33
34c les variables globales ecrites dans le fichier restart
35
[766]36     
[1001]37      REAL tsoil(klon,nsoilmx,nbsrf)
38      REAL tslab(klon), seaice(klon)
39      REAL qsurf(klon,nbsrf)
40      REAL qsol(klon)
41      REAL snow(klon,nbsrf)
42      REAL evap(klon,nbsrf)
43      real fder(klon)
44      REAL frugs(klon,nbsrf)
45      REAL agesno(klon,nbsrf)
46      REAL run_off_lic_0(klon)
[1279]47      REAL trs(klon,nbtr)
[524]48c
49      INTEGER nid, nvarid, idim1, idim2, idim3
50      INTEGER ierr
51      INTEGER length
52      PARAMETER (length=100)
53      REAL tab_cntrl(length)
54c
55      INTEGER isoil, nsrf
[967]56      CHARACTER (len=7) :: str7
57      CHARACTER (len=2) :: str2
[1279]58      INTEGER           :: it, iiq
59     
[782]60c======================================================================
61c
62c Get variables which will be written to restart file from module
63c pbl_surface_mod
[1001]64      CALL pbl_surface_final(qsol, fder, snow, qsurf,
65     $     evap, frugs, agesno, tsoil)
[782]66
67c Get a variable calculated in module fonte_neige_mod
[1001]68      CALL fonte_neige_final(run_off_lic_0)
[782]69
70c======================================================================
71
[1001]72      CALL open_restartphy(fichnom)
[766]73     
[524]74      DO ierr = 1, length
75         tab_cntrl(ierr) = 0.0
76      ENDDO
[1303]77      tab_cntrl(1) = dtime
[524]78      tab_cntrl(2) = radpas
[1279]79c co2_ppm : current value of atmospheric CO2
[524]80      tab_cntrl(3) = co2_ppm
81      tab_cntrl(4) = solaire
82      tab_cntrl(5) = iflag_con
83      tab_cntrl(6) = nbapp_rad
84
85      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
86      IF(   soil_model ) tab_cntrl( 8 ) = 1.
87      IF(     new_oliq ) tab_cntrl( 9 ) = 1.
88      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
89      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
90
91      tab_cntrl(13) = day_end
92      tab_cntrl(14) = annee_ref
93      tab_cntrl(15) = itau_phy
[1279]94
95c co2_ppm0 : initial value of atmospheric CO2
96      tab_cntrl(16) = co2_ppm0
[524]97c
[1001]98      CALL put_var("controle","Parametres de controle",tab_cntrl)
[524]99c
[1001]100
101      CALL put_field("longitude",
102     .               "Longitudes de la grille physique",rlon)
103     
104      CALL put_field("latitude","Latitudes de la grille physique",rlat)
105
[524]106c
107C PB ajout du masque terre/mer
108C
[1001]109      CALL put_field("masque","masque terre mer",zmasq)
110
[524]111c BP ajout des fraction de chaque sous-surface
112C
113C 1. fraction de terre
114C
[1001]115      CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
[524]116C
117C 2. Fraction de glace de terre
118C
[1001]119      CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
[524]120C
121C 3. fraction ocean
122C
[1001]123      CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
[524]124C
125C 4. Fraction glace de mer
126C
[1001]127      CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
[524]128C
129C
130c
131      DO nsrf = 1, nbsrf
132        IF (nsrf.LE.99) THEN
[1001]133          WRITE(str2,'(i2.2)') nsrf
134          CALL put_field("TS"//str2,"Temperature de surface No."//str2,
135     .                    ftsol(:,nsrf))
[524]136        ELSE
[1001]137          PRINT*, "Trop de sous-mailles"
138          CALL abort
[524]139        ENDIF
140      ENDDO
141c
142      DO nsrf = 1, nbsrf
[1001]143        DO isoil=1, nsoilmx
144          IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
145            WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
146            CALL put_field("Tsoil"//str7,"Temperature du sol No."//str7,
147     .                     tsoil(:,isoil,nsrf))
148          ELSE
149            PRINT*, "Trop de couches"
150            CALL abort
151          ENDIF
152        ENDDO
[524]153      ENDDO
154c
155      DO nsrf = 1, nbsrf
156        IF (nsrf.LE.99) THEN
[1001]157          WRITE(str2,'(i2.2)') nsrf
158          CALL put_field("QS"//str2,"Humidite de surface No."//str2,
159     .                   qsurf(:,nsrf))
[524]160        ELSE
[1001]161          PRINT*, "Trop de sous-mailles"
162          CALL abort
[524]163        ENDIF
164      END DO
165C
[1001]166      CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
[524]167c
168      DO nsrf = 1, nbsrf
169        IF (nsrf.LE.99) THEN
[1001]170          WRITE(str2,'(i2.2)') nsrf
171          CALL put_field("ALBE"//str2,"albedo de surface No."//str2,
172     .                   falb1(:,nsrf))
[524]173        ELSE
[1001]174          PRINT*, "Trop de sous-mailles"
175          CALL abort
[524]176        ENDIF
177      ENDDO
178
[1001]179      DO nsrf = 1, nbsrf
[524]180        IF (nsrf.LE.99) THEN
[1001]181          WRITE(str2,'(i2.2)') nsrf
182          CALL put_field("ALBLW"//str2,"albedo LW de surface No."//str2,
183     .                   falb2(:,nsrf))
[524]184        ELSE
[1001]185          PRINT*, "Trop de sous-mailles"
186          CALL abort
[524]187        ENDIF
188      ENDDO
189c
[888]190c
[524]191      DO nsrf = 1, nbsrf
192        IF (nsrf.LE.99) THEN
[1001]193          WRITE(str2,'(i2.2)') nsrf
194          CALL put_field("EVAP"//str2,"Evaporation de surface No."//str2
195     .                   ,evap(:,nsrf))
[524]196        ELSE
[1001]197          PRINT*, "Trop de sous-mailles"
198          CALL abort
[524]199        ENDIF
200      ENDDO
201
202c
203      DO nsrf = 1, nbsrf
204        IF (nsrf.LE.99) THEN
[1001]205          WRITE(str2,'(i2.2)') nsrf
206          CALL put_field("SNOW"//str2,"Neige de surface No."//str2,
207     .                   snow(:,nsrf))
[524]208        ELSE
[1001]209          PRINT*, "Trop de sous-mailles"
210          CALL abort
[524]211        ENDIF
212      ENDDO
213
214c
[1001]215      CALL put_field("RADS","Rayonnement net a la surface",radsol)
[524]216c
[1001]217      CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
[524]218c
[1001]219      CALL put_field("sollw","Rayonnement IF a la surface",sollw)
[524]220c
[1001]221      CALL put_field("fder","Derive de flux",fder)
[524]222c
[1001]223      CALL put_field("rain_f","precipitation liquide",rain_fall)
[524]224c
[1001]225      CALL put_field("snow_f", "precipitation solide",snow_fall)
[524]226c
227      DO nsrf = 1, nbsrf
228        IF (nsrf.LE.99) THEN
229        WRITE(str2,'(i2.2)') nsrf
[1001]230          CALL put_field("RUG"//str2,"rugosite de surface No."//str2,
231     .         frugs(:,nsrf))
[524]232        ELSE
[1001]233          PRINT*, "Trop de sous-mailles"
234          CALL abort
[524]235        ENDIF
236      ENDDO
237c
238      DO nsrf = 1, nbsrf
239        IF (nsrf.LE.99) THEN
240            WRITE(str2,'(i2.2)') nsrf
[1001]241            CALL put_field("AGESNO"//str2,
242     .                     "Age de la neige surface No."//str2,
243     .                     agesno(:,nsrf))
[524]244        ELSE
245            PRINT*, "Trop de sous-mailles"
246            CALL abort
247        ENDIF
248      ENDDO
249c
[1403]250      CALL put_field("ZMEA","ZMEA",zmea)
[524]251c
[1403]252      CALL put_field("ZSTD","ZSTD",zstd)
[1001]253     
[1403]254      CALL put_field("ZSIG","ZSIG",zsig)
[1001]255     
[1403]256      CALL put_field("ZGAM","ZGAM",zgam)
[1001]257     
[1403]258      CALL put_field("ZTHE","ZTHE",zthe)
[1001]259     
[1403]260      CALL put_field("ZPIC","ZPIC",zpic)
[1001]261     
[1403]262      CALL put_field("ZVAL","ZVAL",zval)
[1001]263     
264      CALL put_field("RUGSREL","RUGSREL",rugoro)
265     
[1403]266      CALL put_field("TANCIEN","TANCIEN",t_ancien)
[1001]267     
[1403]268      CALL put_field("QANCIEN","QANCIEN",q_ancien)
[1619]269
270      CALL put_field("UANCIEN","",u_ancien)
271
272      CALL put_field("VANCIEN","",v_ancien)
273
[1001]274      CALL put_field("RUGMER","Longueur de rugosite sur mer",
275     .               frugs(:,is_oce))
276     
[1619]277      CALL put_field("CLWCON","Eau liquide convective",clwcon)
[1001]278     
[1619]279      CALL put_field("RNEBCON","Nebulosite convective",rnebcon)
[1001]280     
[1619]281      CALL put_field("RATQS", "Ratqs",ratqs)
[524]282c
283c run_off_lic_0
284c
[1001]285      CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
[524]286c
287c
[878]288!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
289c
290      IF (iflag_pbl>1) then
[1001]291        DO nsrf = 1, nbsrf
292          IF (nsrf.LE.99) THEN
[878]293            WRITE(str2,'(i2.2)') nsrf
[1001]294            CALL put_field("TKE"//str2,"Energ. Cineti. Turb."//str2,
[1458]295     .                     pbl_tke(:,1:klev+1,nsrf))
[1001]296          ELSE
[878]297            PRINT*, "Trop de sous-mailles"
298            CALL abort
[1001]299          ENDIF
300        ENDDO
[878]301      ENDIF
302
303!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
[973]304cIM ajout zmax0, f0, ema_work1, ema_work2
[1403]305cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
[1001]306     
[1403]307      CALL put_field("ZMAX0","ZMAX0",zmax0)
[1001]308     
[1403]309      CALL put_field("F0","F0",f0)
[1001]310     
[1403]311      CALL put_field("EMA_WORK1","EMA_WORK1",ema_work1)
[1001]312     
[1403]313      CALL put_field("EMA_WORK2","EMA_WORK2",ema_work2)
[1001]314     
[973]315c wake_deltat
[1403]316      CALL put_field("WAKE_DELTAT","WAKE_DELTAT",wake_deltat)
[1001]317
[1403]318      CALL put_field("WAKE_DELTAQ","WAKE_DELTAQ",wake_deltaq)
[1001]319     
[1403]320      CALL put_field("WAKE_S","WAKE_S",wake_s)
[1001]321     
[1403]322      CALL put_field("WAKE_CSTAR","WAKE_CSTAR",wake_cstar)
[1001]323     
[1403]324      CALL put_field("WAKE_PE","WAKE_PE",wake_pe)
[1001]325
[1403]326      CALL put_field("WAKE_FIP","WAKE_FIP",wake_fip)
[1279]327
[1403]328c thermiques
329
330      CALL put_field("FM_THERM","FM_THERM",fm_therm)
331
332      CALL put_field("ENTR_THERM","ENTR_THERM",entr_therm)
333
334      CALL put_field("DETR_THERM","DETR_THERM",detr_therm)
335
[1279]336! trs from traclmdz_mod
337      IF (type_trac == 'lmdz') THEN
338         CALL traclmdz_to_restart(trs)
339         DO it=1,nbtr
340            iiq=niadv(it+2)
341            CALL put_field("trs_"//tname(iiq),"",trs(:,it))
342         END DO
[1454]343         IF (carbon_cycle_cpl) THEN
344            IF (.NOT. ALLOCATED(co2_send)) THEN
345               ! This is the case of create_etat0_limit, ce0l
346               ALLOCATE(co2_send(klon))
347               co2_send(:) = co2_ppm0
348            END IF
349            CALL put_field("co2_send","co2_ppm for coupling",co2_send)
350         END IF
[1279]351      END IF
352
[1001]353      CALL close_restartphy
354!$OMP BARRIER
[524]355      RETURN
356      END
Note: See TracBrowser for help on using the repository browser.