! First include the set of model-wide compiler flags #include "tm5.inc" ! Macro #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if #define TRACEBACK write (gol,'("in ",a," (",a,i6,")")') rname, __FILE__, __LINE__ ; call goErr #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if #define IF_NOTOK_MDF(action) if (status/=0) then; TRACEBACK; action; call MDF_CLose(fid,status); status=1; return; end if ! integer, parameter :: sp = selected_real_kind(6, 37) ! integer, parameter :: dp = selected_real_kind(15, 307) !===================================================================== ! ! Write OmF information to netcdf file, with one file per orbit ! ! Henk Eskes, KNMI, Aug 2016 !====================================================================== module MOmF_output ! printing, error handling use GO, only : gol, goPr, goErr, goLabel ! Observational input (slant columns) is stored in this structure use MTObsTrack, only : TObsTrack ! Storage for retrieval results (vertical columns) use MTObsFcInfo, only : TObsFcInfo ! Storage superobservations use MOmFSuper, only : TObsInfoReduced ! output makes use of the MDF module use MDF implicit none private public :: OmF_Output !------------------------------------------------------------- character(len=*), parameter :: dataset_author = 'Henk Eskes' character(len=*), parameter :: institution = 'KNMI' ! character(len=*) :: dataset_version = character(len=*), parameter :: mname = 'MOmF_output' ! type for netcdf file access, storing id's of datasets type TPFile_OmF integer :: trec integer :: ncid ! dimension id integer :: dimid_nobs integer :: dimid_nobs_super_fc, dimid_nobs_super_an integer :: dimid_tm5_im, dimid_tm5_jm ! individual observations integer :: varid_lon, varid_lat, varid_icell, varid_jcell integer :: varid_vza, varid_sza, varid_aza integer :: varid_slc, varid_slcerr, varid_cf, varid_cp integer :: varid_slcfc, varid_slcan integer :: varid_fcerr, varid_tropfrac ! superobservations integer :: varid_sup_obsi_fc, varid_sup_obsj_fc integer :: varid_sup_obsi_an, varid_sup_obsj_an integer :: varid_sup_slcobs, varid_sup_slcfc, varid_sup_slcan ! TM5 2D fields integer :: varid_tm5_lon, varid_tm5_lat integer :: varid_tm5_no2col_fc, varid_tm5_no2col_an, varid_tm5_no2col_AmF ! gridded fields integer :: varid_grid_sup_o, varid_grid_sup_f integer :: varid_grid_sup_omf, varid_grid_sup_oma, varid_grid_sup_amf end type TPFile_OmF ! share varid and dimid between subroutines type(TPFile_OmF) :: omff ! parallel netcdf or not ... integer :: access_mode ! netcdf-4 access mode integer :: fid ! for NOTOK_MDF macro ! Undefined value real, parameter :: undef = -999.99 contains subroutine OmF_Output( no2Tr, obsFcInfo, obsFcInfoReduced, NO2VCForecastError, im, jm, tm_lon, tm_lat, tm_no2col_fc, TM5_date, filedir, status, obsAnInfo, obsAnInfoReduced, tm_no2col_an ) implicit none ! in/out ! Storage of track data: NO2 and cloud info type(TObsTrack), intent(inout) :: no2Tr ! observations and model forecast type(TObsFcInfo), intent(inout) :: obsFcInfo ! clustered superobservations type(TObsInfoReduced), intent(inout) :: obsFcInfoReduced ! the 2D model column forecast error distribution real, dimension(:,:), intent(in) :: NO2VCForecastError ! TM5 2D NO2 field integer, intent(in) :: im, jm real, dimension(im), intent(in) :: tm_lon real, dimension(jm), intent(in) :: tm_lat real, dimension(im,jm), intent(in) :: tm_no2col_fc ! other integer, dimension(6), intent(in) :: TM5_date character(len=*), intent(in) :: filedir integer, intent(out) :: status ! optional (analysis) type(TObsFcInfo), intent(inout), optional :: obsAnInfo type(TObsInfoReduced), intent(inout), optional :: obsAnInfoReduced real, dimension(im,jm), intent(in), optional :: tm_no2col_an ! local logical :: includeAnalysis character(len=*), parameter :: rname = trim(mname)//'/OmF_Output' ! begin code status = 0 if ( present(obsAnInfo) .and. present(obsAnInfoReduced) .and. present(tm_no2col_an) ) then print *, 'OmF_Output: output for both forecast and analysis' includeAnalysis = .true. call OmF_Output_Init( no2Tr, im, jm, TM5_date, includeAnalysis, filedir, obsFcInfoReduced%count, obsAnInfoReduced%count, status ) IF_NOTOK_RETURN(status=1) call OmF_Output_Write( no2Tr, obsFcInfo, obsFcInfoReduced, NO2VCForecastError, im, jm, tm_lon, tm_lat, tm_no2col_fc, includeAnalysis, status, obsAnInfo, obsAnInfoReduced, tm_no2col_an ) IF_NOTOK_RETURN(status=1) else print *, 'OmF_Output: output for forecast only' includeAnalysis = .false. call OmF_Output_Init( no2Tr, im, jm, TM5_date, includeAnalysis, filedir, obsFcInfoReduced%count, 0, status ) IF_NOTOK_RETURN(status=1) call OmF_Output_Write( no2Tr, obsFcInfo, obsFcInfoReduced, NO2VCForecastError, im, jm, tm_lon, tm_lat, tm_no2col_fc, includeAnalysis, status ) IF_NOTOK_RETURN(status=1) end if call OmF_Output_Done( status ) IF_NOTOK_RETURN(status=1) print *, 'OmF_Output: done' end subroutine OmF_Output subroutine OmF_Output_Init( no2Tr, im, jm, TM5_date, includeAnalysis, filedir, nobs_sup_fc, nobs_sup_an, status ) ! ! Open OmF netcdf output file, define arrays and attributes ! use partools, only : MPI_INFO_NULL, localComm implicit none ! in/out type(TObsTrack), intent(inout) :: no2Tr integer, intent(in) :: im, jm integer, dimension(6), intent(in) :: TM5_date logical, intent(in) :: includeAnalysis character(len=*), intent(in) :: filedir integer, intent(in) :: nobs_sup_fc, nobs_sup_an integer, intent(out) :: status ! local character(len=*), parameter :: rname = trim(mname)//'/OmF_Output_Init' character(len=256) :: fname integer :: varid integer :: rtype ! --- begin ------------------------------------- call goLabel(rname) ! o open file ! write filename write (fname,'(a,"/",a,"_o",i5.5,".nc")') & trim(filedir), 'omf', no2Tr%orbitNumber print *, 'OmF_Output: file = ',trim(fname) !#ifdef MPI ! ! overwrite existing files (clobber), provide MPI stuff: ! call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, omff%ncid, status, & ! mpi_comm=localComm, mpi_info=MPI_INFO_NULL ) ! if (status/=0) then ! write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr ! write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr ! TRACEBACK; status=1; return ! end if !#else ! overwrite existing files (clobber) call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, omff%ncid, status ) IF_NOTOK_RETURN(status=1) !#endif ! o global attributes call MDF_Put_Att( omff%ncid, MDF_GLOBAL, 'Title', 'Obsevation-minus-forecast output' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, MDF_GLOBAL, 'DatasetAuthor' , trim(dataset_author) , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, MDF_GLOBAL, 'Institution' , trim(institution) , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, MDF_GLOBAL, 'TM5_DateTime' , TM5_date , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, MDF_GLOBAL, 'L2_OrbitFilename' , trim(no2Tr%orbitParts(1)%filename), status) IF_NOTOK_MDF(fid=omff%ncid) ! o define dimensions call MDF_Def_Dim( omff%ncid, 'nObs', no2Tr%count, omff%dimid_nobs, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Def_Dim( omff%ncid, 'nObsSuper_fc', nObs_sup_fc, omff%dimid_nobs_super_fc, status ) IF_NOTOK_MDF(fid=omff%ncid) if ( includeAnalysis ) then ! there may be less analysis than fc superobs (not more) call MDF_Def_Dim( omff%ncid, 'nObsSuper_an', nObs_sup_an, omff%dimid_nobs_super_an, status ) IF_NOTOK_MDF(fid=omff%ncid) end if call MDF_Def_Dim( omff%ncid, 'lon', im, omff%dimid_tm5_im, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Def_Dim( omff%ncid, 'lat', jm, omff%dimid_tm5_jm, status ) IF_NOTOK_MDF(fid=omff%ncid) !#ifdef MPI !#ifdef with_netcdf4_par ! access_mode = MDF_COLLECTIVE !#else ! write(gol,'("Time Series output (PDUMP) requires netcdf4 with parallel access enabled")') ; call goErr ! TRACEBACK ! status=1; return !#endif !#else access_mode = MDF_INDEPENDENT !#endif ! o define variables call MDF_Def_Var( omff%ncid, 'obs_lon_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'longitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'longitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', 'degrees_east' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_lon = varid call MDF_Def_Var( omff%ncid, 'obs_lat_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'latitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'latitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', 'degrees_north' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_lat = varid call MDF_Def_Var( omff%ncid, 'icell_fc', MDF_INT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'tm5_cell_index_lon' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'East-West index of the TM5 cell' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '-' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_icell = varid call MDF_Def_Var( omff%ncid, 'jcell_fc', MDF_INT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'tm5_cell_index_lat' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'North-South index of the TM5 cell' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '-' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_jcell = varid call MDF_Def_Var( omff%ncid, 'vza_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'viewing zenith angle' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'viewing zenith angle at the surface' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', 'degree' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_vza = varid call MDF_Def_Var( omff%ncid, 'sza_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'solar zenith angle' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'solar zenith angle at the surface' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', 'degree' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_sza = varid !call MDF_Def_Var( omff%ncid, 'aza', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) !IF_NOTOK_MDF(fid=omff%ncid) !call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) !IF_NOTOK_MDF(fid=omff%ncid) !call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'relative azimuth angle' , status) !IF_NOTOK_MDF(fid=omff%ncid) !call MDF_Put_Att( omff%ncid, varid, 'long_name', 'relative azimuth angle' , status) !IF_NOTOK_MDF(fid=omff%ncid) !call MDF_Put_Att( omff%ncid, varid, 'units', 'degree' , status) !IF_NOTOK_MDF(fid=omff%ncid) !omff%varid_aza = varid call MDF_Def_Var( omff%ncid, 'slc_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'slant column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'NO2 slant column divided by the geometrical AMF' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_slc = varid call MDF_Def_Var( omff%ncid, 'slc_uncertainty_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'slant column uncertainty' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'Relative NO2 slant column uncertainty (%)' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '%' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_slcerr = varid call MDF_Def_Var( omff%ncid, 'cloudFraction_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'cloud fraction' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'fraction of satellite footprint covered with clouds' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '-' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_cf = varid call MDF_Def_Var( omff%ncid, 'cloudTopPressure', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'cloud pressure' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'effective cloud top pressure' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', 'hPa' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_cp = varid call MDF_Def_Var( omff%ncid, 'no2_slc_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'model forecast slant column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'model NO2 forecast slant column divided by the geometrical AMF' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_slcfc = varid if ( includeAnalysis ) then call MDF_Def_Var( omff%ncid, 'no2_slc_an', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'model analysis slant column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'model NO2 analysis slant column divided by the geometrical AMF' , status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_slcan = varid end if call MDF_Def_Var( omff%ncid, 'forecastError_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'model forecast uncertainty, total column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'model NO2 vertical column uncertainty' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_fcerr = varid call MDF_Def_Var( omff%ncid, 'tropFraction_fc', MDF_FLOAT, (/omff%dimid_nobs/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'model tropospheric column fraction' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'forecast NO2 tropospheric column divided by forecast total column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '-' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_tropfrac = varid ! o superobservations call MDF_Def_Var( omff%ncid, 'sup_obsi_fc', MDF_INT, (/omff%dimid_nobs_super_fc/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'superobs tm5_cell_index_lon' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'East-West index of the TM5 cell of the superobservation' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '-' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_sup_obsi_fc = varid call MDF_Def_Var( omff%ncid, 'sup_obsj_fc', MDF_INT, (/omff%dimid_nobs_super_fc/), varid , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'superobs tm5_cell_index_lat' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'North-South index of the TM5 cell of the superobservation' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '-' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_sup_obsj_fc = varid call MDF_Def_Var( omff%ncid, 'sup_no2_slc_obs_fc', MDF_FLOAT, (/omff%dimid_nobs_super_fc/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'superobservation slant column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'measured NO2 slant column divided by the geometrical AMF for the superobservation' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_sup_slcobs = varid call MDF_Def_Var( omff%ncid, 'sup_no2_slc_fc', MDF_FLOAT, (/omff%dimid_nobs_super_fc/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'superobs model forecast slant column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'model NO2 forecast slant column divided by the geometrical AMF for the superobservation' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_sup_slcfc = varid if ( includeAnalysis ) then call MDF_Def_Var( omff%ncid, 'sup_no2_slc_an', MDF_FLOAT, (/omff%dimid_nobs_super_an/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'superobs model analysis slant column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'model NO2 analysis slant column divided by the geometrical AMF for the superobservation' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_sup_slcan = varid end if ! o TM5 NO2 field call MDF_Def_Var( omff%ncid, 'lon', MDF_FLOAT, (/omff%dimid_tm5_im/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'longitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'longitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', 'degrees_east' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_tm5_lon = varid call MDF_Def_Var( omff%ncid, 'lat', MDF_FLOAT, (/omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'latitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'latitude' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', 'degrees_north' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_tm5_lat = varid call MDF_Def_Var( omff%ncid, 'tm5_no2col_fc', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'TM5 forecast NO2 column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'TM5 forecast NO2 column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_tm5_no2col_fc = varid if ( includeAnalysis ) then call MDF_Def_Var( omff%ncid, 'tm5_no2col_an', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'TM5 analysis NO2 column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'TM5 analysis NO2 column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_tm5_no2col_an = varid call MDF_Def_Var( omff%ncid, 'tm5_no2col_AmF', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'TM5 AmF NO2 column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'TM5 analysis-minus-forecast NO2 column' , status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2' , status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_tm5_no2col_AmF = varid end if ! o gridded fields call MDF_Def_Var( omff%ncid, 'grid_sup_o', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'gridded NO2 superobs', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'NO2 superobservations on the TM5 grid', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2', status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_grid_sup_o = varid call MDF_Def_Var( omff%ncid, 'grid_sup_f', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'gridded NO2 forecast for superobs', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'NO2 forecast for the superobservations on the TM5 grid', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2', status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_grid_sup_f = varid call MDF_Def_Var( omff%ncid, 'grid_sup_omf', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'gridded OmF for superobs', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'Observation-minus-forecast for the superobservations on the TM5 grid', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2', status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_grid_sup_omf = varid if ( includeAnalysis ) then call MDF_Def_Var( omff%ncid, 'grid_sup_oma', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'gridded OmA for superobs', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'Observation-minus-analysis for the superobservations on the TM5 grid', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2', status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_grid_sup_oma = varid call MDF_Def_Var( omff%ncid, 'grid_sup_amf', MDF_FLOAT, (/omff%dimid_tm5_im,omff%dimid_tm5_jm/), varid, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Var_Par_Access( omff%ncid, varid, access_mode, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'standard_name', 'gridded AmF for superobs', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'long_name', 'Analysis-minus-forecast for the superobservations on the TM5 grid', status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Att( omff%ncid, varid, 'units', '10^15 molecules cm^-2', status) IF_NOTOK_MDF(fid=omff%ncid) omff%varid_grid_sup_amf = varid end if ! o end defintion mode call MDF_EndDef( omff%ncid , status) IF_NOTOK_MDF(fid=omff%ncid) ! no records written yet omff%trec = 0 call goLabel() ; status = 0 end subroutine OmF_Output_Init subroutine OmF_Output_Write( no2Tr, obsFcInfo, obsFcInfoReduced, NO2VCForecastError, im, jm, tm_lon, tm_lat, tm_no2col_fc, includeAnalysis, status, obsAnInfo, obsAnInfoReduced, tm_no2col_an ) implicit none ! ! in/out ! Storage of track data: NO2 and cloud info type(TObsTrack), intent(inout) :: no2Tr ! observations and model forecast type(TObsFcInfo), intent(inout) :: obsFcInfo ! clustered superobservations type(TObsInfoReduced), intent(inout) :: obsFcInfoReduced ! the 2D model column forecast error distribution real, dimension(:,:), intent(in) :: NO2VCForecastError ! TM5 2D NO2 field integer, intent(in) :: im, jm real, dimension(im), intent(in) :: tm_lon real, dimension(jm), intent(in) :: tm_lat real, dimension(im,jm), intent(in) :: tm_no2col_fc logical, intent(in) :: includeAnalysis integer, intent(out) :: status ! optional (analysis structures) type(TObsFcInfo), intent(inout), optional :: obsAnInfo type(TObsInfoReduced), intent(inout), optional :: obsAnInfoReduced real, dimension(im,jm), intent(in), optional :: tm_no2col_an ! local character(len=*), parameter :: rname = trim(mname)//'/OmF_Output_Write' integer :: i, isup, isupfc, nObsSup real, dimension(:), allocatable :: fcerr, tropfrac real, dimension(:,:), allocatable :: tmfield real, dimension(:), allocatable :: s_slcfc ! --- begin ------------------------------------- call goLabel(rname) call MDF_Put_Var( omff%ncid, omff%varid_lon, no2Tr%longitude, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_lat, no2Tr%latitude, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_icell, obsFcInfo%icell, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_jcell, obsFcInfo%jcell, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_vza, no2Tr%viewingZenithAngle, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_sza, no2Tr%solarZenithAngle, status) IF_NOTOK_MDF(fid=omff%ncid) !call MDF_Put_Var( omff%ncid, omff%varid_aza, no2Tr%viewingAzimuthAngle, status) !IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_slc, no2Tr%no2slc/obsFcInfo%amfgeo, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_slcerr, no2Tr%no2slcError, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_cf, no2Tr%cloudFraction, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_cp, no2Tr%cloudTopPressure, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_slcfc, obsFcInfo%no2slcfc/obsFcInfo%amfgeo, status) IF_NOTOK_MDF(fid=omff%ncid) if ( includeAnalysis ) then call MDF_Put_Var( omff%ncid, omff%varid_slcan, obsAnInfo%no2slcfc/obsAnInfo%amfgeo, status) IF_NOTOK_MDF(fid=omff%ncid) end if allocate ( fcerr(obsFcInfo%count) ) allocate ( tropfrac(obsFcInfo%count) ) fcerr(:) = undef tropfrac(:) = undef do i = 1, obsFcInfo%count if ( iand(ObsFcInfo%flag(i), 255) == 0 ) then fcerr(i) = NO2VCForecastError(obsFcInfo%icell(i),obsFcInfo%jcell(i)) tropfrac(i) = obsFcInfo%no2vcdfctrop(i)/obsFcInfo%no2vcdfc(i) end if end do call MDF_Put_Var( omff%ncid, omff%varid_fcerr, fcerr, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_tropfrac, tropfrac, status) IF_NOTOK_MDF(fid=omff%ncid) deallocate ( fcerr ) deallocate ( tropfrac ) ! superobs call MDF_Put_Var( omff%ncid, omff%varid_sup_obsi_fc, obsFcInfoReduced%obsi, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_sup_obsj_fc, obsFcInfoReduced%obsj, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_sup_slcobs, obsFcInfoReduced%slcobs, status) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_sup_slcfc, obsFcInfoReduced%slcfc, status) IF_NOTOK_MDF(fid=omff%ncid) if ( includeAnalysis ) then call MDF_Put_Var( omff%ncid, omff%varid_sup_slcan, obsAnInfoReduced%slcfc, status) IF_NOTOK_MDF(fid=omff%ncid) end if ! TM5 NO2 field call MDF_Put_Var( omff%ncid, omff%varid_tm5_lon, tm_lon, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_tm5_lat, tm_lat, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_tm5_no2col_fc, tm_no2col_fc, status ) IF_NOTOK_MDF(fid=omff%ncid) if ( includeAnalysis ) then call MDF_Put_Var( omff%ncid, omff%varid_tm5_no2col_an, tm_no2col_an, status ) IF_NOTOK_MDF(fid=omff%ncid) call MDF_Put_Var( omff%ncid, omff%varid_tm5_no2col_AmF, tm_no2col_an-tm_no2col_fc, status ) IF_NOTOK_MDF(fid=omff%ncid) end if ! gridded results allocate ( tmfield(im,jm) ) ! O for superobs on grid tmfield(:,:) = 0.0 do isup = 1, obsFcInfoReduced%count tmfield(obsFcInfoReduced%obsi(isup),obsFcInfoReduced%obsj(isup)) = obsFcInfoReduced%slcobs(isup) end do call MDF_Put_Var( omff%ncid, omff%varid_grid_sup_o, tmfield, status ) IF_NOTOK_MDF(fid=omff%ncid) ! F for superobs on grid tmfield(:,:) = 0.0 do isup = 1, obsFcInfoReduced%count tmfield(obsFcInfoReduced%obsi(isup),obsFcInfoReduced%obsj(isup)) = obsFcInfoReduced%slcfc(isup) end do call MDF_Put_Var( omff%ncid, omff%varid_grid_sup_f, tmfield, status ) IF_NOTOK_MDF(fid=omff%ncid) ! OmF for superobs on grid tmfield(:,:) = 0.0 do isup = 1, obsFcInfoReduced%count tmfield(obsFcInfoReduced%obsi(isup),obsFcInfoReduced%obsj(isup)) = obsFcInfoReduced%slcobs(isup) - obsFcInfoReduced%slcfc(isup) end do call MDF_Put_Var( omff%ncid, omff%varid_grid_sup_omf, tmfield, status ) IF_NOTOK_MDF(fid=omff%ncid) if ( includeAnalysis ) then ! OmA for superobs tmfield(:,:) = 0.0 do isup = 1, obsAnInfoReduced%count tmfield(obsAnInfoReduced%obsi(isup),obsAnInfoReduced%obsj(isup)) = obsAnInfoReduced%slcobs(isup) - obsAnInfoReduced%slcfc(isup) end do call MDF_Put_Var( omff%ncid, omff%varid_grid_sup_oma, tmfield, status ) IF_NOTOK_MDF(fid=omff%ncid) ! AmF for superobs tmfield(:,:) = 0.0 if ( obsFcInfoReduced%count > obsAnInfoReduced%count ) then ! Reduce and match the number of FC superobs in case there are less analysis points isup = 0 do isupfc = 1, obsFcInfoReduced%count if ( ( obsFcInfoReduced%obsi(isupfc) == obsAnInfoReduced%obsi(isup+1) ) .and. & ( obsFcInfoReduced%obsj(isupfc) == obsAnInfoReduced%obsj(isup+1) ) ) then isup = isup + 1 tmfield(obsAnInfoReduced%obsi(isup),obsAnInfoReduced%obsj(isup)) = obsAnInfoReduced%slcfc(isup) - obsFcInfoReduced%slcfc(isupfc) end if end do if ( isup /= obsAnInfoReduced%count ) then print *, 'ERROR in OmF_output (2nd): isup inconsistent' stop -1 end if else if ( obsFcInfoReduced%count == obsAnInfoReduced%count ) then do isup = 1, obsFcInfoReduced%count tmfield(obsFcInfoReduced%obsi(isup),obsFcInfoReduced%obsj(isup)) = obsAnInfoReduced%slcfc(isup) - obsFcInfoReduced%slcfc(isup) end do call MDF_Put_Var( omff%ncid, omff%varid_grid_sup_amf, tmfield, status ) IF_NOTOK_MDF(fid=omff%ncid) end if end if end if deallocate ( tmfield ) ! wrap up call goLabel() status = 0 end subroutine OmF_Output_Write subroutine OmF_Output_Done( status ) implicit none ! in/out integer, intent(out) :: status ! local character(len=*), parameter :: rname = trim(mname)//'/omff_GridDef_Done' ! --- begin ------------------------------------- call goLabel(rname) call MDF_Close( omff%ncid, status) IF_NOTOK_RETURN(status=1) call goLabel() status = 0 end subroutine OmF_Output_Done end module MOmF_output