source: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/meso_writediagfi.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: 13.4 KB
Line 
1      subroutine meso_writediagfi(ngrid,nom,titre,unite,dim,px)
2
3c=======================================================================
4c
5c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
6c
7c       ... CHECK THE ****WRF lines
8c
9c=======================================================================
10!  Ecriture de variables diagnostiques au choix dans la physique
11!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
12!  3d (ex : temperature), 2d (ex : temperature de surface), ou
13!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
14!  solaire)
15!  Dans la version 2000, la periode d'ecriture est celle de
16!  "ecritphy " regle dans le fichier de controle de run :  run.def
17!
18!    writediagfi peut etre appele de n'importe quelle subroutine
19!    de la physique, plusieurs fois. L'initialisation et la creation du
20!    fichier se fait au tout premier appel.
21!
22! WARNING : les variables dynamique (u,v,t,q,ps)
23!  sauvees par writediagfi avec une
24! date donnee sont legerement differentes que dans le fichier histoire car
25! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
26! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
27! avant l'ecriture dans diagfi (cf. physiq.F)
28
29!
30!  parametres (input) :
31!  ----------
32!      ngrid : nombres de point ou est calcule la physique
33!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
34!                 (= nlon ou klon dans la physique terrestre)
35!     
36!      unit : unite logique du fichier de sortie (toujours la meme)
37!      nom  : nom de la variable a sortir (chaine de caracteres)
38!      titre: titre de la variable (chaine de caracteres)
39!      unite : unite de la variable (chaine de caracteres)
40!      px : variable a sortir (real 0, 2, ou 3d)
41!      dim : dimension de px : 0, 2, ou 3 dimensions
42!
43!=================================================================
44 
45      implicit none
46
47! Arguments variable
48
49! Local variables
50#include "dimensions.h"
51#include "dimphys.h"
52#include "paramet.h"
53#include "control.h"
54#include "comvert.h"
55#include "comgeom.h"
56#include "description.h"
57#include "netcdf.inc"
58#include "temps.h"
59#include "surfdat.h"
60
61      integer ngrid
62       
63!****WRF
64        INTEGER idim_alt,idim_lon,idim_lat
65        REAL px(ngrid,nlayermx)
66        REAL dx3(wiim,wjjm,nlayermx),dx2(wiim,wjjm)
67!****WRF
68!!      REAL px(ngrid,llm)
69!!      REAL dx3(iip1,jjp1,llm),dx2(iip1,jjp1)
70
71      REAL dx0
72
73      real date
74      character (len=*) :: nom,titre,unite
75
76      REAL phis(ip1jmp1)
77
78      integer dim
79      integer irythme
80      integer ierr
81      integer iq
82      integer i,j,l,zmax , ig0
83
84      integer zitau
85      character firstnom*10
86      SAVE firstnom
87      SAVE zitau
88      SAVE date
89      data firstnom /'1234567890'/
90      data zitau /0/
91
92! Ajouts
93      integer, save :: ntime=0
94      integer :: idim,varid
95      integer :: nid
96      character (len =50):: fichnom
97      integer, dimension(4) :: id
98      integer, dimension(4) :: edges,corner
99     
100
101!***************************************************************
102!Sortie des variables au rythme voulu
103
104      irythme = int(ecritphy) ! sortie au rythme de ecritphy
105        !print*,irythme
106!     irythme = iconser  ! sortie au rythme des variables de controle
107!     irythme = iphysiq  ! sortie a tous les pas physique
108!     irythme = iecri*day_step ! sortie au rythme des fichiers histoires
109!     irythme = periodav*day_step ! sortie au rythme des fichiers histmoy
110
111!***************************************************************
112 
113c     nom=trim((nom))
114c     unite=trim((unite))
115c     titre=trim((titre))
116
117c
118c lat / lon / alt dimensions from WRF (in dimphys.h)
119c
120        idim_lat=wjjm
121c        write (*,*) "lat",idim_lat
122        idim_lon=wiim
123c        write (*,*) "lon",idim_lon
124        idim_alt=nlayermx
125c        write (*,*) "alt",idim_alt     
126
127
128
129! initialisation de 'firstnom' / ouverture du fichier NetCDF
130! ----------------------------------------------------------
131! (Au tout premier appel de la subroutine durant le run.)
132
133      if(ngrid.eq.1) return ! don't use writediagfi with 1D version
134
135      fichnom="diagfi.nc"
136      if (firstnom.eq.'1234567890') then
137         firstnom = nom
138
139!****WRF
140!         call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis)
141!****WRF
142
143! assign Logical Unit: ouverture du fichier NetCDF
144         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
145! Creation de la dimension (temps)
146         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
147        ierr = NF_DEF_DIM (nid, "latitude", wjjm, idim_lat)
148        ierr = NF_DEF_DIM (nid, "longitude", wiim, idim_lon)
149        ierr = NF_DEF_DIM (nid, "altitude", nlayermx,idim_alt)
150
151
152#ifdef NC_DOUBLE
153         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
154#else
155         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
156#endif
157         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
158     .          4,"Time")
159         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
160     .          "days since 0000-00-0 00:00:00")
161         ierr = NF_ENDDEF(nid)
162! ecriture de l'entete du fichier (longitudes, latitudes ... relief)
163
164!!****caca caca
165!                phis(:)=0.   
166!         call iniwrite(nid,day_ini , phis)
167!!
168!        ierr = NF_DEF_DIM (nid, "latitude", wjjm, idim_lat)
169!        ierr = NF_DEF_DIM (nid, "longitude", wiim, idim_lon)
170!        ierr = NF_DEF_DIM (nid, "altitude", nlayermx, idim_alt)
171#ifdef NC_DOUBLE
172      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_lat,varid)
173#else
174      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_lat,varid)
175#endif
176      ierr =NF_PUT_ATT_TEXT(nid,varid,'units',13,"degrees_north")
177      ierr = NF_PUT_ATT_TEXT (nid,varid,"long_name", 14,
178     .      "North latitude")
179      ierr = NF_ENDDEF(nid)
180!#ifdef NC_DOUBLE
181!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
182!#else
183!      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
184!#endif
185#ifdef NC_DOUBLE
186      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_lon,varid)
187#else
188      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1,idim_lon,varid)
189#endif
190      ierr = NF_PUT_ATT_TEXT (nid,varid,"long_name",14,
191     .      "East longitude")
192      ierr =NF_PUT_ATT_TEXT(nid,varid,'units',12,"degrees_east")
193      ierr = NF_ENDDEF(nid)
194!#ifdef NC_DOUBLE
195!      ierr = NF_PUT_VAR_DOUBLE(nid,nvarid,rlonv/pi*180)
196!#else
197!      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
198!#endif
199#ifdef NC_DOUBLE
200      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
201     .       idim_alt,varid)
202#else
203      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
204     .       idim_alt,varid)
205#endif
206      ierr = NF_PUT_ATT_TEXT (nid,varid,"long_name",10,"pseudo-alt")
207      ierr = NF_PUT_ATT_TEXT (nid,varid,'units',2,"km")
208      ierr = NF_PUT_ATT_TEXT (nid,varid,'positive',2,"up")
209
210      ierr = NF_ENDDEF(nid)
211!#ifdef NC_DOUBLE
212!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
213!#else
214!      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
215!#endif
216
217
218
219         zitau = -1
220      else
221         ierr = NF_OPEN(fichnom,NF_WRITE,nid)
222      endif
223
224!incrementation de temps a chaque premier appel de WRITEDIAGFI ds la physique
225!------------------------------------------------------------------------
226      if (nom.eq.firstnom) then
227          !! -- elapsed seconds --   
228          zitau = zitau + iphysiq
229          !! iphysiq is ptimestep         
230      end if
231
232!--------------------------------------------------------
233!Sortie des variables au rythme voulu
234!--------------------------------------------------------
235
236      if ( MOD(zitau+1,irythme) .eq.0.) then
237
238!Calcul/ecriture/extension de la coordonnee temps (date en jours)
239!--------------------------------------------------------
240!(effectuee a chaque premier appel de writediagfi ds la physique)
241!On date les sorties comme histoire, c.a.d un pas de temps plus loin !
242
243!Detection du changement de temps
244        if (nom.eq.firstnom) then
245           ntime=ntime+1
246!           date= float (zitau +1)/float (day_step)
247           date=float(zitau+1)/3700.
248!
249           ierr= NF_INQ_VARID(nid,"Time",varid)
250#ifdef NC_DOUBLE
251           ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
252#else
253           ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
254#endif
255           if (ierr.ne.NF_NOERR) then
256              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
257              write(*,*) "***** with time"
258              write(*,*) 'ierr=', ierr   
259c             call abort
260           endif
261
262           write(6,*)'WRITEDIAGFI: date= ', date
263        end if
264
265!Cas Variable 3D
266!---------------
267        if (dim.eq.3) then
268
269!         Passage variable physique -->  variable dynamique
270
271!****WRF
272
273           DO l=1,nlayermx
274             DO j=1,wjjm
275                ig0=(j-1)*wiim
276                DO i=1,wiim
277                   dx3(i,j,l)=px(ig0+i,l)
278                ENDDO
279             ENDDO
280           ENDDO
281
282
283!!           DO l=1,llm
284!!             DO i=1,iip1
285!!                dx3(i,1,l)=px(1,l)
286!!                dx3(i,jjp1,l)=px(ngrid,l)
287!!             ENDDO
288!!             DO j=2,jjm
289!!                ig0= 1+(j-2)*iim
290!!                DO i=1,iim
291!!                   dx3(i,j,l)=px(ig0+i,l)
292!!                ENDDO
293!!                dx3(iip1,j,l)=dx3(1,j,l)
294!!             ENDDO
295!!           ENDDO
296
297!****WRF
298
299!         Ecriture du champs
300
301!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
302!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
303! nom de la variable
304           ierr= NF_INQ_VARID(nid,nom,varid)
305           if (ierr /= NF_NOERR) then
306! choix du nom des coordonnees
307              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
308              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
309              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
310              ierr= NF_INQ_DIMID(nid,"Time",id(4))
311
312! Creation de la variable si elle n'existait pas
313
314              write (*,*) "====================="
315              write (*,*) "DIAGFI: creation de ",nom
316              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
317
318           endif
319
320           corner(1)=1
321           corner(2)=1
322           corner(3)=1
323           corner(4)=ntime
324!****WRF
325!!           edges(1)=iip1
326!!           edges(2)=jjp1
327           edges(1)=wiim
328           edges(2)=wjjm
329           edges(3)=nlayermx
330!****WRF
331
332           edges(4)=1
333#ifdef NC_DOUBLE
334           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
335#else
336           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
337#endif
338
339           if (ierr.ne.NF_NOERR) then
340              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
341              write(*,*) "***** with ",nom
342              write(*,*) 'ierr=', ierr
343c             call abort
344           endif
345
346!Cas Variable 2D
347!---------------
348
349        else if (dim.eq.2) then
350
351!         Passage variable physique -->  physique dynamique
352
353!****WRF
354
355!           DO l=1,nlayermx
356             DO j=1,wjjm
357                ig0=(j-1)*wiim
358                DO i=1,wiim
359                   dx2(i,j)=px(ig0+i,1)
360                ENDDO
361             ENDDO
362!           ENDDO
363
364!!             DO i=1,iip1
365!!                dx2(i,1)=px(1,1)
366!!                dx2(i,jjp1)=px(ngrid,1)
367!!             ENDDO
368!!             DO j=2,jjm
369!!                ig0= 1+(j-2)*iim
370!!                DO i=1,iim
371!!                   dx2(i,j)=px(ig0+i,1)
372!!                ENDDO
373!!                dx2(iip1,j)=dx2(1,j)
374!!             ENDDO
375
376!****WRF
377
378!         Ecriture du champs
379
380!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
381!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
382           ierr= NF_INQ_VARID(nid,nom,varid)
383           if (ierr /= NF_NOERR) then
384!  choix du nom des coordonnees
385              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
386              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
387              ierr= NF_INQ_DIMID(nid,"Time",id(3))
388
389! Creation de la variable si elle n'existait pas
390
391              write (*,*) "====================="
392              write (*,*) "DIAGFI: creation de ",nom
393
394              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
395
396           endif
397
398           corner(1)=1
399           corner(2)=1
400           corner(3)=ntime
401!****WRF
402!!           edges(1)=iip1
403!!           edges(2)=jjp1
404           edges(1)=wiim
405           edges(2)=wjjm
406!****WRF
407           edges(3)=1
408
409
410#ifdef NC_DOUBLE
411           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2)
412#else         
413           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
414#endif     
415
416           if (ierr.ne.NF_NOERR) then
417              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
418              write(*,*) "***** with ",nom
419              write(*,*) 'ierr=', ierr
420c             call abort
421           endif
422
423!Cas Variable 0D (scalaire dependant du temps)
424!---------------------------------------------
425
426        else if (dim.eq.0) then
427           dx0 = px (1,1)
428
429!         Ecriture du champs
430
431!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
432           ierr= NF_INQ_VARID(nid,nom,varid)
433           if (ierr /= NF_NOERR) then
434!  choix du nom des coordonnees
435              ierr= NF_INQ_DIMID(nid,"Time",id(1))
436
437! Creation de la variable si elle n'existait pas
438
439              write (*,*) "====================="
440              write (*,*) "DIAGFI: creation de ",nom
441
442              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
443
444           endif
445
446           corner(1)=ntime
447           edges(1)=1
448
449#ifdef NC_DOUBLE
450           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0) 
451#else
452           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
453#endif
454           if (ierr.ne.NF_NOERR) then
455              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
456              write(*,*) "***** with ",nom
457              write(*,*) 'ierr=', ierr
458c             call abort
459           endif
460
461        endif
462
463      endif
464
465      ierr= NF_CLOSE(nid)
466
467      end
Note: See TracBrowser for help on using the repository browser.