source: LMDZ.3.3/branches/rel-LF/libf/bibio/writephys.F90 @ 558

Last change on this file since 558 was 353, checked in by lmdzadmin, 23 years ago

2 changements pour les fichiers histoire:

  • utilisation de l'entree "rectilineaire" de IOIPSL pour ne plus avoir

a

lancer ncregular a chaque fois

  • le calendrier des fichiers histoire est maintenant base sur la date d'initialisation de la simulation plutot que sur la date de depart du

job

en cours

LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.4 KB
Line 
1!
2! $Header$
3!
4  MODULE writephys
5
6!
7! Wrapper d'IOIPSL pour l'ecriture des sorties de la physique. Un seul appel
8! par variable devrait (?) suffire pour l'initialisation et l'ecriture
9!
10! LF, LMD, 07/2001
11!
12! 2 routines principales:
13!   writephy_ini pour l'initialisation des fichiers (appel histbeg, histvert)
14!   writephy pour l'ecriture des champs (appel histdef, histwrite)
15! dans le futur:
16!   writephy_def pour definir des profils de variables
17!
18  USE IOIPSL
19
20  IMPLICIT none
21
22  PRIVATE
23  PUBLIC :: writephy_ini, writephy, writephy_def, writephy_sync
24
25!
26! variables locales
27!
28! nombre de fichiers maximum a ouvrir
29  integer, parameter :: nb_files_max = 20
30! nombre de variables maximum par fichier
31  integer, parameter :: nb_var_max = 500
32! nombre maximum de "profils" de variables
33  integer, parameter :: nb_prof_max = 10
34! structure d'infos sur les fichiers
35  type fichier
36     character*30        :: file_name
37     integer             :: nitau
38     integer             :: file_id
39     integer             :: isize, jsize, lsize, phy_lon
40     integer             :: nhori, nvert
41     logical             :: define
42  end type fichier
43  type (fichier), dimension(nb_files_max), save :: hist_files
44! structure de profils de variables
45  type profils
46     real               :: freq_op
47     real               :: freq_wri
48     character*6        :: var_op
49     integer            :: zsize
50     integer            :: reg_size
51     integer,dimension(:), pointer :: reg_index
52  end type profils
53  type (profils), dimension(nb_prof_max, nb_files_max), save :: var_profs
54
55! liste des variables par fichier
56  character (len=10), save, dimension(nb_var_max,nb_files_max) :: list_var='undefined'
57! nombre de variables par fichier
58  integer, save, dimension(nb_files_max) :: nb_var = 0
59! nombre de bits à sauvegarder dans les fichiers
60  integer, save :: nbits = 32
61!
62! Quelques initialisations
63!
64
65  CONTAINS
66
67!
68!###########################################################################
69!
70  SUBROUTINE writephy_ini(nid_file, nom_fichier, klon, iim, jjm, llm, &
71 &                        rlon, rlat, zlev, &
72 &                        date0, dtime)
73!
74! Initialisation des fichiers histoire de la physique
75! Appels a histbeg, histvert
76! Remplissage des structures d'informations sur les fichiers
77!
78! Entree:
79!   nid_file          numero/index du fichier a initialiser
80!   nom_fichier       nom du fichier
81!   klon              taille des champs physiques
82!   iim, jjm, llm     taille en i,j,k     
83!   rlon, rlat, zlev  coordonnees en x, y, z
84!   date0             date debut
85!   dtime             pas de temps elementaire de la physique
86!   
87! Declaration des parametres d'entree
88  integer :: nid_file
89  character*(*) :: nom_fichier
90  integer :: iim, jjm, llm, klon
91  real, dimension(klon) :: rlon
92  real, dimension(klon) :: rlat
93  real, dimension(llm) :: zlev
94  real                 :: date0, dtime
95  integer              :: itau_deb
96!
97! Variables locales
98!
99  integer :: i, file_id, nvert, nhori
100  real, dimension(iim, jjm) :: temp_lon, temp_lat
101  logical, save             :: first_call = .true.
102  integer,parameter         :: nulou = 6
103!
104! Quelques initialisations
105!
106  if (first_call) then
107    hist_files(:)%define = .true.
108    var_profs(:,:)%freq_wri = -999
109    hist_files(:)%nitau = 1
110    first_call= .false.
111  endif
112!
113! Mise des coordonnees sur une grille 2D
114!
115  call gr_fi_ecrit(1,klon,iim,jjm,rlon,temp_lon)
116  do i = 1, iim
117    temp_lon(i,1) = rlon(i+1)
118    temp_lon(i,jjm) = rlon(i+1)
119  enddo
120  call gr_fi_ecrit(1,klon,iim,jjm,rlat,temp_lat)
121!
122! Initialisation du fichier
123!
124  call histbeg(nom_fichier, iim, temp_lon(:,1), jjm, temp_lat(1,:), &
125     &                 1, iim, 1, jjm, itau_deb, date0, dtime, &
126     &                 nhori, file_id)
127  call histvert(file_id, "presnivs", "Vertical levels", "mb", &
128     &                 llm, zlev, nvert)
129
130!
131! Remplissage des infos
132!
133  hist_files(nid_file)%file_name = nom_fichier
134  hist_files(nid_file)%file_id = file_id
135  hist_files(nid_file)%isize = iim
136  hist_files(nid_file)%jsize = jjm
137  hist_files(nid_file)%lsize = llm
138  hist_files(nid_file)%phy_lon = klon
139  hist_files(nid_file)%nhori = nhori
140  hist_files(nid_file)%nvert = nvert
141
142  write(nulou,*)'####################################'
143  write(nulou,*)' Definition du fichier no ',nid_file
144  write(nulou,*)'    nom du fichier     ',hist_files(nid_file)%file_name
145  write(nulou,*)'    identifiant        ',hist_files(nid_file)%file_id
146  write(nulou,*)'    taille en i        ',hist_files(nid_file)%isize
147  write(nulou,*)'    taille en j        ',hist_files(nid_file)%jsize
148  write(nulou,*)'    taille en l        ',hist_files(nid_file)%lsize
149
150!
151  END SUBROUTINE writephy_ini
152!
153!###########################################################################
154!
155  SUBROUTINE writephy_def(profil_n, nid_file,               &
156 &                        var_op, freq_op, freq_wri, zsize, &
157 &                        reg_size, reg_index)
158!
159! Definition de profil type de sortie de variables
160!               (moyenne, instantanee, indexee ...)
161!
162! Parametres d'entree
163!   profil_n      numero du profil-type
164!   nid_file      numero de fichier
165!   var_op        operation a effectuer sur la variable
166!   freq_op       frequence de l'operation
167!   freq_wri      frequence d'ecriture
168!   zsize         variable 2D/3D
169!   reg_size      taille de la region a sortir
170!   reg_index     indices de la region a sortir
171!
172  integer                         :: profil_n
173  integer                         :: nid_file
174  character*(*)             :: var_op
175  real                            :: freq_op, freq_wri
176  integer                         :: zsize
177  integer, optional               :: reg_size
178  integer, dimension(*), optional :: reg_index
179!
180! variables locales
181!
182  character (len = 20) :: modname = 'writephy_def'
183  character (len = 80) :: message
184  integer              :: dummy_size
185  integer              :: error
186  integer,parameter    :: nulou = 6
187!
188! Differentes verif
189!
190  if (profil_n > nb_prof_max) then
191    message = 'numero de profil de variable > nbre maximal de profil'
192    call abort_gcm(modname, message, 1)
193  endif
194  if (var_profs(profil_n, nid_file)%freq_wri /= -999) then
195    message = 'numero de profil deja attribue'
196    call abort_gcm(modname, message, 1)
197  endif       
198!
199! Remplissage structure infos
200!
201  var_profs(profil_n, nid_file)%var_op = var_op
202  var_profs(profil_n, nid_file)%freq_op = freq_op
203  var_profs(profil_n, nid_file)%freq_wri = freq_wri
204  var_profs(profil_n, nid_file)%zsize = zsize
205!
206! test pour region
207!
208  if (present (reg_size)) then
209    if ( .not. present (reg_index)) then
210      message = 'reg_size defini mais pas de region definie'
211      call abort_gcm(modname, message, 1)
212    endif
213    allocate(var_profs(profil_n, nid_file)%reg_index(reg_size), stat = error)
214    if (error /= 0) then
215      message='Pb allocation reg_index'
216      call abort_gcm(modname,message,1)
217    endif
218    var_profs(profil_n, nid_file)%reg_size = reg_size
219    var_profs(profil_n, nid_file)%reg_index = reg_index(1:reg_size)
220  else
221    dummy_size = 1
222    allocate(var_profs(profil_n, nid_file)%reg_index(dummy_size), stat = error)
223    if (error /= 0) then
224      message='Pb allocation reg_index'
225      call abort_gcm(modname,message,1)
226    endif
227    var_profs(profil_n, nid_file)%reg_size = dummy_size
228    var_profs(profil_n, nid_file)%reg_index = 0
229  endif
230
231  write(nulou,*)' Definition du profil de variable numero ', profil_n
232  write(nulou,*)'                              du fichier ', nid_file
233  write(nulou,*)'     operation               ', &
234 &                    var_profs(profil_n, nid_file)%var_op
235  write(nulou,*)'     frequence d''operation  ', &
236 &                    var_profs(profil_n, nid_file)%freq_op
237  write(nulou,*)'     frequence d''ecriture   ', &
238 &                    var_profs(profil_n, nid_file)%freq_wri
239  write(nulou,*)'     2D/3D                   ', &
240 &                    var_profs(profil_n, nid_file)%zsize
241  write(nulou,*)'     taille de la region     ', &
242 &                    var_profs(profil_n, nid_file)%reg_size
243
244  END SUBROUTINE writephy_def
245!
246!###########################################################################
247!
248! A faire: rendre var_title et var_units optionels par lecture d'un tableau
249!
250!
251  SUBROUTINE writephy(file, iprof, var_name, data, var_title, var_units)
252!
253! Definition et ecriture des variables
254!
255! file             numero du fichier dans lequel ecrire
256! iprof            profil de la variable a ecrire
257! var_name         nom de la variable a ecrire
258! data             les donnees effectives a ecrire 
259! var_title        "vrai" nom de la variable, optionel, si non present
260!                  interrogation d'un tableau
261! var_units        unite de la variable, optionel, si non present
262!                  interrogation d'un tableau
263
264  integer              :: file, iprof
265  character*(*)        :: var_name
266  real, dimension(*)   :: data
267  character*(*)        :: var_title
268  character*(*)        :: var_units
269!
270! variables locales
271!
272  integer              :: i, error
273  character (len=6)    :: var_op
274  real                 :: freq_op, freq_wri
275  integer              :: file_id, isize, jsize, lsize, phy_lon, zsize
276  integer              :: nhori, nvert, klon
277  integer              :: itau
278  real, dimension(:,:,:), allocatable :: temp_data
279  character (len = 20) :: modname = 'writephy'
280  character (len = 80) :: message
281!
282! Test: toujours en mode definition des variables?
283!
284  if (var_name == list_var(1, file)) then
285    hist_files(file)%nitau = hist_files(file)%nitau + 1
286  endif
287  if (hist_files(file)%define) then
288    if (var_name == list_var(1, file)) then
289!     on a fait le tour des variables
290      hist_files(file)%define = .false.
291      call histend(hist_files(file)%file_id)
292    else
293!
294! pour que l'appel a histdef soit plus lisible, on range tout dans des tampons
295!
296      file_id = hist_files(file)%file_id
297      isize = hist_files(file)%isize
298      jsize = hist_files(file)%jsize   
299      nhori = hist_files(file)%nhori
300      klon = hist_files(file)%phy_lon
301      var_op = var_profs(iprof, file)%var_op
302      freq_op = var_profs(iprof, file)%freq_op
303      freq_wri = var_profs(iprof, file)%freq_wri
304      if (var_profs(iprof, file)%zsize == 0) then
305        lsize = 1
306        nvert = -99
307      else
308        lsize = hist_files(file)%lsize
309        nvert = hist_files(file)%nvert
310      endif
311!      if (var_name == 'phis') then
312!        write(*,*)'Define: ',var_name
313!        write(*,*)file_id, var_name, var_title, var_units,  &
314! &                isize, jsize, nhori, lsize, 1, lsize, nvert, nbits,  &
315! &                var_op, freq_op, freq_wri
316!      endif
317      call histdef(file_id, var_name, var_title, var_units,  &
318 &                isize, jsize, nhori, lsize, 1, lsize, nvert, nbits,  &
319 &                var_op, freq_op, freq_wri)
320      nb_var(file) = nb_var(file) + 1
321      list_var(nb_var(file), file) = var_name
322    endif
323  endif
324!
325! On ecrit la variable
326!
327! Preparation
328!
329  file_id = hist_files(file)%file_id
330  isize = hist_files(file)%isize
331  jsize = hist_files(file)%jsize   
332  nhori = hist_files(file)%nhori
333  var_op = var_profs(iprof, file)%var_op
334  freq_op = var_profs(iprof, file)%freq_op
335  freq_wri = var_profs(iprof, file)%freq_wri
336  itau = hist_files(file)%nitau
337
338  if (var_profs(iprof, file)%zsize == 0) then
339    lsize = 1
340  else
341    lsize = hist_files(file)%lsize
342  endif
343  allocate(temp_data(isize,jsize,lsize), stat = error)
344  if (error /= 0) then
345    message='Pb allocation temp_data'
346    call abort_gcm(modname, message, 1)
347  endif
348!
349! Ecriture
350!
351  call gr_fi_ecrit(lsize, klon, isize, jsize, data, temp_data)
352  if (var_name == 'tsol') then
353    write(*,*)'writephys itau = ', file_id, var_name, itau
354!    write(*,*)file_id, var_name,itau,temp_data, &
355! &               var_profs(iprof, file)%reg_size, &
356! &               var_profs(iprof, file)%reg_index
357  endif
358  call histwrite(file_id, var_name,itau,temp_data, &
359 &               var_profs(iprof, file)%reg_size, &
360 &               var_profs(iprof, file)%reg_index)
361
362  deallocate(temp_data)
363 
364  return
365!
366  END SUBROUTINE writephy
367!
368!###########################################################################
369!
370  SUBROUTINE writephy_sync(nid_file)
371!
372! Flush des donnees dans le fichier et eventuellement fermeture du
373! mode 'define'
374!
375! Entree:
376!   nid_file    numero du fichier a traiter
377!
378  integer     :: nid_file
379!
380  if (hist_files(nid_file)%define) then
381    call histend(hist_files(nid_file)%file_id)
382    hist_files(nid_file)%define = .false.
383  endif
384
385  call histsync(hist_files(nid_file)%file_id)
386 
387return
388
389  END SUBROUTINE writephy_sync
390!
391!###########################################################################
392!
393  END MODULE writephys
Note: See TracBrowser for help on using the repository browser.