source: trunk/LMDZ.TITAN/libf/phytitan/writediagspecIR.F @ 3000

Last change on this file since 3000 was 1543, checked in by emillour, 9 years ago

All models: Further adaptations to keep up with changes in LMDZ5 concerning
physics/dynamics separation:

  • dyn3d:
  • adapted gcm.F so that all physics initializations are now done in iniphysiq.
  • dyn3dpar:
  • adapted gcm.F so that all physics initializations are now done in iniphysiq.
  • updated calfis_p.F to follow up with changes.
  • copied over updated "bands.F90" from LMDZ5.
  • dynphy_lonlat:
  • calfis_p.F90, mod_interface_dyn_phys.F90, follow up of changes in phy_common/mod_* routines
  • phy_common:
  • added "geometry_mod.F90" to store information about the grid (replaces phy*/comgeomphy.F90) and give variables friendlier names: rlond => longitude , rlatd => latitude, airephy => cell_area, cuphy => dx , cvphy => dy
  • added "physics_distribution_mod.F90"
  • updated "mod_grid_phy_lmdz.F90", "mod_phys_lmdz_mpi_data.F90", "mod_phys_lmdz_para.F90", "mod_phys_lmdz_mpi_transfert.F90", "mod_grid_phy_lmdz.F90", "mod_phys_lmdz_omp_data.F90", "mod_phys_lmdz_omp_transfert.F90", "write_field_phy.F90" and "ioipsl_getin_p_mod.F90" to LMDZ5 versions.
  • phy[venus/titan/mars/std]:
  • removed "init_phys_lmdz.F90", "comgeomphy.F90"; adapted routines to use geometry_mod (longitude, latitude, cell_area, etc.)

EM

