My Project
 All Classes Files Functions Variables Macros
phyredem.F
Go to the documentation of this file.
1 !
2 ! $Id: phyredem.F 1619 2012-03-27 08:16:51Z jghattas $
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 
19  IMPLICIT none
20 c======================================================================
21 c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
22 c Objet: Ecriture de l'etat de redemarrage pour la physique
23 c======================================================================
24 #include "netcdf.inc"
25 #include "indicesol.h"
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 
104  CALL put_field("latitude","Latitudes de la grille physique",rlat)
105 
106 c
107 C PB ajout du masque terre/mer
108 C
109  CALL put_field("masque","masque terre mer",zmasq)
110 
111 c BP ajout des fraction de chaque sous-surface
112 C
113 C 1. fraction de terre
114 C
115  CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
116 C
117 C 2. Fraction de glace de terre
118 C
119  CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
120 C
121 C 3. fraction ocean
122 C
123  CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
124 C
125 C 4. Fraction glace de mer
126 C
127  CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
128 C
129 C
130 c
131  DO nsrf = 1, nbsrf
132  IF (nsrf.LE.99) THEN
133  WRITE(str2,'(i2.2)') nsrf
134  CALL put_field("TS"//str2,"Temperature de surface No."//str2,
135  . ftsol(:,nsrf))
136  ELSE
137  print*, "Trop de sous-mailles"
138  CALL abort
139  ENDIF
140  ENDDO
141 c
142  DO nsrf = 1, nbsrf
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
153  ENDDO
154 c
155  DO nsrf = 1, nbsrf
156  IF (nsrf.LE.99) THEN
157  WRITE(str2,'(i2.2)') nsrf
158  CALL put_field("QS"//str2,"Humidite de surface No."//str2,
159  . qsurf(:,nsrf))
160  ELSE
161  print*, "Trop de sous-mailles"
162  CALL abort
163  ENDIF
164  END DO
165 C
166  CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
167 c
168  DO nsrf = 1, nbsrf
169  IF (nsrf.LE.99) THEN
170  WRITE(str2,'(i2.2)') nsrf
171  CALL put_field("ALBE"//str2,"albedo de surface No."//str2,
172  . falb1(:,nsrf))
173  ELSE
174  print*, "Trop de sous-mailles"
175  CALL abort
176  ENDIF
177  ENDDO
178 
179  DO nsrf = 1, nbsrf
180  IF (nsrf.LE.99) THEN
181  WRITE(str2,'(i2.2)') nsrf
182  CALL put_field("ALBLW"//str2,"albedo LW de surface No."//str2,
183  . falb2(:,nsrf))
184  ELSE
185  print*, "Trop de sous-mailles"
186  CALL abort
187  ENDIF
188  ENDDO
189 c
190 c
191  DO nsrf = 1, nbsrf
192  IF (nsrf.LE.99) THEN
193  WRITE(str2,'(i2.2)') nsrf
194  CALL put_field("EVAP"//str2,"Evaporation de surface No."//str2
195  . ,evap(:,nsrf))
196  ELSE
197  print*, "Trop de sous-mailles"
198  CALL abort
199  ENDIF
200  ENDDO
201 
202 c
203  DO nsrf = 1, nbsrf
204  IF (nsrf.LE.99) THEN
205  WRITE(str2,'(i2.2)') nsrf
206  CALL put_field("SNOW"//str2,"Neige de surface No."//str2,
207  . snow(:,nsrf))
208  ELSE
209  print*, "Trop de sous-mailles"
210  CALL abort
211  ENDIF
212  ENDDO
213 
214 c
215  CALL put_field("RADS","Rayonnement net a la surface",radsol)
216 c
217  CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
218 c
219  CALL put_field("sollw","Rayonnement IF a la surface",sollw)
220 c
221  CALL put_field("fder","Derive de flux",fder)
222 c
223  CALL put_field("rain_f","precipitation liquide",rain_fall)
224 c
225  CALL put_field("snow_f", "precipitation solide",snow_fall)
226 c
227  DO nsrf = 1, nbsrf
228  IF (nsrf.LE.99) THEN
229  WRITE(str2,'(i2.2)') nsrf
230  CALL put_field("RUG"//str2,"rugosite de surface No."//str2,
231  . frugs(:,nsrf))
232  ELSE
233  print*, "Trop de sous-mailles"
234  CALL abort
235  ENDIF
236  ENDDO
237 c
238  DO nsrf = 1, nbsrf
239  IF (nsrf.LE.99) THEN
240  WRITE(str2,'(i2.2)') nsrf
241  CALL put_field("AGESNO"//str2,
242  . "Age de la neige surface No."//str2,
243  . agesno(:,nsrf))
244  ELSE
245  print*, "Trop de sous-mailles"
246  CALL abort
247  ENDIF
248  ENDDO
249 c
250  CALL put_field("ZMEA","ZMEA",zmea)
251 c
252  CALL put_field("ZSTD","ZSTD",zstd)
253 
254  CALL put_field("ZSIG","ZSIG",zsig)
255 
256  CALL put_field("ZGAM","ZGAM",zgam)
257 
258  CALL put_field("ZTHE","ZTHE",zthe)
259 
260  CALL put_field("ZPIC","ZPIC",zpic)
261 
262  CALL put_field("ZVAL","ZVAL",zval)
263 
264  CALL put_field("RUGSREL","RUGSREL",rugoro)
265 
266  CALL put_field("TANCIEN","TANCIEN",t_ancien)
267 
268  CALL put_field("QANCIEN","QANCIEN",q_ancien)
269 
270  CALL put_field("UANCIEN","",u_ancien)
271 
272  CALL put_field("VANCIEN","",v_ancien)
273 
274  CALL put_field("RUGMER","Longueur de rugosite sur mer",
275  . frugs(:,is_oce))
276 
277  CALL put_field("CLWCON","Eau liquide convective",clwcon)
278 
279  CALL put_field("RNEBCON","Nebulosite convective",rnebcon)
280 
281  CALL put_field("RATQS", "Ratqs",ratqs)
282 c
283 c run_off_lic_0
284 c
285  CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
286 c
287 c
288 !!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
289 c
290  IF (iflag_pbl>1) then
291  DO nsrf = 1, nbsrf
292  IF (nsrf.LE.99) THEN
293  WRITE(str2,'(i2.2)') nsrf
294  CALL put_field("TKE"//str2,"Energ. Cineti. Turb."//str2,
295  . pbl_tke(:,1:klev+1,nsrf))
296  ELSE
297  print*, "Trop de sous-mailles"
298  CALL abort
299  ENDIF
300  ENDDO
301  ENDIF
302 
303 !!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
304 cIM ajout zmax0, f0, ema_work1, ema_work2
305 cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
306 
307  CALL put_field("ZMAX0","ZMAX0",zmax0)
308 
309  CALL put_field("F0","F0",f0)
310 
311  CALL put_field("EMA_WORK1","EMA_WORK1",ema_work1)
312 
313  CALL put_field("EMA_WORK2","EMA_WORK2",ema_work2)
314 
315 c wake_deltat
316  CALL put_field("WAKE_DELTAT","WAKE_DELTAT",wake_deltat)
317 
318  CALL put_field("WAKE_DELTAQ","WAKE_DELTAQ",wake_deltaq)
319 
320  CALL put_field("WAKE_S","WAKE_S",wake_s)
321 
322  CALL put_field("WAKE_CSTAR","WAKE_CSTAR",wake_cstar)
323 
324  CALL put_field("WAKE_PE","WAKE_PE",wake_pe)
325 
326  CALL put_field("WAKE_FIP","WAKE_FIP",wake_fip)
327 
328 c 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 
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
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
351  END IF
352 
353  CALL close_restartphy
354 !$OMP BARRIER
355  RETURN
356  END