source: LMDZ5/branches/LMDZ5-DOFOCO/libf/phylmd/phyredem.F @ 5024

Last change on this file since 5024 was 1785, checked in by Ehouarn Millour, 11 years ago

Transformation de l'include indicesol.h en un module indice_sol_mod et modification des appels dans tous les fichiers concernés.
Aucun changement des résultats ni des sorties du modèle vs 1784.
UG

...................................................

Replacement of the indicesol.h include by a module named indice_sol_mod. Modification of the calls in every affected files.
Results and outputs of simulations are unchanged in comparison with rev 1784.
UG
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.6 KB
Line 
1!
2! $Id: phyredem.F 1785 2013-07-16 09:22:04Z asima $
3!
4c
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
21c======================================================================
22c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
23c Objet: Ecriture de l'etat de redemarrage pour la physique
24c======================================================================
25#include "netcdf.inc"
26#include "dimsoil.h"
27#include "clesphys.h"
28#include "temps.h"
29#include "thermcell.h"
30#include "compbl.h"
31c======================================================================
32      CHARACTER*(*) fichnom
33
34c 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)
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
56      CHARACTER (len=7) :: str7
57      CHARACTER (len=2) :: str2
58      INTEGER           :: it, iiq
59     
60c======================================================================
61c
62c Get variables which will be written to restart file from module
63c pbl_surface_mod
64      CALL pbl_surface_final(qsol, fder, snow, qsurf,
65     $     evap, frugs, agesno, tsoil)
66
67c Get a variable calculated in module fonte_neige_mod
68      CALL fonte_neige_final(run_off_lic_0)
69
70c======================================================================
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
79c 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
95c co2_ppm0 : initial value of atmospheric CO2
96      tab_cntrl(16) = co2_ppm0
97c
98      CALL put_var("controle","Parametres de controle",tab_cntrl)
99c
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
106c
107C PB ajout du masque terre/mer
108C
109      CALL put_field("masque","masque terre mer",zmasq)
110
111c BP ajout des fraction de chaque sous-surface
112C
113C 1. fraction de terre
114C
115      CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
116C
117C 2. Fraction de glace de terre
118C
119      CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
120C
121C 3. fraction ocean
122C
123      CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
124C
125C 4. Fraction glace de mer
126C
127      CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
128C
129C
130c
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
141c
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
154c
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
165C
166      CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
167c
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
189c
190c
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
202c
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
214c
215      CALL put_field("RADS","Rayonnement net a la surface",radsol)
216c
217      CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
218c
219      CALL put_field("sollw","Rayonnement IF a la surface",sollw)
220c
221      CALL put_field("fder","Derive de flux",fder)
222c
223      CALL put_field("rain_f","precipitation liquide",rain_fall)
224c
225      CALL put_field("snow_f", "precipitation solide",snow_fall)
226c
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
237c
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
249c
250      CALL put_field("ZMEA","ZMEA",zmea)
251c
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)
282c
283c run_off_lic_0
284c
285      CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
286c
287c
288!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
289c
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 !!!!!!!!!!!!!!!!!!!!!!!!!
304cIM ajout zmax0, f0, ema_work1, ema_work2
305cIM 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     
315c 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
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
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
Note: See TracBrowser for help on using the repository browser.