source: BOL/trunk/IPCC/ts2IPCC.F90 @ 551

Last change on this file since 551 was 551, checked in by lmdzadmin, 21 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.1 KB
RevLine 
[551]1
2PROGRAM ts2IPCC
3
4!
5! Filtre permettant de transformer les fichiers de serie temporelle a une
6! variable de l'IPSL en fichiers acceptables par le PCMDI/IPCC.
7!
8! Utilisation de la bibliothèque CMOR du PCMDI
9!
10! L. Fairhead 2004/08
11!
12! Ce programme est appelé avec un argument, le nom du fichier à traiter
13! Il nécessite aussi un fichier config.def contenant diverses informations
14! (voir plus bas) et l'accès à un tableau faisant la correspondance entre
15! les noms de variables du modèle et les noms imposés par l'IPCC
16! Pour l'instant on ne traite que les fichiers contenant la serie
17! temporelle d'une seule variable
18
19  use cmor_users_functions
20 
21  implicit none
22
23#include "netcdf.inc"
24
25  CHARACTER (len=256)        :: orig_file   ! nom du fichier à traiter
26  character (len=512)        :: line_read
27  CHARACTER (len=128)        :: inpath, contact, hist_gen,repert,instit
28  CHARACTER (len=128)        :: hist_var,expt_id,source,comment,refs
29  CHARACTER (len=20)         :: action
30  character (len=20)         :: first_part
31  character (len=1004)       :: second_part
32  CHARACTER (len=20), DIMENSION(100) :: ipsl_name, ipsl_units
33  CHARACTER (len=20), DIMENSION(100) :: ipcc_name, ipcc_table
34  CHARACTER (len=80)         :: varname, units
35
36  INTEGER                    :: orig_file_id, nvars, ndims
37  INTEGER                    :: verbos, exit_ctl, realis, indice,index_table
38  INTEGER                    :: iargc, iostat, ierr
39  INTEGER                    :: i
40  INTEGER                    :: latid, lonid, vertid, timeid
41  INTEGER                    :: varid, cmorvarid
42  INTEGER                    :: ilat, ilon, ivert, itime
43  INTEGER                    :: lunout      ! device de sortie
44  logical                    :: found = .false.
45
46  REAL, ALLOCATABLE, DIMENSION(:) :: lon, lat, vert, time
47  REAL, ALLOCATABLE, DIMENSION(:) :: lon_bounds, lat_bounds
48  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: donnees
49  DOUBLE PRECISION, DIMENSION(1)                :: rdate
50  real                            :: missing_value
51
52  external iargc
53
54!
55! quelques initialisations
56  lunout = 6
57  varname = 'xxxxxxxx'
58
59!
60! On vérifie que l'appel au programme a bien un argument:
61  CALL getarg(1, orig_file)
62  IF (iargc() == 0 .OR.  orig_file == '-h') then
63    WRITE(lunout,*)' '
64    WRITE(lunout,*)' Utilisation de ce programme: '
65    WRITE(lunout,*)' ./ts2IPCC nom_de_fichier [variable]'
66    WRITE(lunout,*)'        ou nom_de_fichier est le nom du fichier a traiter'
67    WRITE(lunout,*)'        et variable la variable a traiter [optionel]'
68    WRITE(lunout,*)' '
69    WRITE(lunout,*)' ./ts2IPCC -h sort ce message'
70    WRITE(lunout,*)' '
71    stop
72  ENDIF
73  if (iargc() == 2) then
74    CALL getarg(2, varname)
75  endif
76
77!
78! Lecture du fichier de configuration
79  OPEN (20, IOSTAT=iostat, file='config.def',form='formatted')
80  IF (iostat /= 0) then
81    WRITE(lunout,*)'Erreur ouverture du fichier config.def'
82    stop
83  endif
84
85  do while (iostat == 0)
86    READ(20,'(A)',iostat=iostat)line_read
87    line_read = trim(line_read)
88    IF (INDEX(line_read, '#') /= 1) THEN
89      first_part = trim(line_read(1:INDEX(line_read, '=')-1))
90      second_part = trim(line_read(INDEX(line_read, '=')+1:))
91      selectcase(first_part)
92        case('inpath')
93         inpath = trim(second_part)
94        case('file_action')
95         action = trim(second_part)
96        case('verbosity')
97          READ(second_part,'(i)') verbos
98        case('exit_control')
99          READ(second_part,'(i)') exit_ctl
100        case('repertoire')
101         repert = trim(second_part)
102        case('experiment_ID')
103         expt_id = trim(second_part)
104        case('institut')
105         instit = trim(second_part)
106        case('source')
107         source = trim(second_part)
108        case('realisation')
109          READ(second_part,'(i)') realis
110        case('hist_gen')
111         hist_gen = trim(second_part)
112        case('comment')
113         comment = trim(second_part)
114        case('refs')
115         refs = trim(second_part)
116        case('hist_var')
117         hist_var = trim(second_part)
118        case('contact')
119          contact = trim(second_part)
120      end select
121    endif
122  enddo
123  if (iostat > 0) then
124    WRITE(lunout,*)'Probleme de lecture du fichier config.def, iostat = ',iostat
125    stop
126  endif
127  close(20)
128
129!
130! Lecture du tableau de correspondance nom IPSL <=> nom IPCC
131  OPEN (20, IOSTAT=iostat, file='table.def',form='formatted')
132  IF (iostat /= 0) then
133    WRITE(lunout,*)'Erreur ouverture du fichier table.def'
134    stop
135  endif
136  indice = 0
137  do while (iostat == 0)
138    READ(20,'(A)',iostat=iostat)line_read
139    line_read = trim(line_read)
140    IF (INDEX(line_read, '#') /= 1) THEN
141      indice = indice + 1
142      ipsl_name(indice) = trim(line_read(1:INDEX(line_read, '|')-1))
143      line_read = trim(line_read(INDEX(line_read, '|')+1:))
144      ipsl_units(indice) = trim(line_read(1:INDEX(line_read, '|')-1))
145      line_read = trim(line_read(INDEX(line_read, '|')+1:))
146      ipcc_name(indice) = trim(line_read(1:INDEX(line_read, '|')-1))
147      ipcc_table(indice) = trim(line_read(INDEX(line_read, '|')+1:))
148    endif
149  enddo
150  indice = indice - 1
151  close(20)
152!  DO i = 1, indice
153!    WRITE(lunout,*)ipsl_name(i),ipsl_units(i),ipcc_name(i),ipcc_table(i)
154!  enddo
155
156!
157! Ouverture du fichier a traiter
158  ierr = nf_open(orig_file, NF_NOWRITE, orig_file_id)
159  IF (ierr /= NF_NOERR) then
160    WRITE(lunout,*)NF_STRERROR(ierr)
161    stop
162  endif
163!
164! trouver la variable a traiter, c'est une variable a 3 ou 4 dimensions
165  ierr = nf_inq_nvars(orig_file_id, nvars)
166  IF (ierr /= NF_NOERR) then
167    WRITE(lunout,*)NF_STRERROR(ierr)
168    stop
169  endif
170
171  i = 0
172  if (varname == 'xxxxxxxx') then
173    DO while (.not.found)
174      i = i + 1
175      if (i > nvars) then
176        WRITE(lunout,*)' pas de variable 3d ou 4d trouvee'
177        stop
178      endif
179      ierr = nf_inq_varname(orig_file_id, i, varname)
180      IF (ierr /= NF_NOERR) then
181        WRITE(lunout,*)NF_STRERROR(ierr)
182        stop
183      endif
184      ierr =  nf_inq_varndims(orig_file_id, i, ndims)
185      IF (ierr /= NF_NOERR) then
186        WRITE(lunout,*)NF_STRERROR(ierr)
187        stop
188      endif
189      if (ndims > 2) found = .true.
190    enddo
191  else
192    ierr = nf_inq_varid(orig_file_id, varname, varid)
193      IF (ierr /= NF_NOERR) then
194        WRITE(lunout,*)NF_STRERROR(ierr)
195        stop
196      endif
197  endif
198   
199!
200! recherche de la correspondance nom IPSL <=> nom IPCC
201  found = .false.
202  i = 0
203  do while (.not. found)
204    i = i + 1
205    if (i > indice) then
206      WRITE(lunout,*)'La variable ',trim(varname),' n''est pas dans le tableau de correspondance table.def'
207      stop
208    endif 
209    IF (varname == ipsl_name(i)) THEN
210      index_table = i
211      found = .true.
212    endif
213  enddo
214
215  WRITE(lunout,*)' found variable = ', trim(varname)
216  WRITE(lunout,*)' ipcc_name = ', trim(ipcc_name(index_table))
217
218
219!
220! Initialisation CMOR
221  ierr = cmor_setup(inpath=inpath, netcdf_file_action=action,set_verbosity=verbos,&
222 &                  exit_control=exit_ctl)
223  IF (ierr /= 0) then
224    WRITE(lunout,*)'Probleme dans cmor_setup, ierr = ', ierr
225  endif
226
227!
228! Initialisation dataset
229  ierr = cmor_dataset(outpath=repert,        &
230 &                    experiment_id=expt_id, &
231 &                    institution=instit,    &
232 &                    source=source,         &
233 &                    calendar='360_day',    &
234 &                    realization=realis,    &
235 &                    contact=contact,       &
236 &                    history=hist_gen,      &
237 &                    comment=comment,       &
238 &                    references=refs)
239  IF (ierr /= 0) then
240    WRITE(lunout,*)'Probleme dans cmor_dataset, ierr = ', ierr
241  endif
242
243!
244! Definition des axes
245
246! lecture de la latitude:
247  ierr = nf_inq_dimid(orig_file_id,'lat',latid)
248  ierr = nf_inq_dimlen(orig_file_id, latid, ilat)
249  allocate(lat(ilat))
250  ierr = nf_inq_varid(orig_file_id,'lat',latid)
251  ierr = nf_get_var_real(orig_file_id, latid, lat)
252  ierr = nf_get_att_text(orig_file_id, latid, 'units', units)
253  ALLOCATE(lat_bounds(ilat+1))
254  DO i = 2, ilat
255    lat_bounds(i) = lat(i-1) - (lat(i-1) - lat(i))/2
256  enddo
257  lat_bounds(1) = lat(1)
258  lat_bounds(ilat+1) = lat(ilat)
259! definition de la latitude
260  latid = cmor_axis(                         &
261     table=trim(ipcc_table(index_table)),    &
262     table_entry='latitude',                 &
263     units=units,                            & 
264     length=ilat,                            &
265     coord_vals=lat,                         &
266     cell_bounds=lat_bounds)       
267
268! lecture de la longitude:
269  units=' '
270  ierr = nf_inq_dimid(orig_file_id,'lon',lonid)
271  ierr = nf_inq_dimlen(orig_file_id, lonid, ilon)
272  allocate(lon(ilon))
273  ierr = nf_inq_varid(orig_file_id,'lon',lonid)
274  ierr = nf_get_var_real(orig_file_id, lonid, lon)
275  ierr = nf_get_att_text(orig_file_id, lonid, 'units', units)
276  ALLOCATE(lon_bounds(ilon+1))
277  DO i = 2, ilon
278    lon_bounds(i) = lon(i-1) - (lon(i-1) - lon(i))/2
279  enddo
280  lon_bounds(1) = lon(1) - (lon_bounds(3) -lon_bounds(2))/2.
281  lon_bounds(ilon+1) = lon(ilon) + (lon_bounds(ilon)-lon_bounds(ilon-1))/2.
282
283! definition de la longitude
284  lonid = cmor_axis(                         &
285     table=trim(ipcc_table(index_table)),    &
286     table_entry='longitude',                &
287     units=units,                            & 
288     length=ilon,                            &
289     coord_vals=lon,                         &
290     cell_bounds=lon_bounds)       
291
292! definition du temps
293  units=' '
294  ierr = nf_inq_dimid(orig_file_id,'time_counter',timeid)
295  ierr = nf_inq_dimlen(orig_file_id,timeid,itime)
296  allocate(time(itime))
297  ierr = nf_inq_varid(orig_file_id,'time_counter',timeid)
298  ierr = nf_get_var_real(orig_file_id, timeid, time)
299  ierr = nf_get_att_text(orig_file_id,timeid, 'units', units)
300  timeid = cmor_axis(                          &
301       table=trim(ipcc_table(index_table)),    &
302       table_entry='time',                     &
303       units=units,                            &
304       length=itime,                           &
305       interval='30 minutes')
306 
307!
308! Definition de la variable a ecrire
309  units=' '
310  ierr = nf_inq_varid(orig_file_id,TRIM(varname), varid)
311  ierr = nf_get_att_text(orig_file_id, varid, 'units', units)
312  ierr = nf_get_att_real(orig_file_id, varid, 'missing_value', missing_value)
313  cmorvarid = cmor_variable(                         &
314       table=trim(ipcc_table(index_table)),          &
315       table_entry=trim(ipcc_name(index_table)),     &
316       units=units,                                  &
317       axis_ids=(/ lonid, latid, timeid /),          &
318       missing_value=real(missing_value),            &
319       original_name=varname)
320!
321! Lecture de la variable
322  ALLOCATE (donnees(ilon, ilat, itime))
323  ierr = nf_get_var_real(orig_file_id, varid, donnees)
324!
325! Ecriture de la variable
326 
327  DO i = 1, itime
328    rdate(1) = dble(time(i))
329    ierr = cmor_write(                                     &
330             var_id        = cmorvarid,                    &
331             data          = real(donnees(:,:,i)),         &
332             ntimes_passed = 1,                            &
333             time_vals     = rdate)
334  enddo
335!
336! Fin CMOR
337  ierr = cmor_close()
338  IF (ierr /= 0) then
339    WRITE(lunout,*)'Probleme dans cmor_close, ierr = ', ierr
340  endif
341
342!
343! fermeture fichier originel
344  ierr = nf_close(orig_file_id)
345  IF (ierr /= NF_NOERR) then
346    WRITE(lunout,*)NF_STRERROR(ierr)
347    stop
348  endif
349 
350END
Note: See TracBrowser for help on using the repository browser.