SUBROUTINE iotd_ecrit(nom,llm,titre,unite,px) !======================================================================= ! Auteur: F. Hourdin ! ------- ! Objet: ! ------ ! Light interface for netcdf outputs. can be used outside LMDZ !======================================================================= !----------------------------------------------------------------------- ! ---------- ! nom : nom de la variable a sortir (chaine de caracteres) ! llm : nombre de couches ! titre: titre de la variable (chaine de caracteres) ! unite : unite de la variable (chaine de caracteres) ! px : variable a sortir !================================================================= USE netcdf, ONLY: nf90_put_var,nf90_inq_varid,nf90_enddef,nf90_redef,nf90_sync,nf90_noerr,& nf90_float,nf90_def_var implicit none ! Commons INCLUDE "iotd.h" ! Arguments on input: integer llm character (len=*) :: nom,titre,unite integer imjmax parameter (imjmax=100000) real px(imjmax*llm) ! Local variables: real(kind=4) date real(kind=4) zx(imjmax*llm) integer ierr,ndim,dim_cc(4) integer iq integer i,j,l integer zitau character firstnom*20 SAVE firstnom SAVE zitau SAVE date data firstnom /'1234567890'/ data zitau /0/ ! Ajouts integer, save :: ntime=0 integer :: idim,varid character (len =50):: fichnom integer, dimension(4) :: id integer, dimension(4) :: edges,corner if (n_names_iotd_def>0 .and..not.any(names_iotd_def==nom)) return !*************************************************************** ! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file ! ------------------------------------------------------------------------ ! (Au tout premier appel de la SUBROUTINE durant le run.) !-------------------------------------------------------- ! Write the variables to output file if it's time to do so !-------------------------------------------------------- ! Compute/write/extend 'time' coordinate (date given in days) ! (done every "first call" (at given time level) to writediagfi) ! Note: date is incremented as 1 step ahead of physics time !-------------------------------------------------------- zx(1:imax*jmax*llm)=px(1:imax*jmax*llm) if (firstnom =='1234567890') then firstnom=nom endif !PRINT*,'nom ',nom,firstnom !! Quand on tombe sur la premiere variable on ajoute un pas de temps if (nom==firstnom) then ! We have identified a "first call" (at given date) ntime=ntime+1 ! increment # of stored time steps !! PRINT*,'ntime ',ntime date=iotd_t0+ntime*iotd_ts !PRINT*,'iotd_ecrit ',iotd_ts,ntime, date ! date= float (zitau +1)/float (day_step) ! compute corresponding date (in days and fractions thereof) ! Get NetCDF ID of 'time' variable ierr=nf90_sync(nid) ierr= nf90_inq_varid(nid,"time",varid) ! Write (append) the new date to the 'time' array ierr= nf90_put_var(nid,varid,date,[ntime]) ! PRINT*,'date ',date,ierr,nid ! PRINT*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date if (ierr/=nf90_noerr) then write(*,*) "***** PUT_VAR matter in writediagfi_nc" write(*,*) "***** with time" write(*,*) 'ierr=', ierr endif ! write(6,*)'WRITEDIAGFI: date= ', date end if ! of if (nom.eq.firstnom) !Case of a 3D variable !--------------------- if (llm==lmax) then ndim=4 corner(1)=1 corner(2)=1 corner(3)=1 corner(4)=ntime edges(1)=imax edges(2)=jmax edges(3)=llm edges(4)=1 dim_cc=dim_coord !Case of a 2D variable !--------------------- else if (llm==1) then ndim=3 corner(1)=1 corner(2)=1 corner(3)=ntime corner(4)=1 edges(1)=imax edges(2)=jmax edges(3)=1 edges(4)=1 dim_cc(1:2)=dim_coord(1:2) dim_cc(3)=dim_coord(4) endif ! of if llm=1 ou llm ! AU premier pas de temps, on crée les variables !----------------------------------------------- if (ntime==1) then ierr = nf90_redef (nid) ierr = nf90_def_var(nid,nom,nf90_float,dim_cc,varid) !PRINT*,'DEF ',nom,nid,varid ierr = nf90_enddef(nid) else ierr= nf90_inq_varid(nid,nom,varid) !PRINT*,'INQ ',nom,nid,varid ! Commandes pour recuperer automatiquement les coordonnees ! ierr= nf90_inq_dimid(nid,"longitude",id(1)) endif ierr= nf90_put_var(nid,varid,zx,corner,edges) if (ierr/=nf90_noerr) then write(*,*) "***** PUT_VAR problem in writediagfi" write(*,*) "***** with ",nom write(*,*) 'ierr=', ierr endif end