source: lmdz_wrf/trunk/WRFV3/lmdz/phyredem.F90 @ 1672

Last change on this file since 1672 was 1, checked in by lfita, 11 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

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