19 #include "dimensions.h"
28 #include "description.h"
42 REAL tab_cntrl(length)
45 character*80 abort_message
49 INTEGER dims2(2), dims3(3), dims4(4)
51 INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
52 INTEGER idim_s, idim_sig
57 INTEGER yyears0,jjour0, mmois0
68 call ju2ymds(
zjulian, yyears0, mmois0, jjour0, hours)
79 tab_cntrl(1) =
REAL(
iim)
80 tab_cntrl(2) =
REAL(jjm)
81 tab_cntrl(3) =
REAL(llm)
120 IF( ysinus ) tab_cntrl(27) = 1.
123 tab_cntrl(30) =
REAL(iday_end)
132 ierr = nf_create(fichnom, nf_clobber, nid)
133 IF (ierr.NE.nf_noerr)
THEN
134 WRITE(6,*)
" Pb d ouverture du fichier "//fichnom
135 WRITE(6,*)
' ierr = ', ierr
141 ierr = nf_put_att_text(nid, nf_global,
"title", 27,
142 .
"Fichier demmarage dynamique")
146 ierr = nf_def_dim(nid,
"index", length, idim_index)
147 ierr = nf_def_dim(nid,
"rlonu", iip1, idim_rlonu)
148 ierr = nf_def_dim(nid,
"rlatu",
jjp1, idim_rlatu)
149 ierr = nf_def_dim(nid,
"rlonv", iip1, idim_rlonv)
150 ierr = nf_def_dim(nid,
"rlatv", jjm, idim_rlatv)
151 ierr = nf_def_dim(nid,
"sigs", llm, idim_s)
152 ierr = nf_def_dim(nid,
"sig",
llmp1, idim_sig)
153 ierr = nf_def_dim(nid,
"temps", nf_unlimited, idim_tim)
155 ierr = nf_enddef(nid)
162 ierr = nf_def_var(nid,
"controle",nf_double,1,idim_index,nvarid)
164 ierr = nf_def_var(nid,
"controle",nf_float,1,idim_index,nvarid)
167 ierr = nf_put_att_text(nid, nvarid,
"title", 22,
168 .
"Parametres de controle")
169 ierr = nf_enddef(nid)
170 call nf95_put_var(nid,nvarid,tab_cntrl)
175 ierr = nf_def_var(nid,
"rlonu",nf_double,1,idim_rlonu,nvarid)
177 ierr = nf_def_var(nid,
"rlonu",nf_float,1,idim_rlonu,nvarid)
180 ierr = nf_put_att_text(nid, nvarid,
"title", 23,
181 .
"Longitudes des points U")
182 ierr = nf_enddef(nid)
183 call nf95_put_var(nid,nvarid,
rlonu)
188 ierr = nf_def_var(nid,
"rlatu",nf_double,1,idim_rlatu,nvarid)
190 ierr = nf_def_var(nid,
"rlatu",nf_float,1,idim_rlatu,nvarid)
193 ierr = nf_put_att_text(nid, nvarid,
"title", 22,
194 .
"Latitudes des points U")
195 ierr = nf_enddef(nid)
196 call nf95_put_var(nid,nvarid,
rlatu)
201 ierr = nf_def_var(nid,
"rlonv",nf_double,1,idim_rlonv,nvarid)
203 ierr = nf_def_var(nid,
"rlonv",nf_float,1,idim_rlonv,nvarid)
206 ierr = nf_put_att_text(nid, nvarid,
"title", 23,
207 .
"Longitudes des points V")
208 ierr = nf_enddef(nid)
209 call nf95_put_var(nid,nvarid,
rlonv)
214 ierr = nf_def_var(nid,
"rlatv",nf_double,1,idim_rlatv,nvarid)
216 ierr = nf_def_var(nid,
"rlatv",nf_float,1,idim_rlatv,nvarid)
219 ierr = nf_put_att_text(nid, nvarid,
"title", 22,
220 .
"Latitudes des points V")
221 ierr = nf_enddef(nid)
222 call nf95_put_var(nid,nvarid,
rlatv)
227 ierr = nf_def_var(nid,
"nivsigs",nf_double,1,idim_s,nvarid)
229 ierr = nf_def_var(nid,
"nivsigs",nf_float,1,idim_s,nvarid)
232 ierr = nf_put_att_text(nid, nvarid,
"title", 28,
233 .
"Numero naturel des couches s")
234 ierr = nf_enddef(nid)
235 call nf95_put_var(nid,nvarid,
nivsigs)
240 ierr = nf_def_var(nid,
"nivsig",nf_double,1,idim_sig,nvarid)
242 ierr = nf_def_var(nid,
"nivsig",nf_float,1,idim_sig,nvarid)
245 ierr = nf_put_att_text(nid, nvarid,
"title", 32,
246 .
"Numero naturel des couches sigma")
247 ierr = nf_enddef(nid)
248 call nf95_put_var(nid,nvarid,
nivsig)
253 ierr = nf_def_var(nid,
"ap",nf_double,1,idim_sig,nvarid)
255 ierr = nf_def_var(nid,
"ap",nf_float,1,idim_sig,nvarid)
258 ierr = nf_put_att_text(nid, nvarid,
"title", 26,
259 .
"Coefficient A pour hybride")
260 ierr = nf_enddef(nid)
261 call nf95_put_var(nid,nvarid,
ap)
266 ierr = nf_def_var(nid,
"bp",nf_double,1,idim_sig,nvarid)
268 ierr = nf_def_var(nid,
"bp",nf_float,1,idim_sig,nvarid)
271 ierr = nf_put_att_text(nid, nvarid,
"title", 26,
272 .
"Coefficient B pour hybride")
273 ierr = nf_enddef(nid)
274 call nf95_put_var(nid,nvarid,
bp)
279 ierr = nf_def_var(nid,
"presnivs",nf_double,1,idim_s,nvarid)
281 ierr = nf_def_var(nid,
"presnivs",nf_float,1,idim_s,nvarid)
284 ierr = nf_enddef(nid)
285 call nf95_put_var(nid,nvarid,
presnivs)
290 dims2(1) = idim_rlonu
291 dims2(2) = idim_rlatu
294 ierr = nf_def_var(nid,
"cu",nf_double,2,dims2,nvarid)
296 ierr = nf_def_var(nid,
"cu",nf_float,2,dims2,nvarid)
299 ierr = nf_put_att_text(nid, nvarid,
"title", 29,
300 .
"Coefficient de passage pour U")
301 ierr = nf_enddef(nid)
302 call nf95_put_var(nid,nvarid,
cu)
305 dims2(1) = idim_rlonv
306 dims2(2) = idim_rlatv
309 ierr = nf_def_var(nid,
"cv",nf_double,2,dims2,nvarid)
311 ierr = nf_def_var(nid,
"cv",nf_float,2,dims2,nvarid)
314 ierr = nf_put_att_text(nid, nvarid,
"title", 29,
315 .
"Coefficient de passage pour V")
316 ierr = nf_enddef(nid)
317 call nf95_put_var(nid,nvarid,
cv)
322 dims2(1) = idim_rlonv
323 dims2(2) = idim_rlatu
326 ierr = nf_def_var(nid,
"aire",nf_double,2,dims2,nvarid)
328 ierr = nf_def_var(nid,
"aire",nf_float,2,dims2,nvarid)
331 ierr = nf_put_att_text(nid, nvarid,
"title", 22,
332 .
"Aires de chaque maille")
333 ierr = nf_enddef(nid)
334 call nf95_put_var(nid,nvarid,
aire)
339 dims2(1) = idim_rlonv
340 dims2(2) = idim_rlatu
343 ierr = nf_def_var(nid,
"phisinit",nf_double,2,dims2,nvarid)
345 ierr = nf_def_var(nid,
"phisinit",nf_float,2,dims2,nvarid)
348 ierr = nf_put_att_text(nid, nvarid,
"title", 19,
349 .
"Geopotentiel au sol")
350 ierr = nf_enddef(nid)
351 call nf95_put_var(nid,nvarid,
phis)
359 ierr = nf_def_var(nid,
"temps",nf_double,1,idim_tim,nvarid)
361 ierr = nf_def_var(nid,
"temps",nf_float,1,idim_tim,nvarid)
364 ierr = nf_put_att_text(nid, nvarid,
"title", 19,
365 .
"Temps de simulation")
366 write(unites,200)yyears0,mmois0,jjour0
367 200
format(
'days since ',i4,
'-',i2.2,
'-',i2.2,
' 00:00:00')
368 ierr = nf_put_att_text(nid, nvarid,
"units", 30,
372 dims4(1) = idim_rlonu
373 dims4(2) = idim_rlatu
378 ierr = nf_def_var(nid,
"ucov",nf_double,4,dims4,nvarid)
380 ierr = nf_def_var(nid,
"ucov",nf_float,4,dims4,nvarid)
383 ierr = nf_put_att_text(nid, nvarid,
"title", 9,
386 dims4(1) = idim_rlonv
387 dims4(2) = idim_rlatv
392 ierr = nf_def_var(nid,
"vcov",nf_double,4,dims4,nvarid)
394 ierr = nf_def_var(nid,
"vcov",nf_float,4,dims4,nvarid)
397 ierr = nf_put_att_text(nid, nvarid,
"title", 9,
400 dims4(1) = idim_rlonv
401 dims4(2) = idim_rlatu
406 ierr = nf_def_var(nid,
"teta",nf_double,4,dims4,nvarid)
408 ierr = nf_def_var(nid,
"teta",nf_float,4,dims4,nvarid)
411 ierr = nf_put_att_text(nid, nvarid,
"title", 11,
414 dims4(1) = idim_rlonv
415 dims4(2) = idim_rlatu
422 ierr = nf_def_var(nid,tname(iq),nf_double,4,dims4,nvarid)
424 ierr = nf_def_var(nid,tname(iq),nf_float,4,dims4,nvarid)
427 ierr = nf_put_att_text(nid, nvarid,
"title", 12,ttext(iq))
430 dims4(1) = idim_rlonv
431 dims4(2) = idim_rlatu
436 ierr = nf_def_var(nid,
"masse",nf_double,4,dims4,nvarid)
438 ierr = nf_def_var(nid,
"masse",nf_float,4,dims4,nvarid)
441 ierr = nf_put_att_text(nid, nvarid,
"title", 12,
444 dims3(1) = idim_rlonv
445 dims3(2) = idim_rlatu
449 ierr = nf_def_var(nid,
"ps",nf_double,3,dims3,nvarid)
451 ierr = nf_def_var(nid,
"ps",nf_float,3,dims3,nvarid)
454 ierr = nf_put_att_text(nid, nvarid,
"title", 15,
457 ierr = nf_enddef(nid)
460 print*,
'iim,jjm,llm,iday_end',
iim,jjm,llm,iday_end
461 print*,
'rad,omeg,g,cpp,kappa',
468 . vcov,ucov,
teta,
q,masse,ps)
472 use netcdf
, only: NF90_get_VAR
479 #include "dimensions.h"
481 #include "description.h"
482 #include "netcdf.inc"
489 REAL vcov(iip1,jjm,llm),ucov(iip1,
jjp1,llm)
491 REAL ps(iip1,
jjp1),masse(iip1,
jjp1,llm)
492 REAL q(iip1,
jjp1, llm, nqtot)
493 CHARACTER*(*) fichnom
496 INTEGER nid, nvarid, nid_trac, nvarid_trac
498 INTEGER ierr, ierr_file
502 REAL tab_cntrl(length)
504 character*80 abort_message
523 if (mpi_rank==0)
then
525 modname =
'dynredem1'
526 ierr = nf_open(fichnom, nf_write, nid)
527 IF (ierr .NE. nf_noerr)
THEN
528 print*,
"Pb. d ouverture "//fichnom
535 ierr = nf_inq_varid(nid,
"temps", nvarid)
536 IF (ierr .NE. nf_noerr)
THEN
537 print *, nf_strerror(ierr)
538 abort_message=
'Variable temps n est pas definie'
539 CALL
abort_gcm(modname,abort_message,ierr)
541 call nf95_put_var(nid,nvarid,
time,start=(/nb/))
542 print*,
"Enregistrement pour ", nb,
time
547 ierr = nf_inq_varid(nid,
"controle", nvarid)
548 IF (ierr .NE. nf_noerr)
THEN
549 abort_message=
"dynredem1: Le champ <controle> est absent"
551 CALL
abort_gcm(modname,abort_message,ierr)
553 ierr = nf90_get_var(nid, nvarid, tab_cntrl)
555 call nf95_put_var(nid,nvarid,tab_cntrl)
559 ierr = nf_inq_varid(nid,
"ucov", nvarid)
560 IF (ierr .NE. nf_noerr)
THEN
561 print*,
"Variable ucov n est pas definie"
564 call nf95_put_var(nid,nvarid,ucov)
566 ierr = nf_inq_varid(nid,
"vcov", nvarid)
567 IF (ierr .NE. nf_noerr)
THEN
568 print*,
"Variable vcov n est pas definie"
571 call nf95_put_var(nid,nvarid,vcov)
573 ierr = nf_inq_varid(nid,
"teta", nvarid)
574 IF (ierr .NE. nf_noerr)
THEN
575 print*,
"Variable teta n est pas definie"
578 call nf95_put_var(nid,nvarid,
teta)
580 IF (type_trac ==
'inca')
THEN
582 inquire(file=
"start_trac.nc", exist=exist_file)
583 print *,
"EXIST", exist_file
585 ierr_file = nf_open(
"start_trac.nc", nf_nowrite,nid_trac)
586 IF (ierr_file .NE.nf_noerr)
THEN
587 write(6,*)
' Pb d''ouverture du fichier start_trac.nc'
588 write(6,*)
' ierr = ', ierr_file
597 IF (type_trac /=
'inca')
THEN
598 ierr = nf_inq_varid(nid, tname(iq), nvarid)
599 IF (ierr .NE. nf_noerr)
THEN
600 print*,
"Variable tname(iq) n est pas definie"
603 call nf95_put_var(nid,nvarid,
q(:,:,:,iq))
606 IF (ierr_file .ne. 2)
THEN
607 ierr = nf_inq_varid(nid_trac, tname(iq), nvarid_trac)
608 IF (ierr .NE. nf_noerr)
THEN
609 print*, tname(iq),
"est absent de start_trac.nc"
610 ierr = nf_inq_varid(nid, tname(iq), nvarid)
611 IF (ierr .NE. nf_noerr)
THEN
612 print*,
"Variable ", tname(iq),
" n est pas definie"
615 call nf95_put_var(nid,nvarid,
q(:,:,:,iq))
618 print*, tname(iq),
"est present dans start_trac.nc"
619 ierr = nf90_get_var(nid_trac, nvarid_trac, trac_tmp)
620 IF (ierr .NE. nf_noerr)
THEN
621 print*,
"Lecture echouee pour", tname(iq)
624 ierr = nf_inq_varid(nid, tname(iq), nvarid)
625 IF (ierr .NE. nf_noerr)
THEN
626 print*,
"Variable ", tname(iq),
" n est pas definie"
629 call nf95_put_var(nid, nvarid, trac_tmp)
635 ierr = nf_inq_varid(nid, tname(iq), nvarid)
636 IF (ierr .NE. nf_noerr)
THEN
637 print*,
"Variable tname(iq) n est pas definie"
640 call nf95_put_var(nid,nvarid,
q(:,:,:,iq))
649 ierr = nf_inq_varid(nid,
"masse", nvarid)
650 IF (ierr .NE. nf_noerr)
THEN
651 print*,
"Variable masse n est pas definie"
654 call nf95_put_var(nid,nvarid,masse)
656 ierr = nf_inq_varid(nid,
"ps", nvarid)
657 IF (ierr .NE. nf_noerr)
THEN
658 print*,
"Variable ps n est pas definie"
661 call nf95_put_var(nid,nvarid,ps)