source: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/physdem1.F @ 2756

Last change on this file since 2756 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 14.2 KB
Line 
1      subroutine physdem1(filename,lonfi,latfi,nsoil,nq,
2     .                   phystep,day_ini,
3     .                   time,tsurf,tsoil,co2ice,emis,q2,qsurf,
4     .                   airefi,alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
5
6      IMPLICIT none
7c-------------------------------------------------------------
8C Author : L. Fairhead
9C Date   : 01/10/1999
10C Objet  : Ecriture des etats initiaux physiques
11c-------------------------------------------------------------
12c
13c
14c
15c
16c
17#include "dimensions.h"
18#include "paramet.h"
19c-----------------------------------------------------------------------
20#include "comvert.h"
21#include "comgeom2.h"
22#include "control.h"
23#include "comdissnew.h"
24#include "logic.h"
25#include "ener.h"
26#include "netcdf.inc"
27#include "dimphys.h"
28c
29      INTEGER nid,iq
30      INTEGER, parameter :: ivap=1
31      REAL, parameter :: qsolmax= 150.0
32      character (len=*) :: filename
33      character (len=7) :: str7
34
35      REAL day_ini
36      INTEGER nsoil,nq
37      integer ierr,idim1,idim2,idim3,idim4,idim5,nvarid
38
39c
40      REAL phystep,time
41      REAL latfi(ngridmx), lonfi(ngridmx)
42      REAL champhys(ngridmx)
43      REAL tsurf(ngridmx)
44      INTEGER length
45      PARAMETER (length=100)
46      REAL tab_cntrl(length)
47
48c
49
50ccccccccccccccccccccc g95 errors
51ccc probably looking for functions,
52ccc but disappointed when finding subroutines
53ccc
54ccc obsolete
55ccc
56ccc     
57c      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
58c      EXTERNAL exner_hyb , SSUM
59c
60ccccccccccccccccccccc g95 errors
61
62#include "serre.h"
63#include "clesph0.h"
64#include "fxyprim.h"
65#include "comgeomfi.h"
66#include "surfdat.h"
67#include "planete.h"
68#include "dimradmars.h"
69#include "yomaer.h"
70#include "comcstfi.h"
71
72      real co2ice(ngridmx),tsoil(ngridmx,nsoil),emis(ngridmx)
73      real q2(ngridmx, llm+1),qsurf(ngridmx,nq)
74      real airefi(ngridmx)
75      real alb(ngridmx),ith(ngridmx)
76      real pzmea(ngridmx),pzstd(ngridmx)
77      real pzsig(ngridmx),pzgam(ngridmx),pzthe(ngridmx)
78      integer ig
79      INTEGER lnblnk
80      EXTERNAL lnblnk
81
82c-----------------------------------------------------------------------
83
84      CALL SCOPY(ngridmx,airefi,1,area,1)
85      DO ig=1,ngridmx
86         albedodat(ig)=alb(ig)
87         inertiedat(ig)=ith(ig)
88         zmea(ig)=pzmea(ig)
89         zstd(ig)=pzstd(ig)
90         zsig(ig)=pzsig(ig)
91         zgam(ig)=pzgam(ig)
92         zthe(ig)=pzthe(ig)
93      ENDDO
94c
95c  stockage sur le fichier Physique:
96c
97      ierr = NF_CREATE(trim((filename)),NF_CLOBBER, nid)
98      IF (ierr.NE.NF_NOERR) THEN
99        WRITE(6,*)' Problem creating restartfi.nc'
100        WRITE(6,*)' ierr = ', ierr
101        CALL ABORT
102      ENDIF
103c
104      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 26,
105     .                       "Fichier demarrage physique")
106c
107      ierr = NF_DEF_DIM (nid,"index",length,idim1)
108      ierr = NF_DEF_DIM (nid,"physical_points",ngridmx,idim2)
109      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoil,idim3)
110      ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
111      ierr = NF_DEF_DIM (nid,"number_of_advected_fields",nq,idim5)
112c
113      ierr = NF_ENDDEF(nid)
114c
115      DO ierr = 1, length
116         tab_cntrl(ierr) = 0.0
117      ENDDO
118
119      write(*,*) "ngridmx: ",ngridmx
120
121ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
122c pour la DOCUMENTATION    (fichier io/maj/fi_cntl)
123ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
124c Info sur la grille physique
125      tab_cntrl(1) = float(ngridmx)  ! nombre de points de la grille physique
126      tab_cntrl(2) = float(nlayermx) ! nombre de couches
127      tab_cntrl(3) = day_ini + int(time)         ! jour initial
128      tab_cntrl(4) = time -int(time)            ! heure initiale 0
129
130c Info sur la Planete Mars pour la dynamique et la physique
131      tab_cntrl(5) = rad      ! rayon de mars(m) ~3397200
132      tab_cntrl(6) = omeg     ! vitesse de rotation (rad.s-1)
133      tab_cntrl(7) = g        ! gravite (m.s-2) ~3.72
134      tab_cntrl(8) = mugaz    ! Masse molaire de l''atm (g.mol-1) ~43.49
135      tab_cntrl(9) = rcp      !  = r/cp  ~0.256793 (=kappa dans dynamique)
136      tab_cntrl(10) = daysec  ! duree du sol (s)  ~88775
137
138      tab_cntrl(11) = phystep  ! pas de temps de la physique
139      tab_cntrl(12) = 0.
140      tab_cntrl(13) = 0.
141
142c Info sur la Planete Mars pour la physique uniquement
143      tab_cntrl(14) = year_day  ! duree de l''annee (sols) ~668.6
144      tab_cntrl(15) = periheli  ! dist.min. soleil-mars (Mkm) ~206.66
145      tab_cntrl(16) = aphelie   ! dist.max. soleil-mars (Mkm) ~249.22
146      tab_cntrl(17) = peri_day  ! date du perihelie (sols depuis printemps)
147      tab_cntrl(18) = obliquit  ! Obliquite de la planete (deg) ~23.98
148
149c Couche limite et Turbulence
150      tab_cntrl(19) = z0        ! surface roughness (m) ~0.01
151      tab_cntrl(20) = lmixmin   ! longueur de melange ~100
152      tab_cntrl(21) = emin_turb ! energie minimale ~1.e-8
153
154c propriete optiques des calottes et emissivite du sol
155      tab_cntrl(22) = albedice(1)  ! Albedo calotte nord ~0.5
156      tab_cntrl(23) = albedice(2)  ! Albedo calotte sud ~0.5
157      tab_cntrl(24) = emisice(1)   ! Emissivite calotte nord ~0.95
158      tab_cntrl(25) = emisice(2)   ! Emissivite calotte sud ~0.95
159      tab_cntrl(26) = emissiv      ! Emissivite du sol martien ~.95
160      tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
161      tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
162      tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
163      tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
164
165c Proprietes des poussiere aerosol
166      tab_cntrl(27) = tauvis      ! profondeur optique visible moyenne
167
168      tab_cntrl(28) = 0.
169      tab_cntrl(29) = 0.
170      tab_cntrl(30) = 0.
171
172cc   ***    new_oliq   (  commentaires de L. LI dans routine physique )
173cc   ***  ok_orodr  et ok_orolf   si on appelle l'orographie      ****
174c
175      ierr = NF_REDEF (nid)
176#ifdef NC_DOUBLE
177      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
178#else
179      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
180#endif
181      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
182     .                        "Parametres de controle")
183      ierr = NF_ENDDEF(nid)
184#ifdef NC_DOUBLE
185      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
186#else
187      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
188#endif
189c
190      ierr = NF_REDEF (nid)
191#ifdef NC_DOUBLE
192      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
193#else
194      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
195#endif
196      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
197     .                        "Longitudes de la grille physique")
198      ierr = NF_ENDDEF(nid)
199
200#ifdef NC_DOUBLE
201      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
202#else
203      ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
204#endif
205c
206      ierr = NF_REDEF (nid)
207#ifdef NC_DOUBLE
208      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
209#else
210      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
211#endif
212      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
213     .                        "Latitudes de la grille physique")
214      ierr = NF_ENDDEF(nid)
215#ifdef NC_DOUBLE
216      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
217#else
218      ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
219#endif
220c
221      ierr = NF_REDEF (nid)
222#ifdef NC_DOUBLE
223      ierr = NF_DEF_VAR (nid, "area", NF_DOUBLE, 1, idim2,nvarid)
224#else
225      ierr = NF_DEF_VAR (nid, "area", NF_FLOAT, 1, idim2,nvarid)
226#endif
227      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
228     .                        "Aire des mailles")
229      ierr = NF_ENDDEF(nid)
230#ifdef NC_DOUBLE
231      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
232#else
233      ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
234#endif
235c
236      ierr = NF_REDEF (nid)
237#ifdef NC_DOUBLE
238      ierr = NF_DEF_VAR (nid, "phisfi", NF_DOUBLE, 1, idim2,nvarid)
239#else
240      ierr = NF_DEF_VAR (nid, "phisfi", NF_FLOAT, 1, idim2,nvarid)
241#endif
242      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
243     .                        "Geopotentiel au sol")
244      ierr = NF_ENDDEF(nid)
245#ifdef NC_DOUBLE
246      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phisfi)
247#else
248      ierr = NF_PUT_VAR_REAL (nid,nvarid,phisfi)
249#endif
250c
251      ierr = NF_REDEF (nid)
252#ifdef NC_DOUBLE
253      ierr = NF_DEF_VAR (nid, "albedodat", NF_DOUBLE, 1, idim2,nvarid)
254#else
255      ierr = NF_DEF_VAR (nid, "albedodat", NF_FLOAT, 1, idim2,nvarid)
256#endif
257      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
258     .                        "Albedo du sol nu")
259      ierr = NF_ENDDEF(nid)
260#ifdef NC_DOUBLE
261      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedodat)
262#else
263      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedodat)
264#endif
265c
266      ierr = NF_REDEF (nid)
267#ifdef NC_DOUBLE
268      ierr = NF_DEF_VAR (nid, "inertiedat", NF_DOUBLE, 1, idim2,nvarid)
269#else
270      ierr = NF_DEF_VAR (nid, "inertiedat", NF_FLOAT, 1, idim2,nvarid)
271#endif
272      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 24,
273     .                        "Inertie thermique du sol")
274      ierr = NF_ENDDEF(nid)
275#ifdef NC_DOUBLE
276      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
277#else
278      ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
279#endif
280c
281c   fichier pour les programmes de Francois Lott
282
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_PUT_ATT_TEXT (nid, nvarid, "title", 12,
290     .                        "Relief moyen")
291      ierr = NF_ENDDEF(nid)
292#ifdef NC_DOUBLE
293      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
294#else
295      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
296#endif
297c
298      ierr = NF_REDEF (nid)
299#ifdef NC_DOUBLE
300      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
301#else
302      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
303#endif
304      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
305     .                        "Ecartype du relief")
306      ierr = NF_ENDDEF(nid)
307#ifdef NC_DOUBLE
308      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
309#else
310      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
311#endif
312c
313      ierr = NF_REDEF (nid)
314#ifdef NC_DOUBLE
315      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
316#else
317      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
318#endif
319      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
320     .                        "Relief: parametre sigma")
321      ierr = NF_ENDDEF(nid)
322#ifdef NC_DOUBLE
323      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
324#else
325      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
326#endif
327c
328      ierr = NF_REDEF (nid)
329#ifdef NC_DOUBLE
330      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
331#else
332      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
333#endif
334      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
335     .                        "Relief: parametre gamma")
336      ierr = NF_ENDDEF(nid)
337#ifdef NC_DOUBLE
338      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
339#else
340      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
341#endif
342c
343      ierr = NF_REDEF (nid)
344#ifdef NC_DOUBLE
345      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
346#else
347      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
348#endif
349      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
350     .                        "Relief: parametre theta")
351      ierr = NF_ENDDEF(nid)
352#ifdef NC_DOUBLE
353      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
354#else
355      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
356#endif
357
358c Ecriture des champs physiques
359      ierr = NF_REDEF (nid)
360#ifdef NC_DOUBLE
361      ierr = NF_DEF_VAR (nid, "co2ice", NF_DOUBLE, 1, idim2,nvarid)
362#else
363      ierr = NF_DEF_VAR (nid, "co2ice", NF_FLOAT, 1, idim2,nvarid)
364#endif
365      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 13,
366     .                        "CO2 ice cover")
367      ierr = NF_ENDDEF(nid)
368#ifdef NC_DOUBLE
369      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,co2ice)
370#else
371      ierr = NF_PUT_VAR_REAL (nid,nvarid,co2ice)
372#endif
373c
374      ierr = NF_REDEF (nid)
375#ifdef NC_DOUBLE
376      ierr = NF_DEF_VAR (nid, "tsurf", NF_DOUBLE, 1, idim2,nvarid)
377#else
378      ierr = NF_DEF_VAR (nid, "tsurf", NF_FLOAT, 1, idim2,nvarid)
379#endif
380      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
381     .                        "Surface temperature")
382      ierr = NF_ENDDEF(nid)
383#ifdef NC_DOUBLE
384      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsurf)
385#else
386      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsurf)
387#endif
388c
389      ierr = NF_REDEF (nid)
390#ifdef NC_DOUBLE
391      ierr = NF_DEF_VAR (nid,"tsoil",NF_DOUBLE,2,(/idim2,idim3/),nvarid)
392#else
393      ierr = NF_DEF_VAR (nid,"tsoil",NF_FLOAT,2,(/idim2,idim3/),nvarid)
394#endif
395      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
396     .                        "Soil temperature")
397      ierr = NF_ENDDEF(nid)
398#ifdef NC_DOUBLE
399      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil)
400#else
401      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil)
402#endif
403c
404      ierr = NF_REDEF (nid)
405#ifdef NC_DOUBLE
406      ierr = NF_DEF_VAR (nid, "emis", NF_DOUBLE, 1, idim2,nvarid)
407#else
408      ierr = NF_DEF_VAR (nid, "emis", NF_FLOAT, 1, idim2,nvarid)
409#endif
410      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
411     .                        "Surface emissivity")
412      ierr = NF_ENDDEF(nid)
413#ifdef NC_DOUBLE
414      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,emis)
415#else
416      ierr = NF_PUT_VAR_REAL (nid,nvarid,emis)
417#endif
418c
419      ierr = NF_REDEF (nid)
420#ifdef NC_DOUBLE
421      ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 2,
422     .  (/idim2,idim4/),nvarid)
423c****WRF: ligne trop longue ....
424#else
425      ierr = NF_DEF_VAR (nid, "q2", NF_FLOAT, 2,(/idim2,idim4/),nvarid)
426#endif
427      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
428     .                        "pbl wind variance")
429      ierr = NF_ENDDEF(nid)
430#ifdef NC_DOUBLE
431      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q2)
432#else
433      ierr = NF_PUT_VAR_REAL (nid,nvarid,q2)
434#endif
435c
436      IF(nq.GE.1) THEN
437         DO iq=1,nq
438            str7(1:5)='qsurf'
439            WRITE(str7(6:7),'(i2.2)') iq
440            ierr = NF_REDEF (nid)
441#ifdef NC_DOUBLE
442            ierr = NF_DEF_VAR (nid,str7,NF_DOUBLE,1,idim2,nvarid)
443#else
444            ierr = NF_DEF_VAR (nid,str7,NF_FLOAT,1,idim2,nvarid)
445#endif
446            ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
447     .                        "tracer on surface")
448            ierr = NF_ENDDEF(nid)
449#ifdef NC_DOUBLE
450            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
451#else
452            ierr = NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
453#endif
454         ENDDO
455      ENDIF
456c
457      ierr = NF_CLOSE(nid)
458
459      RETURN
460
461      END
Note: See TracBrowser for help on using the repository browser.