source: trunk/MESOSCALE/LMDZ.MARS/libf_gcm/phymars/physdem1.F @ 1242

Last change on this file since 1242 was 57, checked in by aslmd, 14 years ago

mineur LMD_MM_MARS: ajout du GCM ancienne physique, systeme maintenant complet sur SVN (ne manque que la base de donnees d'etats initiaux)

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