source: LMDZ.3.3/trunk/libf/phylmd/phyredem.F @ 45

Last change on this file since 45 was 45, checked in by lmdz, 24 years ago

Sauvegarde des tendances dynamiques dans l'etat initial L.Li
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 12.0 KB
Line 
1      SUBROUTINE phyredem (fichnom,dtime,radpas,co2_ppm,solaire,
2     .           rlat,rlon,tsol,tsoil,deltat,qsol,snow,
3     .           radsol,rugmer,agesno,
4     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,
5     .           t_ancien, q_ancien)
6      IMPLICIT none
7c======================================================================
8c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
9c Objet: Ecriture de l'etat de redemarrage pour la physique
10c======================================================================
11#include "dimensions.h"
12#include "dimphy.h"
13#include "netcdf.inc"
14#include "indicesol.h"
15#include "dimsoil.h"
16#include "clesphys.h"
17#include "control.h"
18c======================================================================
19      CHARACTER*(*) fichnom
20      REAL dtime
21      INTEGER radpas
22      REAL rlat(klon), rlon(klon)
23      REAL co2_ppm
24      REAL solaire
25      REAL tsol(klon,nbsrf)
26      REAL tsoil(klon,nsoilmx,nbsrf)
27      REAL deltat(klon)
28      REAL qsol(klon,nbsrf)
29      REAL snow(klon,nbsrf)
30      REAL radsol(klon)
31      REAL rugmer(klon)
32      REAL agesno(klon)
33      REAL zmea(klon)
34      REAL zstd(klon)
35      REAL zsig(klon)
36      REAL zgam(klon)
37      REAL zthe(klon)
38      REAL zpic(klon)
39      REAL zval(klon)
40      REAL rugsrel(klon)
41      REAL t_ancien(klon,klev), q_ancien(klon,klev)
42c
43      INTEGER nid, nvarid, idim1, idim2, idim3
44      INTEGER ierr
45      INTEGER length
46      PARAMETER (length=100)
47      REAL tab_cntrl(length)
48c
49      INTEGER isoil, nsrf
50      CHARACTER*7 str7
51      CHARACTER*2 str2
52c
53      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
54      IF (ierr.NE.NF_NOERR) THEN
55        write(6,*)' Pb d''ouverture du fichier '//fichnom
56        write(6,*)' ierr = ', ierr
57        CALL ABORT
58      ENDIF
59c
60      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
61     .                       "Fichier redemmarage physique")
62c
63      ierr = NF_DEF_DIM (nid, "index", length, idim1)
64      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
65      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
66c
67      ierr = NF_ENDDEF(nid)
68c
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) = dayref
86      tab_cntrl(14) = anneeref
87c
88      ierr = NF_REDEF (nid)
89#ifdef NC_DOUBLE
90      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
91#else
92      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
93#endif
94      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
95     .                        "Parametres de controle")
96      ierr = NF_ENDDEF(nid)
97#ifdef NC_DOUBLE
98      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
99#else
100      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
101#endif
102c
103      ierr = NF_REDEF (nid)
104#ifdef NC_DOUBLE
105      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
106#else
107      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
108#endif
109      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
110     .                        "Longitudes de la grille physique")
111      ierr = NF_ENDDEF(nid)
112#ifdef NC_DOUBLE
113      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
114#else
115      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
116#endif
117c
118      ierr = NF_REDEF (nid)
119#ifdef NC_DOUBLE
120      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
121#else
122      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
123#endif
124      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
125     .                        "Latitudes de la grille physique")
126      ierr = NF_ENDDEF(nid)
127#ifdef NC_DOUBLE
128      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
129#else
130      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
131#endif
132c
133c
134      DO nsrf = 1, nbsrf
135        IF (nsrf.LE.99) THEN
136        WRITE(str2,'(i2.2)') nsrf
137        ierr = NF_REDEF (nid)
138#ifdef NC_DOUBLE
139        ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid)
140#else
141        ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid)
142#endif
143        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
144     .                        "Temperature de surface No."//str2)
145        ierr = NF_ENDDEF(nid)
146        ELSE
147        PRINT*, "Trop de sous-mailles"
148        CALL abort
149        ENDIF
150#ifdef NC_DOUBLE
151        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1,nsrf))
152#else
153        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1,nsrf))
154#endif
155      ENDDO
156c
157      DO nsrf = 1, nbsrf
158      DO isoil=1, nsoilmx
159        IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
160        WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
161        ierr = NF_REDEF (nid)
162#ifdef NC_DOUBLE
163        ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid)
164#else
165        ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid)
166#endif
167        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29,
168     .                        "Temperature du sol No."//str7)
169        ierr = NF_ENDDEF(nid)
170        ELSE
171        PRINT*, "Trop de couches"
172        CALL abort
173        ENDIF
174#ifdef NC_DOUBLE
175        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf))
176#else
177        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf))
178#endif
179      ENDDO
180      ENDDO
181c
182c
183      ierr = NF_REDEF (nid)
184#ifdef NC_DOUBLE
185      ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid)
186#else
187      ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid)
188#endif
189      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
190     .                        "Ecart de la SST (pour slab-ocean)")
191      ierr = NF_ENDDEF(nid)
192#ifdef NC_DOUBLE
193      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat)
194#else
195      ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat)
196#endif
197c
198      DO nsrf = 1, nbsrf
199        IF (nsrf.LE.99) THEN
200        WRITE(str2,'(i2.2)') nsrf
201        ierr = NF_REDEF (nid)
202#ifdef NC_DOUBLE
203        ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid)
204#else
205        ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid)
206#endif
207        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
208     .                        "Humidite de surface No."//str2)
209        ierr = NF_ENDDEF(nid)
210        ELSE
211        PRINT*, "Trop de sous-mailles"
212        CALL abort
213        ENDIF
214#ifdef NC_DOUBLE
215      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol(1,nsrf))
216#else
217      ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol(1,nsrf))
218#endif
219      ENDDO
220c
221      DO nsrf = 1, nbsrf
222        IF (nsrf.LE.99) THEN
223        WRITE(str2,'(i2.2)') nsrf
224        ierr = NF_REDEF (nid)
225#ifdef NC_DOUBLE
226        ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid)
227#else
228        ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid)
229#endif
230        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
231     .                        "Neige de surface No."//str2)
232        ierr = NF_ENDDEF(nid)
233        ELSE
234        PRINT*, "Trop de sous-mailles"
235        CALL abort
236        ENDIF
237#ifdef NC_DOUBLE
238      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf))
239#else
240      ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf))
241#endif
242      ENDDO
243c
244      ierr = NF_REDEF (nid)
245#ifdef NC_DOUBLE
246      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
247#else
248      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
249#endif
250      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
251     .                        "Rayonnement net a la surface")
252      ierr = NF_ENDDEF(nid)
253#ifdef NC_DOUBLE
254      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
255#else
256      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
257#endif
258c
259      ierr = NF_REDEF (nid)
260#ifdef NC_DOUBLE
261      ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
262#else
263      ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
264#endif
265      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
266     .                        "Longueur de rugosite sur mer")
267      ierr = NF_ENDDEF(nid)
268#ifdef NC_DOUBLE
269      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugmer)
270#else
271      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugmer)
272#endif
273c
274      ierr = NF_REDEF (nid)
275#ifdef NC_DOUBLE
276      ierr = NF_DEF_VAR (nid, "AGESNO", NF_DOUBLE, 1, idim2,nvarid)
277#else
278      ierr = NF_DEF_VAR (nid, "AGESNO", NF_FLOAT, 1, idim2,nvarid)
279#endif
280      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
281     .                        "Age de la neige")
282      ierr = NF_ENDDEF(nid)
283#ifdef NC_DOUBLE
284      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno)
285#else
286      ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno)
287#endif
288c
289      ierr = NF_REDEF (nid)
290#ifdef NC_DOUBLE
291      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
292#else
293      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
294#endif
295      ierr = NF_ENDDEF(nid)
296#ifdef NC_DOUBLE
297      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
298#else
299      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
300#endif
301c
302      ierr = NF_REDEF (nid)
303#ifdef NC_DOUBLE
304      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
305#else
306      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
307#endif
308      ierr = NF_ENDDEF(nid)
309#ifdef NC_DOUBLE
310      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
311#else
312      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
313#endif
314c
315      ierr = NF_REDEF (nid)
316#ifdef NC_DOUBLE
317      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
318#else
319      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
320#endif
321      ierr = NF_ENDDEF(nid)
322#ifdef NC_DOUBLE
323      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
324#else
325      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
326#endif
327c
328      ierr = NF_REDEF (nid)
329#ifdef NC_DOUBLE
330      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
331#else
332      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
333#endif
334      ierr = NF_ENDDEF(nid)
335#ifdef NC_DOUBLE
336      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
337#else
338      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
339#endif
340c
341      ierr = NF_REDEF (nid)
342#ifdef NC_DOUBLE
343      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
344#else
345      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
346#endif
347      ierr = NF_ENDDEF(nid)
348#ifdef NC_DOUBLE
349      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
350#else
351      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
352#endif
353c
354      ierr = NF_REDEF (nid)
355#ifdef NC_DOUBLE
356      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
357#else
358      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
359#endif
360      ierr = NF_ENDDEF(nid)
361#ifdef NC_DOUBLE
362      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic)
363#else
364      ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic)
365#endif
366c
367      ierr = NF_REDEF (nid)
368#ifdef NC_DOUBLE
369      ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
370#else
371      ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
372#endif
373      ierr = NF_ENDDEF(nid)
374#ifdef NC_DOUBLE
375      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval)
376#else
377      ierr = NF_PUT_VAR_REAL (nid,nvarid,zval)
378#endif
379c
380      ierr = NF_REDEF (nid)
381#ifdef NC_DOUBLE
382      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
383#else
384      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
385#endif
386      ierr = NF_ENDDEF(nid)
387#ifdef NC_DOUBLE
388      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel)
389#else
390      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel)
391#endif
392c
393      ierr = NF_REDEF (nid)
394#ifdef NC_DOUBLE
395      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
396#else
397      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
398#endif
399      ierr = NF_ENDDEF(nid)
400#ifdef NC_DOUBLE
401      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
402#else
403      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
404#endif
405c
406      ierr = NF_REDEF (nid)
407#ifdef NC_DOUBLE
408      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
409#else
410      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
411#endif
412      ierr = NF_ENDDEF(nid)
413#ifdef NC_DOUBLE
414      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien)
415#else
416      ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien)
417#endif
418c
419      ierr = NF_CLOSE(nid)
420c
421      RETURN
422      END
Note: See TracBrowser for help on using the repository browser.