source: LMDZ.3.3/branches/rel-1-0-patch/libf/dyn3d/physdem.F @ 346

Last change on this file since 346 was 253, checked in by (none), 23 years ago

This commit was manufactured by cvs2svn to create branch
'rel-1-0-patch'.

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