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

Last change on this file since 2 was 2, checked in by lmdz, 25 years ago

Initial revision

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