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

Last change on this file since 481 was 51, checked in by lmdzadmin, 25 years ago

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