File size: 11.2 KB
Line 
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 geometry_mod, only: cell_area
46      use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather
47      use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo,
48     &                              nbp_lon, nbp_lat
49      use time_phylmdz_mod, only: ecritphy, iphysiq, day_step, day_ini
50      use callkeys_mod, only: iradia
51
52      implicit none
53
54      include "netcdf.inc"
55
56! Arguments on input:
57      integer,intent(in) :: ngrid
58      character (len=*),intent(in) :: nom,titre,unite
59      integer,intent(in) :: dimpx
60      real,intent(in) :: px(ngrid,L_NSPECTI)
61
62! Local variables:
63
64!      real dx3(iip1,jjp1,llm) ! to store a 3D data set
65!      real dx2(iip1,jjp1)     ! to store a 2D (surface) data set
66!      real dx0
67
68      integer irythme
69      integer ierr
70      integer iq
71      integer i,j,l,zmax , ig0
72
73      integer,save :: zitau=0
74      character(len=20),save :: firstnom='1234567890'
75      real,save :: date
76!$OMP THREADPRIVATE(firstnom,zitau,date)
77
78! Ajouts
79      integer, save :: ntime=0
80!$OMP THREADPRIVATE(ntime)
81      integer :: idim,varid
82      integer :: nid
83      character (len =50):: fichnom
84      integer, dimension(4) :: id
85      integer, dimension(4) :: edges,corner
86
87      real area((nbp_lon+1),nbp_lat)
88! added by RDW for OLR output
89      real dx3(nbp_lon+1,nbp_lat,L_NSPECTI) ! to store the data set
90      real dx3_1d(1,L_NSPECTI) ! to store the data with 1D model
91
92#ifdef CPP_PARA
93! Added to work in parallel mode
94      real dx3_glop(klon_glo,L_NSPECTI)
95      real dx3_glo(nbp_lon,nbp_lat,L_NSPECTI) ! to store a global 3D data set
96      real areafi_glo(klon_glo) ! mesh area on global physics grid
97#else
98      real areafi_glo(ngrid) ! mesh area on global physics grid
99#endif
100
101!***************************************************************
102!Sortie des variables au rythme voulu
103
104      irythme = ecritphy*iradia ! sortie au rythme de ecritphy*iradia
105!EM+JL if the spetra need to be output more frequently, need to define a ecritSpec...
106!     irythme = iphysiq  ! sortie a tous les pas physique
107
108
109!***************************************************************
110
111! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
112! ------------------------------------------------------------------------
113! (Au tout premier appel de la subroutine durant le run.)
114
115      fichnom="diagspecIR.nc"
116
117      if (firstnom.eq.'1234567890') then ! .true. for the very first call
118      !  to this subroutine; now set 'firstnom'
119         firstnom = nom
120         ! just to be sure, check that firstnom is large enough to hold nom
121         if (len_trim(firstnom).lt.len_trim(nom)) then
122           write(*,*) "writediagspecIR: Error !!!"
123           write(*,*) "   firstnom string not long enough!!"
124           write(*,*) "   increase its size to at least ",len_trim(nom)
125           stop
126         endif
127
128#ifdef CPP_PARA
129          ! Gather cell_area() mesh area on physics grid
130          call Gather(cell_area,areafi_glo)
131#else
132         areafi_glo(:)=cell_area(:)
133#endif
134         ! Create the NetCDF file
135         if (is_master) then
136         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
137         ! Define the 'Time' dimension
138         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
139         ! Define the 'Time' variable
140#ifdef NC_DOUBLE
141         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
142#else
143         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
144#endif
145         ! Add a long_name attribute
146         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
147     .          4,"Time")
148         ! Add a units attribute
149         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
150     .          "days since 0000-00-0 00:00:00")
151         ! Switch out of NetCDF Define mode
152         ierr = NF_ENDDEF(nid)
153
154         ! Build area()
155         IF (klon_glo>1) THEN
156          do i=1,nbp_lon+1 ! poles
157           ! divide at the poles by nbp_lon
158           area(i,1)=areafi_glo(1)/nbp_lon
159           area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon
160          enddo
161          do j=2,nbp_lat-1
162           ig0= 1+(j-2)*nbp_lon
163           do i=1,nbp_lon
164              area(i,j)=areafi_glo(ig0+i)
165           enddo
166           ! handle redundant point in longitude
167           area(nbp_lon+1,j)=area(1,j)
168          enddo
169         ENDIF
170
171         ! write "header" of file (longitudes, latitudes, area, ...)
172         IF (klon_glo>1) THEN ! general 3D case
173           call iniwrite_specIR(nid,day_ini,area,nbp_lon+1,nbp_lat)
174         ELSE
175           call iniwrite_specIR(nid,day_ini,areafi_glo(1),1,1)
176         ENDIF
177         endif ! of if (is_master)
178
179         zitau = -1 ! initialize zitau
180      else
181         if (is_master) then
182           ! Open the NetCDF file
183           ierr = NF_OPEN(fichnom,NF_WRITE,nid)
184         endif
185      endif ! if (firstnom.eq.'1234567890')
186
187! Increment time index 'zitau' if it is the "firstcall" (at given time level)
188! to writediagfi
189!------------------------------------------------------------------------
190      if (nom.eq.firstnom) then
191          zitau = zitau + iphysiq
192      end if
193
194!--------------------------------------------------------
195! Write the variables to output file if it's time to do so
196!--------------------------------------------------------
197
198      if ( MOD(zitau+1,irythme) .eq.0.) then
199
200! Compute/write/extend 'Time' coordinate (date given in days)
201! (done every "first call" (at given time level) to writediagfi)
202! Note: date is incremented as 1 step ahead of physics time
203!       (like the 'histoire' outputs)
204!--------------------------------------------------------
205
206        if (nom.eq.firstnom) then
207
208        ! We have identified a "first call" (at given date)
209           ntime=ntime+1 ! increment # of stored time steps
210           ! compute corresponding date (in days and fractions thereof)
211           date= float (zitau +1)/float (day_step)
212
213           if (is_master) then
214             ! Get NetCDF ID of 'Time' variable
215             ierr= NF_INQ_VARID(nid,"Time",varid)
216
217             ! Write (append) the new date to the 'Time' array
218#ifdef NC_DOUBLE
219             ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
220#else
221             ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
222#endif
223             if (ierr.ne.NF_NOERR) then
224              write(*,*) "***** PUT_VAR matter in writediagspec_nc"
225              write(*,*) "***** with time"
226              write(*,*) 'ierr=', ierr   
227c             call abort
228             endif
229
230             write(6,*)'WRITEDIAGSPECIR: date= ', date
231           endif ! of if (is_master)
232        end if ! of if (nom.eq.firstnom)
233
234
235 
236!Case of a 3D variable
237!---------------------
238        if (dimpx.eq.3) then
239
240!         A. Recast (copy) variable from physics grid to dynamics grid
241#ifdef CPP_PARA
242  ! gather field on a "global" (without redundant longitude) array
243          call Gather(px,dx3_glop)
244!$OMP MASTER
245          if (is_mpi_root) then
246            call Grid1Dto2D_glo(dx3_glop,dx3_glo)
247            ! copy dx3_glo() to dx3(:) and add redundant longitude
248            dx3(1:nbp_lon,:,:)=dx3_glo(1:nbp_lon,:,:)
249            dx3(nbp_lon+1,:,:)=dx3(1,:,:)
250          endif
251!$OMP END MASTER
252!$OMP BARRIER
253#else
254          IF (klon_glo>1) THEN ! General case
255           DO l=1,L_NSPECTI
256             DO i=1,nbp_lon+1
257                dx3(i,1,l)=px(1,l)
258                dx3(i,nbp_lat,l)=px(ngrid,l)
259             ENDDO
260             DO j=2,nbp_lat-1
261                ig0= 1+(j-2)*nbp_lon
262                DO i=1,nbp_lon
263                   dx3(i,j,l)=px(ig0+i,l)
264                ENDDO
265                dx3(nbp_lon+1,j,l)=dx3(1,j,l)
266             ENDDO
267           ENDDO
268          ELSE ! 1D model case
269            dx3_1d(1,1:L_NSPECTI)=px(1,1:L_NSPECTI)
270          ENDIF
271#endif
272
273!         B. Write (append) the variable to the NetCDF file
274          if (is_master) then
275
276! name of the variable
277           ierr= NF_INQ_VARID(nid,nom,varid)
278           if (ierr /= NF_NOERR) then
279! corresponding dimensions
280              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
281              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
282              ierr= NF_INQ_DIMID(nid,"IR_Wavenumber",id(3))
283              ierr= NF_INQ_DIMID(nid,"Time",id(4))
284
285! Create the variable if it doesn't exist yet
286
287              write (*,*) "=========================="
288              write (*,*) "DIAGSPECIR: creating variable ",nom
289              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
290
291           endif
292
293           corner(1)=1
294           corner(2)=1
295           corner(3)=1
296           corner(4)=ntime
297
298           IF (klon_glo==1) THEN
299             edges(1)=1
300           ELSE
301             edges(1)=nbp_lon+1
302           ENDIF
303           edges(2)=nbp_lat
304           edges(3)=L_NSPECTI
305           edges(4)=1
306#ifdef NC_DOUBLE
307           IF (klon_glo>1) THEN ! General case
308             ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
309           ELSE
310             ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3_1d)
311           ENDIF
312#else
313           IF (klon_glo>1) THEN ! General case
314             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
315           ELSE
316             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3_1d)
317           ENDIF
318#endif
319
320           if (ierr.ne.NF_NOERR) then
321              write(*,*) "***** PUT_VAR problem in writediagspec"
322              write(*,*) "***** with ",nom
323              write(*,*) 'ierr=', ierr
324             call abort
325           endif
326
327          endif ! of if (is_master)
328
329        endif ! of if (dimpx.eq.3)
330
331      endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
332
333      ! Close the NetCDF file
334      if (is_master) then
335        ierr= NF_CLOSE(nid)
336      endif
337
338      end
Note: See TracBrowser for help on using the repository browser.