source: LMDZ.3.3/branches/LF/libf/dyn3d/physdem.F @ 2793

Last change on this file since 2793 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.3 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(iip1,jjp1),zstd(iip1,jjp1)
44      REAL zsig(iip1,jjp1),zgam(iip1,jjp1),zthe(iip1,jjp1)
45      REAL zpic(iip1,jjp1),zval(iip1,jjp1)
46      REAL rugsrel(iip1,jjp1)
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      CALL gr_dyn_fi(1, iip1, jjp1, klon, zmea, champhys)
283      ierr = NF_REDEF (nid)
284#ifdef NC_DOUBLE
285      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
286#else
287      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
288#endif
289      ierr = NF_ENDDEF(nid)
290#ifdef NC_DOUBLE
291      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
292#else
293      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
294#endif
295c
296      CALL gr_dyn_fi(1, iip1, jjp1, klon, zstd, champhys)
297      ierr = NF_REDEF (nid)
298#ifdef NC_DOUBLE
299      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
300#else
301      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
302#endif
303      ierr = NF_ENDDEF(nid)
304#ifdef NC_DOUBLE
305      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
306#else
307      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
308#endif
309
310      CALL gr_dyn_fi(1, iip1, jjp1, klon, zsig, champhys)
311      ierr = NF_REDEF (nid)
312#ifdef NC_DOUBLE
313      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
314#else
315      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
316#endif
317      ierr = NF_ENDDEF(nid)
318#ifdef NC_DOUBLE
319      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
320#else
321      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
322#endif
323
324      CALL gr_dyn_fi(1, iip1, jjp1, klon, zgam, champhys)
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,champhys)
334#else
335      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
336#endif
337
338      CALL gr_dyn_fi(1, iip1, jjp1, klon, zthe, champhys)
339      ierr = NF_REDEF (nid)
340#ifdef NC_DOUBLE
341      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
342#else
343      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
344#endif
345      ierr = NF_ENDDEF(nid)
346#ifdef NC_DOUBLE
347      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
348#else
349      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
350#endif
351
352      CALL gr_dyn_fi(1, iip1, jjp1, klon, zpic, champhys)
353      ierr = NF_REDEF (nid)
354#ifdef NC_DOUBLE
355      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
356#else
357      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
358#endif
359      ierr = NF_ENDDEF(nid)
360#ifdef NC_DOUBLE
361      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
362#else
363      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
364#endif
365
366      CALL gr_dyn_fi(1, iip1, jjp1, klon, zval, champhys)
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,champhys)
376#else
377      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
378#endif
379
380      CALL gr_dyn_fi(1, iip1, jjp1, klon, rugsrel, champhys)
381      ierr = NF_REDEF (nid)
382#ifdef NC_DOUBLE
383      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
384#else
385      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
386#endif
387      ierr = NF_ENDDEF(nid)
388#ifdef NC_DOUBLE
389      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
390#else
391      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
392#endif
393c
394      ierr = NF_CLOSE(nid)
395
396      RETURN
397
398      END
Note: See TracBrowser for help on using the repository browser.