subroutine outprint(ks) !----------------------------------------------------------------------------- ! Outputs on file and screen. !----------------------------------------------------------------------------- use pncvar use chimere_common use chimere_params, only: nsectors_sg implicit none #define NCERR(lnum) if (ncstat/=NF90_NOERR) call pnc_err(ncstat,lnum,__FILE__) integer,intent(in) :: ks integer :: ns,cl,nsec ! Counters for out.nc and end.nc integer, save :: irec_out, irec_out2 = 0 integer :: ncstat, ioutspec, nf, ne, no, nsp, i, j, nout integer :: ispec, izo, ime, ivert, nd, sp,cell,sect integer :: iwrt_sg, isup_sg real(kind=iprec), parameter :: salt2na=0.3728d0 ! Conversion coeffient from NA to SALT in units ug/m3 | real(kind=iprec) :: dteffphys, dteffchem, fppb,vol real(kind=iprec),allocatable,dimension(:,:,:,:) :: toprint,bnum real(kind=iprec),allocatable,dimension(:,:,:,:) :: toprint4d real(kind=iprec),allocatable,dimension(:,:,:) :: buf3d real(kind=iprec),allocatable,dimension(:,:,:,:) :: toprint_sg real(kind=iprec),allocatable,dimension(:,:) :: conc_ug_sg real(kind=iprec),dimension(1,1,1,1) :: toprint_sg_dummy real(kind=8) :: nsecsimu character(len=10) :: datimrealchar character(len=dlen) :: out1, out2 character(len=200) :: theline character(len=512) :: get_out_file ! Calculation of cpu and real time integer :: endh, endmn, endh2, endmn2 integer,dimension(8) :: values real(kind=iprec) :: cput1, dtcpu, endtime, endtime2, dtcpu2 !----------------------------------------------------------------------------- ! General buffer tables if(.not. allocated(toprint))allocate(toprint(nspectot,nzonal,nmerid,nverti)) toprint=dzero if ( (sgmodel.eq.1).and.(num_sgcells.gt.0) ) then if(.not.allocated(conc_ug_sg)) allocate(conc_ug_sg(nfam,nsectors_sg+1)) if(.not.allocated(toprint_sg)) allocate(toprint_sg(nspectot,num_sgcells,nverti,nsectors_sg+1)) endif if (sgmodel.eq.1) toprint_sg_dummy=-999.0 !----------------------------------------------------------------------------- ! Calculation of families do nf=1,nfam nsp=nspectot - nfam + nf do ivert=1,nverti cell=0 do ime=1,nmerid do izo=1,nzonal conc(nsp,izo,ime,ivert) = dzero do ne=1,nelem(nf) conc(nsp,izo,ime,ivert) = conc(nsp,izo,ime,ivert) & & + conc(ifam(nf,ne),izo,ime,ivert) ! for sub-grid scale model if((sgmodel.eq.1).and.(num_sgcells.gt.0))then if(mask_map_sg(izo,ime).gt.0)then cell=mask_map_sg(izo,ime) conc_sg(nsp,cell,ivert,:) = conc_sg(nsp,cell,ivert,:) & & + conc_sg(ifam(nf,ne),cell,ivert,:) endif endif enddo enddo enddo enddo enddo ! Transformation of concentrations into ppb or microg/m3 do ivert=1,nverti do ime=1,nmerid do izo=1,nzonal fppb = 1d9/airm(izo,ime,ivert,ks) do nf=1,nfam conc_ug(nf) = dzero nsp=nspectot - nfam + nf nout=0 do no=1,noutspec ns = output_species(no)%iaddr if(ns.eq.nsp)nout=no enddo do ne=1,nelem(nf) if(ifam(nf,ne).le.ngassp) then if(nout.ne.0) then conc_ug(nf) = conc_ug(nf) + conc(ifam(nf,ne),izo,ime,ivert) & & * output_species(nout)%fspec endif else conc_ug(nf) = conc_ug(nf)+conc(ifam(nf,ne),izo,ime,ivert) & & *zunitu(ifam(nf,ne)) endif enddo enddo do no=1,noutspec ns = output_species(no)%iaddr if (output_species(no)%fspec > dzero) then ! Molar mass: ug m-3 if(ns.le.nspec) then toprint(no,izo,ime,ivert) = real(output_species(no)%fspec*conc(ns,izo,ime,ivert)) else toprint(no,izo,ime,ivert) = real(conc_ug(ns-nspectot+nfam)) endif elseif (output_species(no)%fspec > -1.) then ! 0: ppb toprint(no,izo,ime,ivert) = real(fppb*conc(ns,izo,ime,ivert)) elseif (output_species(no)%fspec > -10.) then ! -1 => to molec m-3 (for pollen output) toprint(no,izo,ime,ivert) = real(conc(ns,izo,ime,ivert)*1.d6 / changeUnits) else ! <= -10. => molec cm-3 (boundary/initial conditions for nested runs) toprint(no,izo,ime,ivert) = real(conc(ns,izo,ime,ivert)) endif enddo enddo enddo enddo ! specific loop for subgrid results if ((sgmodel.eq.1).and.(num_sgcells.gt.0)) then do ivert=1,nverti cell=0 do ime=1,nmerid do izo=1,nzonal fppb = 1d9/airm(izo,ime,ivert,ks) cell=mask_map_sg(izo,ime) if (cell.gt.0)then do nf=1,nfam conc_ug_sg(nf,:) = dzero nsp=nspectot - nfam + nf nout=0 do no=1,noutspec ns = output_species(no)%iaddr if(ns.eq.nsp)nout=no enddo do ne=1,nelem(nf) if(ifam(nf,ne).le.ngassp) then if(nout.ne.0) then conc_ug_sg(nf,:) = conc_ug_sg(nf,:)+conc_sg(ifam(nf,ne),cell,ivert,:) & & *output_species(nout)%fspec endif else conc_ug_sg(nf,:) = conc_ug_sg(nf,:) + conc_sg(ifam(nf,ne),cell,ivert,:) & & *zunitu(ifam(nf,ne)) endif enddo enddo do no=1,noutspec ns = output_species(no)%iaddr if (output_species(no)%fspec > dzero) then ! Molar mass: ug m-3 if(ns.le.nspec) then toprint_sg(no,cell,ivert,:) = real(output_species(no)%fspec& & *conc_sg(ns,cell,ivert,:)) else toprint_sg(no,cell,ivert,:) = real(conc_ug_sg(ns-nspectot+nfam,:)) endif elseif (output_species(no)%fspec > -1.) then ! 0: ppb toprint_sg(no,cell,ivert,:) = real(fppb*conc_sg(ns,cell,ivert,:)) elseif (output_species(no)%fspec > -10.) then ! -1 => to molec m-3 (for pollen output) toprint_sg(no,cell,ivert,:) = real(conc_sg(ns,cell,ivert,:)*1.d6 / changeUnits) else ! <= -10. => molec cm-3 (boundary/initial conditions for nested runs) toprint_sg(no,cell,ivert,:) = real(conc_sg(ns,cell,ivert,:)) endif enddo endif ! cell.gt.0 enddo ! ime enddo ! izo enddo ! ivert endif ! sgmodel !----------------------------------------------------------------------------- ! Opening output file if this is the first run hour if(ihourrun.eq.0)then irec_out=0 call iniout(trim(fnout)) endif irec_out = irec_out + 1 ! TIMES call pncvar_write_time(out_nc, rank, idatestart, ihourrun, irec_out) !------------------------------------------------------------------ ! SPECIES do ioutspec=1,noutspec ! First treat species that do not have a size_bin dimension if (output_species(ioutspec)%bin == 0) then call pncvar_put_var(domains, var_output_species(ioutspec), & & toprint(ioutspec,:,:,:), rank, & & (/nzonal,nmerid,nverti,1/), (/irec_out/)) ! Add pSALT to output by dividing pNA with salt2na coefficent if (iusesalt.ne.0) then if (output_species(ioutspec)%name.eq.'pNA')then call pncvar_put_var(domains, var_param_psalt,& & toprint(ioutspec,:,:,:) / salt2na , rank, & & (/nzonal,nmerid,nverti,1/), (/irec_out/)) endif endif ! Subgrid scale species if (sgmodel.eq.1) then iwrt_sg=0 if (output_species(ioutspec)%name.eq.'NO')then iwrt_sg=1 isup_sg=noutspec+1 endif if (output_species(ioutspec)%name.eq.'NO2')then iwrt_sg=1 isup_sg=noutspec+2 endif if (output_species(ioutspec)%name.eq.'O3')then iwrt_sg=1 isup_sg=noutspec+3 endif if (output_species(ioutspec)%name.eq.'PM25')then iwrt_sg=1 isup_sg=noutspec+4 endif if (output_species(ioutspec)%name.eq.'PM10')then iwrt_sg=1 isup_sg=noutspec+5 endif if(iwrt_sg.eq.1)then if (num_sgcells.gt.0) then ncstat = nf90_put_var(var_output_species(isup_sg)%ncid, & & var_output_species(isup_sg)%id, & & toprint_sg(ioutspec,:,:,:),start=(/sgcells_start_count,1,1,irec_out/), & & count=(/num_sgcells,nverti,nsectors_sg+1,1/)) if (ncstat /= NF90_NOERR) then print*, 'Error putting var :',var_output_species(isup_sg)%name, & & 'in file :',var_output_species(isup_sg)%ncid print*, 'Error code ', ncstat, ':', trim(nf90_strerror(ncstat)) endif else ncstat = nf90_put_var(var_output_species(isup_sg)%ncid,var_output_species(isup_sg)%id,& &toprint_sg_dummy,start=(/1,1,1,irec_out/),count=(/0,0,0,1/)) endif endif endif ! sgmodel ! Then treat species which do have a size_bin dimension. ! In this case, put the values in the appropriate bin. ! Index in var_output_species(:) is given by output_species(ioutspec)%varid. else call pncvar_put_var(domains, var_output_species(output_species(ioutspec)%varid), & & toprint(ioutspec,:,:,:), & & rank,(/nzonal,nmerid,nverti,1,1/), & & (/output_species(ioutspec)%bin,irec_out/)) ! Add bSALT to output by dividing bNA with salt2na coefficent if (iusesalt.ne.0) then if (output_species(ioutspec)%name.eq.'bNA')then call pncvar_put_var(domains, var_param_bsalt,& & toprint(ioutspec,:,:,:) /salt2na , rank, & & (/nzonal,nmerid,nverti,1,1/), (/irec_out/)) endif endif endif enddo ! wet properties of aerosols if(iwmet.ge.2.and.bins.eq.1)then do nsec=1,ms call pncvar_put_var(domains, var_dry_to_wet, & & real(dry_to_wet(1:nzonal,1:nmerid,1:nverti,nsec)), & & rank,(/nzonal,nmerid,nverti,1,1/),(/nsec,irec_out/)) enddo do nsec=1,ms call pncvar_put_var(domains, var_wetdensity, & & real(wet_density(1:nzonal,1:nmerid,1:nverti,nsec)), & & rank,(/nzonal,nmerid,nverti,1,1/),(/nsec,irec_out/)) enddo endif !----------------------------------------------------------------------------- ! Calculate aerosol NUMBER distribution: output in #/cm3 ! (here without water, considered as the last aero species in the list) ! zunitu: from molecules/cm3 to ug/m3 ! vol: [m3] (calculated using 'ds' in meters) ! rhoaero in kg/m3 ! from ug to kg => x 1.d-9 ! from m3 to cm3 => x 1d-6 ! Total conversion: x 1d-15 if(bins.eq.1.)then if(.not. allocated(bnum))allocate(bnum(ms,nzonal,nmerid,nverti)) bnum = 0.d0 do i=1,ms do ivert=1,nverti do ime=1,nmerid do izo=1,nzonal do j=1,nkc-1 bnum(i,izo,ime,ivert) = bnum(i,izo,ime,ivert) & & +conc(iaersp(i,j),izo,ime,ivert) & & *zunitu(iaersp(i,j))/(rhoaero(j)*vol_sec(i))*1.d-15 enddo enddo enddo enddo enddo do i=1,ms call pncvar_put_var(domains,var_param_bnum,bnum(i,1:nzonal,1:nmerid,1:nverti),rank, & & (/nzonal,nmerid,nverti,1,1/),(/i,irec_out/)) enddo endif !chemistry if (mecachim.eq.3.and.bins.eq.1) then call pncvar_put_var(domains,var_param_gamma_cl,gamma_cl(1:nzonal,1:nmerid,1:nverti,1:ms), & rank,(/nzonal,nmerid,nverti,ms,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_gamma_stock_cl,gamma_stock_cl(1:nzonal,1:nmerid,1:nverti,1:ms), & rank,(/nzonal,nmerid,nverti,ms,1/),(/irec_out/)) allocate(toprint4d(nzonal,nmerid,nverti,ms)) do i=1,ms toprint4d(:,:,:,i)=surfloc(i,:,:,:) enddo call pncvar_put_var(domains,var_param_surfloc,toprint4d, & rank,(/nzonal,nmerid,nverti,ms,1/),(/irec_out/)) do i=1,ms toprint4d(:,:,:,i)=surfloc_dry(i,:,:,:) enddo call pncvar_put_var(domains,var_param_surfloc_dry,toprint4d, & rank,(/nzonal,nmerid,nverti,ms,1/),(/irec_out/)) deallocate(toprint4d) endif !------------------------------------------------------------------ ! Optical depth for clouds and aerosols + total (for the nwl=5 Fast-J wavelengths) if(iwmet.ge.3.and.mecachim.ge.1)then call pncvar_put_var(domains,var_jO3loc, real(jO3loc(1:nzonal,1:nmerid,1:nverti)), & & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_jNO2loc, real(jNO2loc(1:nzonal,1:nmerid,1:nverti)), & & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) endif if(iwmet.ge.3)then call pncvar_put_var(domains,var_allod, real(allod(1:nzonal,1:nmerid,1:nwl)), & & rank,(/nzonal,nmerid,nwl,1/),(/irec_out/)) call pncvar_put_var(domains,var_cloudod, real(cloudod(1:nzonal,1:nmerid,1:nwl)), & & rank,(/nzonal,nmerid,nwl,1/),(/irec_out/)) endif call pncvar_put_var(domains,var_aerood, real(aerood(1:nzonal,1:nmerid,1:nwl)), & & rank,(/nzonal,nmerid,nwl,1/),(/irec_out/)) !------------------------------------------------------------------ ! lidar profiles if (ilidar.eq.1) then call pncvar_put_var(domains,var_atb_mol_nad, real(atb_mol_nad(1:nzonal,1:nmerid,1:nverti,1:nwl)), & & rank,(/nzonal,nmerid,nverti,nwl,1/),(/irec_out/)) call pncvar_put_var(domains,var_atb_tot_nad, real(atb_tot_nad(1:nzonal,1:nmerid,1:nverti,1:nwl)), & & rank,(/nzonal,nmerid,nverti,nwl,1/),(/irec_out/)) call pncvar_put_var(domains,var_scat_ratio_nad, real(scat_ratio_nad(1:nzonal,1:nmerid,1:nverti,1:nwl)), & & rank,(/nzonal,nmerid,nverti,nwl,1/),(/irec_out/)) call pncvar_put_var(domains,var_atb_mol_zen, real(atb_mol_zen(1:nzonal,1:nmerid,1:nverti,1:nwl)), & & rank,(/nzonal,nmerid,nverti,nwl,1/),(/irec_out/)) call pncvar_put_var(domains,var_atb_tot_zen, real(atb_tot_zen(1:nzonal,1:nmerid,1:nverti,1:nwl)), & & rank,(/nzonal,nmerid,nverti,nwl,1/),(/irec_out/)) call pncvar_put_var(domains,var_scat_ratio_zen, real(scat_ratio_zen(1:nzonal,1:nmerid,1:nverti,1:nwl)), & & rank,(/nzonal,nmerid,nverti,nwl,1/),(/irec_out/)) endif !------------------------------------------------------------------ ! Meteo files to out file ! ! iwmet=1: only 2D fields ! iwmet=2: 2D fields + 3D for u,v,t,q,P ! iwmet=2: 2D fields + 3D fields for all variables !-------------------- ! 2D fields ! Lightning flash numbers if(ilinox.eq.1)then call pncvar_put_var(domains, var_flashnum, flashnum(1:nzonal,1:nmerid), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) endif ! last rain call pncvar_put_var(domains, var_lastrain, lastrain(1:nzonal,1:nmerid), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_hght, cm2m*hght(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_u10m, u10m(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_v10m, v10m(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_w10m, cm2m*w10m(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_usta, cm2m*usta(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_wsta, cm2m*wsta(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_tem2, tem2(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_soim, soim(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_sreh, sreh(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_sshf, sshf(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_slhf, slhf(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_copc, copc(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_lspc, lspc(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_topc, topc(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_aerr, aerr(1:nzonal,1:nmerid,ks)/cm2m, & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_atte, atte(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_swrd, swrd(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) call pncvar_put_var(domains, var_param_albedo, albedo(1:nzonal,1:nmerid,ks), & & rank, (/nzonal,nmerid,1/), (/irec_out/)) !---------------------------- ! 3D fields for iwmet>=2 ! airm enters this routine already in molecules / cm3 (after met2chim) ! Depp convection fluxes are in (g/cm2/s) => (kg/m2/s) conversion = * 10. if(iwmet.ge.2)then call pncvar_put_var(domains,var_param_winz, cm2m*winz(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_winm, cm2m*winm(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_winw, cm2m*real(winw(1:nzonal,1:nmerid,1:nverti,ks)), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_temp, temp(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_sphu, & & sphu(1:nzonal,1:nmerid,1:nverti,ks)/(airm(1:nzonal,1:nmerid,1:nverti,ks)*air_dry2moist), & & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_airm, airm(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_hlay, cm2m*hlay(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_pres, pres(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) endif if(iwmet.ge.3)then call pncvar_put_var(domains, var_param_relh, real(rehu(1:nzonal,1:nmerid,1:nverti,ks)), & & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_cloudph, phloc(1:nzonal,1:nmerid,1:nverti), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_aeroph, aeroph(1:nzonal,1:nmerid,1:nverti), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_kzzz, cm2m*cm2m*kzzz(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_cliq, & cliq(1:nzonal,1:nmerid,1:nverti,ks)*real(avogadro)/(airm(1:nzonal,1:nmerid,1:nverti,ks)*29.), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) if(rain_ok.eq.1)call pncvar_put_var(domains,var_param_rain, & rain(1:nzonal,1:nmerid,1:nverti,ks)*real(avogadro)/(airm(1:nzonal,1:nmerid,1:nverti,ks)*29.), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) if(snow_ok.eq.1)call pncvar_put_var(domains,var_param_snow, & snow(1:nzonal,1:nmerid,1:nverti,ks)*real(avogadro)/(airm(1:nzonal,1:nmerid,1:nverti,ks)*29.), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_cice, & cice(1:nzonal,1:nmerid,1:nverti,ks)*real(avogadro)/(airm(1:nzonal,1:nmerid,1:nverti,ks)*29.), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_thlay, cm2m*thlay(1:nzonal,1:nmerid,1:nverti,ks), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_dpeu, dpeu(1:nzonal,1:nmerid,1:nverti,ks)*flxg2kg*molec2g, & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_dped, dped(1:nzonal,1:nmerid,1:nverti,ks)*flxg2kg*molec2g, & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_dpdu, dpdu(1:nzonal,1:nmerid,1:nverti,ks)*flxg2kg*molec2g, & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_dpdd, dpdd(1:nzonal,1:nmerid,1:nverti,ks)*flxg2kg*molec2g, & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_flxu, flxu(1:nzonal,1:nmerid,1:nverti,ks)*flxg2kg*molec2g, & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) call pncvar_put_var(domains,var_param_flxd, flxd(1:nzonal,1:nmerid,1:nverti,ks)*flxg2kg*molec2g, & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) endif ! Chemical regime if(mecachim.ge.1)then call pncvar_put_var(domains,var_param_chemregime, chemregime(1:nzonal,1:nmerid,1:nverti), & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) endif ! write minerals in case of dust explicit mineralogy if(iusedust.eq.3)then allocate(buf3d(nzonal,nmerid,nverti)) do i=1,nmineralchem buf3d=0d0 do ispec=1,nkc do nsec=1,ms ns=iaersp(nsec,ispec) nd=inemisd(ns) if(nd.ne.0) then sp=idustspec(nd) if(sp.ne.0) then do ivert=1,nverti do ime=1,nmerid do izo=1,nzonal buf3d(izo,ime,ivert)=buf3d(izo,ime,ivert)+conc(ns,izo,ime,ivert) & & *zunitu(ns)*mineral_ratio(sp,i)/100d0 enddo enddo enddo endif endif enddo enddo !Mg case if(i.eq.ismg) then do ivert=1,nverti do ime=1,nmerid do izo=1,nzonal do nsec=1,ms ns = iaersp(nsec,1)-1 buf3d(izo,ime,ivert)=buf3d(izo,ime,ivert) & & +zunitu(ns+ina)*conc(ns+ina,izo,ime,ivert)*na2mg enddo enddo enddo enddo endif !Ca case if(i.eq.isca) then do ivert=1,nverti do ime=1,nmerid do izo=1,nzonal do nsec=1,ms ns = iaersp(nsec,1)-1 buf3d(izo,ime,ivert)=buf3d(izo,ime,ivert) & & +zunitu(ns+ina)*conc(ns+ina,izo,ime,ivert)*na2ca enddo enddo enddo enddo endif !K case if(i.eq.isk) then do ivert=1,nverti do ime=1,nmerid do izo=1,nzonal do nsec=1,ms ns = iaersp(nsec,1)-1 buf3d(izo,ime,ivert)=buf3d(izo,ime,ivert) & & +zunitu(ns+ina)*conc(ns+ina,izo,ime,ivert)*na2k enddo enddo enddo enddo endif call pncvar_put_var(domains,var_min(i), buf3d, & & rank,(/nzonal,nmerid,nverti,1/),(/irec_out/)) enddo deallocate(buf3d) endif !----------------------------------------------------------------------------- ! Synchronize disk to avoid data loss call pncvar_sync(out_nc%id) !----------------------------------------------------------------------------- ! Output on screen if (rank.eq.middle_proc.and.ihourrun.eq.0) then out1=output_species(1)%name(1:cl(output_species(1)%name)) out2=output_species(2)%name(1:cl(output_species(2)%name)) theline='[42m DATE '//out1(1:9)//out2(1:9)//'T_2m(C) ' & & //' PBLH(m) DTphys(mn) DTchem(mn) CPU(mn) end(h)' print*,' ' print 103,achar(27)//theline(1:120)//achar(27)//'[0m' endif if (rank == middle_proc) then ! physical and chemical time-step dteffphys=3600d0/nphour dteffchem=dtr/60d0 ! 'endtime' (in seconds) is calculated by using all values to smooth the result ! 1. Calculation with the CPUtime call cpu_time(cput1) dtcpu=(cput1-cput0) cput0=cput1 if(ihourrun.eq.0)then cpucum=cput1 endtime=cpucum*real(nhourrun) else cpucum=cpucum+dtcpu endtime=(cpucum/real(ihourrun+1))*(real(nhourrun)-real(ihourrun+1)) endif endh=int(endtime/3600.) endmn=int((endtime/3600.-endh)*60) if(endmn.lt.0)endmn=0. print 106, idate(ihourrun), & & toprint(1,id_izo_middle,id_ime_middle,1), & & toprint(2,id_izo_middle,id_ime_middle,1), & & tem2(id_izo_middle,id_ime_middle,ks)-t0k, & & hght(id_izo_middle,id_ime_middle,ks)*1d-2, & & dteffphys/60., dteffchem, dtcpu/60., endh,'h',endmn endif 103 format(100a) 104 format(i10,f10.1,f10.1,f10.1,f10.0,f10.2,f10.2,f10.2,f10.2) 105 format(a9,a12,a13,3x,6(a10)) 106 format(i10,f10.1,f10.1,f10.1,f10.0,f10.2,f10.2,f10.2,3x,i3,1a,i2.2) ! Write to the end.nc file every nsaveconcs if((mod(ihourrun, nsaveconcs) == 0)) call write_end if (allocated(toprint))deallocate(toprint) if (allocated(bnum))deallocate(bnum) !----------------------------------------------------------------------------- contains subroutine write_end if(ihourrun.eq.0)then irec_out2=0 call iniend(trim(fnconcs)) endif irec_out2 = irec_out2 + 1 call pncvar_write_time(end_nc, rank, idatestart, ihourrun, irec_out2) ! Last rain call pncvar_put_var(domains, var_end_lastrain, lastrain(1:nzonal,1:nmerid), & & rank, (/nzonal,nmerid,1/), (/irec_out2/)) ! Daily averaged value of T2m and SWRD for Megan call pncvar_put_var(domains, var_end_dtem2d, m_dtem2d(1:nzonal,1:nmerid,1:240), & & rank, (/nzonal,nmerid,240,1/), (/irec_out2/)) call pncvar_put_var(domains, var_end_drad2d, m_drad2d(1:nzonal,1:nmerid,1:240), & & rank, (/nzonal,nmerid,240,1/), (/irec_out2/)) ! Optical properties (write only if online) if (online.eq.1)then call pncvar_put_var(domains, var_end_aod_aer, & & aod3dloc_wrf(1:nzonal,1:nmerid,1:nlev_wrf,1:nwl), & & rank, (/nzonal,nmerid,nlev_wrf,nwl,1/), (/irec_out2/)) call pncvar_put_var(domains, var_end_aod_lw_aer, & & aod3dloc_lw_wrf(1:nzonal,1:nmerid,1:nlev_wrf,1:nwl_lw), & & rank, (/nzonal,nmerid,nlev_wrf,nwl_lw,1/), (/irec_out2/)) call pncvar_put_var(domains, var_end_ssa_aer, & & sscat_alb(1:nzonal,1:nmerid,1:nlev_wrf,1:nwl), & & rank, (/nzonal,nmerid,nlev_wrf,nwl,1/), (/irec_out2/)) call pncvar_put_var(domains, var_end_g_aer, & & asymmetry_factor(1:nzonal,1:nmerid,1:nlev_wrf,1:nwl), & & rank, (/nzonal,nmerid,nlev_wrf,nwl,1/), (/irec_out2/)) endif if(iwmet.ge.2.and.bins.eq.1)then do nsec=1,ms call pncvar_put_var(domains, var_end_dry_to_wet, & & real(dry_to_wet(1:nzonal,1:nmerid,1:nverti,nsec)), & & rank,(/nzonal,nmerid,nverti,1,1/),(/nsec,irec_out2/)) enddo do nsec=1,ms call pncvar_put_var(domains, var_end_wetdensity, & & real(wet_density(1:nzonal,1:nmerid,1:nverti,nsec)), & & rank,(/nzonal,nmerid,nverti,1,1/),(/nsec,irec_out2/)) enddo endif if(cpl_case.eq.3.or.cpl_case.eq.4) then do nsec=1,ms call pncvar_put_var(domains, var_end_num_aer_wrf, & & real(num_aer_wrf(1:nzonal,1:nmerid,1:nlev_wrf,nsec)), & & rank,(/nzonal,nmerid,nlev_wrf,1,1/),(/nsec,irec_out2/)) enddo do nsec=1,ms call pncvar_put_var(domains, var_end_num_aer_hygro_wrf, & & real(num_aer_hygro_wrf(1:nzonal,1:nmerid,1:nlev_wrf,nsec)), & & rank,(/nzonal,nmerid,nlev_wrf,1,1/),(/nsec,irec_out2/)) enddo call pncvar_put_var(domains, var_end_hygro_aer_wrf, & & hygro_aer_wrf(1:nzonal,1:nmerid,1:nlev_wrf), & & rank, (/nzonal,nmerid,nlev_wrf,1/), (/irec_out2/)) call pncvar_put_var(domains, var_end_ice_nucl_wrf, & & ice_nucl_wrf(1:nzonal,1:nmerid,1:nlev_wrf), & & rank, (/nzonal,nmerid,nlev_wrf,1/), (/irec_out2/)) endif ! CONC for "end" file do ispec=1,nspectot call pncvar_put_var(domains,var_end_species(ispec), & & conc(ispec,1:nzonal,1:nmerid,1:nverti), rank,(/nzonal,nmerid,nverti,1/),(/irec_out2/)) enddo call pncvar_put_var(domains,var_end_airm, airm(1:nzonal,1:nmerid,1:nverti,ks), & & rank,(/nzonal,nmerid,nverti,1/),(/irec_out2/)) call pncvar_put_var(domains,var_end_hlay, cm2m*hlay(1:nzonal,1:nmerid,1:nverti,ks), & & rank,(/nzonal,nmerid,nverti,1/),(/irec_out2/)) ! Synchronize disk to avoid data loss call pncvar_sync(end_nc%id) end subroutine write_end !------------------------------------------------------------------------------------------ end subroutine outprint