source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagspecIR.F @ 245

Last change on this file since 245 was 245, checked in by ymipsl, 10 years ago
  • One call for initialize physics from dynamico
  • mpi_root renamed into mpi_master due to conflict with an existaing symbol from the mpi library

==> mpi_root => mpi_master, is_mpi_root => is_mpi_master, is_omp_root => is_omp_master

YM
File size: 9.9 KB
RevLine 
[222]1      subroutine writediagspecIR(ngrid,nom,titre,unite,dimpx,px)
2
3!  Ecriture de variables diagnostiques au choix dans la physique
4!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
5!  3d (ex : temperature), 2d (ex : temperature de surface), ou
6!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
7!  solaire)
8!  Dans la version 2000, la periode d'ecriture est celle de
9!  "ecritphy " regle dans le fichier de controle de run :  run.def
10!
11!    writediagfi peut etre appele de n'importe quelle subroutine
12!    de la physique, plusieurs fois. L'initialisation et la creation du
13!    fichier se fait au tout premier appel.
14!
15! WARNING : les variables dynamique (u,v,t,q,ps)
16!  sauvees par writediagfi avec une
17! date donnee sont legerement differentes que dans le fichier histoire car
18! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
19! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
20! avant l'ecriture dans diagfi (cf. physiq.F)
21! 
22!
23!  parametres (input) :
24!  ----------
25!      ngrid : nombres de point ou est calcule la physique
26!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
27!                 (= nlon ou klon dans la physique terrestre)
28!     
29!      unit : unite logique du fichier de sortie (toujours la meme)
30!      nom  : nom de la variable a sortir (chaine de caracteres)
31!      titre: titre de la variable (chaine de caracteres)
32!      unite : unite de la variable (chaine de caracteres)
33!      px : variable a sortir (real 0, 2, ou 3d)
34!      dimpx : dimension de px : 0, 2, ou 3 dimensions
35!
36!=================================================================
37!
38!      This is a modified version that accepts spectrally varying input
39!      RW (2010)
40!
41!=================================================================
42 
43! Addition by RW (2010) to allow OLR to be saved in .nc format
44      use radinc_h, only : L_NSPECTI
45!      USE surfdat_h, only : phisfi
46#ifdef CPP_PARA
[245]47      use mod_phys_lmdz_para, only : is_mpi_master, is_master, gather
[222]48      use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
49#endif
50      use control_mod, only: ecritphy, iphysiq, day_step
51
52      implicit none
53
54! Commons
55#include "dimensions.h"
[227]56!#include "dimphys.h"
[222]57#include "paramet.h"
58!#include "control.h"
59#include "comvert.h"
60#include "comgeom.h"
61#include "netcdf.inc"
62#include "temps.h"
63#include "callkeys.h"
64
65! Arguments on input:
66      integer,intent(in) :: ngrid
67      character (len=*),intent(in) :: nom,titre,unite
68      integer,intent(in) :: dimpx
69      real,intent(in) :: px(ngrid,L_NSPECTI)
70
71! Local variables:
72
73!      real dx3(iip1,jjp1,llm) ! to store a 3D data set
74!      real dx2(iip1,jjp1)     ! to store a 2D (surface) data set
75!      real dx0
76
77      real date
78
79!      REAL phis(ip1jmp1)
80
81      integer irythme
82      integer ierr
83      integer iq
84      integer i,j,l,zmax , ig0
85
86      integer zitau
87      character firstnom*20
88      SAVE firstnom
89      SAVE zitau
90      SAVE date
91      data firstnom /'1234567890'/
92      data zitau /0/
[227]93!$OMP THREADPRIVATE(firstnom,zitau,date)
[222]94
95! Ajouts
96      integer, save :: ntime=0
[227]97!$OMP THREADPRIVATE(ntime)
[222]98      integer :: idim,varid
99      integer :: nid
100      character (len =50):: fichnom
101      integer, dimension(4) :: id
102      integer, dimension(4) :: edges,corner
103
104! added by RDW for OLR output
105       real dx3(iip1,jjp1,L_NSPECTI) ! to store the data set
106
107#ifdef CPP_PARA
108! Added to work in parallel mode
109      real dx3_glop(klon_glo,L_NSPECTI)
110      real dx3_glo(iim,jjp1,L_NSPECTI) ! to store a global 3D data set
111#else
112      logical,parameter :: is_master=.true.
[245]113      logical,parameter :: is_mpi_master=.true.
[222]114#endif
115
116!***************************************************************
117!Sortie des variables au rythme voulu
118
119      irythme = ecritphy*iradia ! sortie au rythme de ecritphy*iradia
120!EM+JL if the spetra need to be output more frequently, need to define a ecritSpec...
121!     irythme = iphysiq  ! sortie a tous les pas physique
122
123
124!***************************************************************
125
126! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
127! ------------------------------------------------------------------------
128! (Au tout premier appel de la subroutine durant le run.)
129
130      fichnom="diagspecIR.nc"
131
132      if (firstnom.eq.'1234567890') then ! .true. for the very first call
133      !  to this subroutine; now set 'firstnom'
134         firstnom = nom
135         ! just to be sure, check that firstnom is large enough to hold nom
136         if (len_trim(firstnom).lt.len_trim(nom)) then
137           write(*,*) "writediagspecIR: Error !!!"
138           write(*,*) "   firstnom string not long enough!!"
139           write(*,*) "   increase its size to at least ",len_trim(nom)
140           stop
141         endif
142
143         ! Create the NetCDF file
144         if (is_master) then
145         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
146         ! Define the 'Time' dimension
147         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
148         ! Define the 'Time' variable
149#ifdef NC_DOUBLE
150         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
151#else
152         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
153#endif
154         ! Add a long_name attribute
155         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
156     .          4,"Time")
157         ! Add a units attribute
158         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
159     .          "days since 0000-00-0 00:00:00")
160         ! Switch out of NetCDF Define mode
161         ierr = NF_ENDDEF(nid)
162
163!         call gr_fi_dyn(1,size(phisfi_glo),iip1,jjp1,phisfi_glo,phis)
164         ! write "header" of file (longitudes, latitudes, area, ...)
165         call iniwrite_specIR(nid,day_ini)
166         endif ! of if (is_master)
167
168         zitau = -1 ! initialize zitau
169      else
170         if (is_master) then
171           ! Open the NetCDF file
172           ierr = NF_OPEN(fichnom,NF_WRITE,nid)
173         endif
174      endif ! if (firstnom.eq.'1234567890')
175
176! Increment time index 'zitau' if it is the "firstcall" (at given time level)
177! to writediagfi
178!------------------------------------------------------------------------
179      if (nom.eq.firstnom) then
180          zitau = zitau + iphysiq
181      end if
182
183!--------------------------------------------------------
184! Write the variables to output file if it's time to do so
185!--------------------------------------------------------
186
187      if ( MOD(zitau+1,irythme) .eq.0.) then
188
189! Compute/write/extend 'Time' coordinate (date given in days)
190! (done every "first call" (at given time level) to writediagfi)
191! Note: date is incremented as 1 step ahead of physics time
192!       (like the 'histoire' outputs)
193!--------------------------------------------------------
194
195        if (nom.eq.firstnom) then
196
197        ! We have identified a "first call" (at given date)
198           ntime=ntime+1 ! increment # of stored time steps
199           ! compute corresponding date (in days and fractions thereof)
200           date= float (zitau +1)/float (day_step)
201
202           if (is_master) then
203             ! Get NetCDF ID of 'Time' variable
204             ierr= NF_INQ_VARID(nid,"Time",varid)
205
206             ! Write (append) the new date to the 'Time' array
207#ifdef NC_DOUBLE
208             ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
209#else
210             ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
211#endif
212             if (ierr.ne.NF_NOERR) then
213              write(*,*) "***** PUT_VAR matter in writediagspec_nc"
214              write(*,*) "***** with time"
215              write(*,*) 'ierr=', ierr   
216c             call abort
217             endif
218
219             write(6,*)'WRITEDIAGSPEC: date= ', date
220           endif ! of if (is_master)
221        end if ! of if (nom.eq.firstnom)
222
223
224 
225!Case of a 3D variable
226!---------------------
227        if (dimpx.eq.3) then
228
229!         A. Recast (copy) variable from physics grid to dynamics grid
230#ifdef CPP_PARA
231  ! gather field on a "global" (without redundant longitude) array
232          call Gather(px,dx3_glop)
233!$OMP MASTER
[245]234          if (is_mpi_master) then
[222]235            call Grid1Dto2D_glo(dx3_glop,dx3_glo)
236            ! copy dx3_glo() to dx3(:) and add redundant longitude
237            dx3(1:iim,:,:)=dx3_glo(1:iim,:,:)
238            dx3(iip1,:,:)=dx3(1,:,:)
239          endif
240!$OMP END MASTER
241!$OMP BARRIER
242#else
243           DO l=1,L_NSPECTI
244             DO i=1,iip1
245                dx3(i,1,l)=px(1,l)
246                dx3(i,jjp1,l)=px(ngrid,l)
247             ENDDO
248             DO j=2,jjm
249                ig0= 1+(j-2)*iim
250                DO i=1,iim
251                   dx3(i,j,l)=px(ig0+i,l)
252                ENDDO
253                dx3(iip1,j,l)=dx3(1,j,l)
254             ENDDO
255           ENDDO
256#endif
257
258!         B. Write (append) the variable to the NetCDF file
259          if (is_master) then
260
261! name of the variable
262           ierr= NF_INQ_VARID(nid,nom,varid)
263           if (ierr /= NF_NOERR) then
264! corresponding dimensions
265              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
266              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
267              ierr= NF_INQ_DIMID(nid,"IR Wavenumber",id(3))
268              ierr= NF_INQ_DIMID(nid,"Time",id(4))
269
270! Create the variable if it doesn't exist yet
271
272              write (*,*) "=========================="
273              write (*,*) "DIAGSPECIR: creating variable ",nom
274              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
275
276           endif
277
278           corner(1)=1
279           corner(2)=1
280           corner(3)=1
281           corner(4)=ntime
282
283           edges(1)=iip1
284           edges(2)=jjp1
285           edges(3)=L_NSPECTI
286           edges(4)=1
287#ifdef NC_DOUBLE
288           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
289#else
290           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
291#endif
292
293           if (ierr.ne.NF_NOERR) then
294              write(*,*) "***** PUT_VAR problem in writediagspec"
295              write(*,*) "***** with ",nom
296              write(*,*) 'ierr=', ierr
297             call abort
298           endif
299
300          endif ! of if (is_master)
301
302        endif ! of if (dimpx.eq.3)
303
304      endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
305
306      ! Close the NetCDF file
307      if (is_master) then
308        ierr= NF_CLOSE(nid)
309      endif
310
311      end
Note: See TracBrowser for help on using the repository browser.