source: LMDZ4/trunk/libf/phylmd/phyredem.F @ 1068

Last change on this file since 1068 was 1001, checked in by Laurent Fairhead, 16 years ago
  • Modifs sur le parallelisme: masquage dans la physique
  • Inclusion strato
  • mise en coherence etat0
  • le mode offline fonctionne maintenant en parallele,
  • les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
  • la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
  • L'OPENMP fonctionne maintenant sans la parallelisation MPI.

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