source: LMDZ.3.3/trunk/libf/dyn3d/physdem.F @ 95

Last change on this file since 95 was 85, checked in by lmdzadmin, 25 years ago

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