123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758 |
- ! First include the set of model-wide compiler flags
- #include "tm5.inc"
- ! -----------------------------------------------------------------------------
- !
- ! TROPOMI NL L2 Data Processors
- !
- ! Copyright 2013-2015 KNMI
- ! This software is the proprietary information of KNMI
- ! All rights Reserved
- !
- ! -----------------------------------------------------------------------------
- module TM5IF_module
- use MTObsTrack
- use MTObsFcInfo
- use netcdf
- use pqf_module, only : PQF_E_GENERIC_EXCEPTION
- implicit none
- private
- public :: TM5IF_select, TM5IF_obstrack_read, TM5IF_obsfcinfo_write
- public :: TM5IF_time_init, TM5IF_time_to_string
- public :: TM5IF_log_info, TM5IF_log_error, TM5IF_log_debug
- public :: TM5IF_date, FILENAME_LEN
- integer, parameter :: FILENAME_LEN = 256
- integer, parameter :: STR_LEN = 256
- integer :: ncfileid
- integer :: ncgroupid
- character*(FILENAME_LEN) :: ncfilename
- ! In case of QA4ECV, the unit of the columns is 10^15 molecules per cm^2
- logical :: use_scd_qa4ecv_units
- ! undefined
- ! real, parameter :: nf_fill_float = 9.9692099683868690e+36
- real(4), parameter :: nf_fill_float = 9.96921e+36
- type TM5IF_date
- integer :: year, month, day, hour, minute, second
- end type TM5IF_date
- interface TM5IF_put_var
- module procedure TM5IF_put_var_f2, TM5IF_put_var_f3, TM5IF_put_var_f4, TM5IF_put_var_i3
- end interface
- interface TM5IF_get_var
- module procedure TM5IF_get_var_f2, TM5IF_get_var_f3, TM5IF_get_var_f4, TM5IF_get_var_i1, TM5IF_get_var_i2, TM5IF_get_var_i3
- end interface
- interface TM5IF_put_att
- module procedure TM5IF_put_att_str
- end interface
- interface TM5IF_get_att
- module procedure TM5IF_get_att_i, TM5IF_get_att_str
- end interface
- contains
- ! -----------------------------------------------------------------------------
- subroutine TM5IF_select ( filename, timeStart, timeStop, obstrack, before_or_after )
- ! Select L2 NO2 products.
- ! Check if product coverage time range falls in processing time range.
- ! If so, read number of scanlines used for allocation of memory for
- ! reading during pass 2.
- !
- ! before_or_after = -1 : the orbit time is before the time interval
- ! 0 : the orbit time is inside the time interval
- ! 1 : the orbit time is after the time interval
- implicit none
- character*(*),intent(in) :: filename
- type(TM5IF_date),intent(in) :: timeStart
- type(TM5IF_date),intent(in) :: timeStop
- type(TObsTrack),intent(inout) :: obstrack
- integer, intent(out) :: before_or_after
- character*(STR_LEN) :: str
- integer :: i, j, n, status
- integer :: nValidPixels
- integer :: dimScanline
- integer :: dimGroundPixel
- integer :: firstimage
- integer :: secCoverageStart
- integer :: secCoverageEnd
- integer :: secCoverageMid
- type(TM5IF_date) :: timeCoverageStart
- type(TM5IF_date) :: timeCoverageEnd
- integer, allocatable :: processingQualityFlags(:,:,:)
- integer, allocatable :: processingErrorFlag(:,:,:)
- status = TM5IF_open ( filename, nf90_nowrite )
- if (status /= 0) goto 999
- status = TM5IF_get_att("time_coverage_start", str)
- if (status /= 0) goto 998
- status = TM5IF_convert_date(str, timeCoverageStart);
- if (status /= 0) goto 998
- status = TM5IF_get_att("time_coverage_end", str)
- if (status /= 0) goto 998
- status = TM5IF_convert_date(str, timeCoverageEnd);
- if (status /= 0) goto 998
- secCoverageStart = TM5IF_time_get_seconds(timeCoverageStart)
- secCoverageEnd = TM5IF_time_get_seconds(timeCoverageEnd)
- secCoverageMid = (secCoverageStart + secCoverageEnd) / 2
- if (secCoverageMid < TM5IF_time_get_seconds(timeStart)) then
- ! orbit before time interval
- before_or_after = -1
- goto 998
- endif
- if (secCoverageMid > TM5IF_time_get_seconds(timeStop)) then
- ! orbit after time interval
- before_or_after = 1
- goto 998
- endif
- ! orbit inside time interval
- before_or_after = 0
- status = TM5IF_set_group("/PRODUCT")
- if (status /= 0) goto 998
- status = TM5IF_get_dimension("scanline", dimScanline)
- if (status /= 0) goto 998
- status = TM5IF_get_dimension("ground_pixel", dimGroundPixel)
- if (status /= 0) goto 998
- status = TM5IF_set_group("/PRODUCT/SUPPORT_DATA/DETAILED_RESULTS")
- if (status /= 0) goto 998
- status = TM5IF_get_var("processing_quality_flags", processingQualityFlags)
- if (status /= 0) goto 998
- status = TM5IF_set_group("/PRODUCT")
- if (status /= 0) goto 998
- nValidPixels = 0
- do i = 1, dimScanline
- do j = 1, dimGroundPixel
- if (iand(processingQualityFlags(j, i, 1), 255) == 0) nValidPixels = nValidPixels + 1
- end do
- end do
- deallocate ( processingQualityFlags )
- print '(a,i6,a,i6)', ' TM5IF_select: nValidPixels = ', nValidPixels,' total = ',dimGroundPixel*dimScanline
- n = obstrack%norbitparts + 1
- obstrack%orbitparts(n)%filename = filename
- obstrack%orbitparts(n)%nValidPixels = nValidPixels
- obstrack%orbitparts(n)%dimScanline = dimScanline
- obstrack%orbitparts(n)%starttime(1) = timeCoverageStart%year
- obstrack%orbitparts(n)%starttime(2) = timeCoverageStart%month
- obstrack%orbitparts(n)%starttime(3) = timeCoverageStart%day
- obstrack%orbitparts(n)%starttime(4) = timeCoverageStart%hour
- obstrack%orbitparts(n)%starttime(5) = timeCoverageStart%minute
- obstrack%orbitparts(n)%starttime(6) = timeCoverageStart%second
- obstrack%orbitparts(n)%endtime(1) = timeCoverageEnd%year
- obstrack%orbitparts(n)%endtime(2) = timeCoverageEnd%month
- obstrack%orbitparts(n)%endtime(3) = timeCoverageEnd%day
- obstrack%orbitparts(n)%endtime(4) = timeCoverageEnd%hour
- obstrack%orbitparts(n)%endtime(5) = timeCoverageEnd%minute
- obstrack%orbitparts(n)%endtime(6) = timeCoverageEnd%second
- !obstrack%orbitparts(n)%meantime = TBD
- obstrack%norbitparts = n
- 998 continue
- status = TM5IF_close()
- if (status /= 0) goto 999
- 999 continue
- end subroutine TM5IF_select
- ! -----------------------------------------------------------------------------
- subroutine TM5IF_obstrack_read(obstrack)
- ! Read L2 NO2 product
- implicit none
- type(TObsTrack) :: obstrack
- character(STR_LEN) :: str
- character(STR_LEN) :: scd_unit_string
- integer :: dim_scanline
- integer :: dim_ground_pixel
- integer :: dim_corner
- integer :: dim_time
- integer :: dim_polynomial_exponents
- integer :: dim_pressure_levels
- integer :: dim_profile_layers
- integer :: i, j, k, n
- integer :: iorbit
- integer :: status
- ! must be real(4) because of reading from netcdf
- real(4), allocatable :: latitude(:,:,:)
- real(4), allocatable :: longitude(:,:,:)
- real(4), allocatable :: latitude_bounds(:,:,:,:)
- real(4), allocatable :: longitude_bounds(:,:,:,:)
- real(4), allocatable :: solar_zenith_angle(:,:,:)
- real(4), allocatable :: solar_azimuth_angle(:,:,:)
- real(4), allocatable :: viewing_zenith_angle(:,:,:)
- real(4), allocatable :: viewing_azimuth_angle(:,:,:)
- real(4), allocatable :: surface_altitude(:,:,:)
- real(4), allocatable :: surface_pressure(:,:,:)
- real(4), allocatable :: surface_albedo_no2(:,:,:)
- real(4), allocatable :: scd_no2(:,:,:)
- real(4), allocatable :: scd_no2_precision(:,:,:)
- real(4), allocatable :: chi_squared(:,:,:)
- real(4), allocatable :: cloud_fraction_no2(:,:,:)
- real(4), allocatable :: cloud_pressure(:,:,:)
- real(4), allocatable :: cloud_albedo(:,:,:)
- real(4), allocatable :: cloud_radiance_fraction_no2(:,:,:)
- real(4), allocatable :: scene_albedo(:,:,:)
- real(4), allocatable :: scene_pressure(:,:,:)
- integer, allocatable :: snow_ice_flag(:,:,:)
- integer, allocatable :: pixel_type(:,:,:)
- integer, allocatable :: time(:)
- integer, allocatable :: delta_time(:,:)
- integer, allocatable :: processing_quality_flags(:,:,:)
- obstrack%count = 0
- call TM5IF_log_info("TM5IF_obstrack_read: now reading the track (orbit parts)")
- n = 0
- do i = 1, obstrack%norbitparts
- n = n + obstrack%orbitparts(i)%nValidPixels
- end do
- call ObsTrackAllocate(obstrack, n)
- do i = 1, obstrack%norbitparts
- call TM5IF_log_info(" Reading data from " // trim(obstrack%orbitparts(i)%filename))
- status = TM5IF_open ( trim(obstrack%orbitparts(i)%filename), nf90_nowrite)
- if (status /= 0) goto 998
- status = TM5IF_get_att("orbit", iorbit)
- if (status /= 0) goto 998
- status = TM5IF_set_group("/PRODUCT")
- if (status /= 0) goto 996
- status = TM5IF_get_dimension("time", dim_time)
- if (status /= 0) goto 996
- status = TM5IF_get_dimension("scanline", dim_scanline)
- if (status /= 0) goto 996
- status = TM5IF_get_dimension("ground_pixel", dim_ground_pixel)
- if (status /= 0) goto 996
- if (dim_time /= 1) then
- call TM5IF_log_error(" Invalid value for dimension 'time'")
- goto 996
- end if
- status = TM5IF_get_var( "time", time )
- if (status /= 0) goto 996
- status = TM5IF_get_var( "delta_time", delta_time )
- if (status /= 0) goto 996
- status = TM5IF_get_var( "latitude", latitude )
- if (status /= 0) goto 996
- status = TM5IF_get_var( "longitude", longitude )
- if (status /= 0) goto 996
- status = TM5IF_set_group("/PRODUCT/SUPPORT_DATA/GEOLOCATIONS")
- if (status /= 0) goto 996
- status = TM5IF_get_var( "pixel_type", pixel_type )
- if (status /= 0) goto 996
- status = TM5IF_get_var( "latitude_bounds", latitude_bounds )
- if (status /= 0) goto 996
- status = TM5IF_get_var( "longitude_bounds", longitude_bounds )
- if (status /= 0) goto 996
- status = TM5IF_get_var( "solar_zenith_angle", solar_zenith_angle )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "viewing_zenith_angle", viewing_zenith_angle )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "solar_azimuth_angle", solar_azimuth_angle, printErrorMessage = .false. )
- if ( status /= 0 ) then
- ! try QA4ECV convention
- status = TM5IF_get_var( "relative_azimuth_angle", solar_azimuth_angle )
- if ( status /= 0 ) goto 996
- call TM5IF_log_info(" Note: using -relative_azimuth_angle- instead of -solar_azimuth_angle- ")
- end if
- status = TM5IF_get_var( "viewing_azimuth_angle", viewing_azimuth_angle, printErrorMessage = .false. )
- if ( status /= 0 ) then
- ! try QA4ECV convention
- ! set vaa = raa, so that the computation in "MObservationOperator" yields a correct value
- status = TM5IF_get_var( "relative_azimuth_angle", viewing_azimuth_angle )
- if ( status /= 0 ) goto 996
- ! re-set saa to 180, so that the computation in "MObservationOperator" yields a correct value
- solar_azimuth_angle(:,:,:) = 180.0
- call TM5IF_log_info(" Note: using -relative_azimuth_angle_surf- instead of -viewing_azimuth_angle- ")
- end if
- status = TM5IF_set_group("/PRODUCT/SUPPORT_DATA/DETAILED_RESULTS")
- if (status /= 0) goto 996
- status = TM5IF_get_var("processing_quality_flags", processing_quality_flags)
- if (status /= 0) goto 996
- status = TM5IF_get_var("scd_no2", scd_no2)
- if (status /= 0) goto 996
- status = TM5IF_get_var_att_str("scd_no2", "units", scd_unit_string)
- if (status /= 0) goto 996
- use_scd_qa4ecv_units = .false.
- if ( trim(scd_unit_string) == "molecules cm-2" ) use_scd_qa4ecv_units = .true.
- print *, ' scd_no2: use qa4ecv units = ',use_scd_qa4ecv_units
- print *, ' scd_no2: units = ',trim(scd_unit_string)
- status = TM5IF_get_var("scd_no2_precision", scd_no2_precision)
- if (status /= 0) goto 996
- status = TM5IF_get_var( "chi_squared", chi_squared, printErrorMessage = .false. )
- if ( status /= 0 ) then
- ! QA4ECV does not provide chi_2
- ! set to fill value
- allocate ( chi_squared(dim_ground_pixel,dim_scanline,1) )
- chi_squared(:,:,:) = nf_fill_float
- call TM5IF_log_info(" Note: -chi_squared- set to fill value ")
- end if
- status = TM5IF_get_var( "cloud_radiance_fraction_no2", cloud_radiance_fraction_no2, printErrorMessage = .false. )
- if ( status /= 0 ) then
- ! QA4ECV does not provide cloud radiance fraction: set to fill value in this case
- allocate ( cloud_radiance_fraction_no2(dim_ground_pixel,dim_scanline,1) )
- cloud_radiance_fraction_no2(:,:,:) = nf_fill_float
- call TM5IF_log_info(" Warning: -cloud_radiance_fraction_no2- set to fill value ")
- end if
- status = TM5IF_get_var( "cloud_fraction_no2", cloud_fraction_no2, printErrorMessage = .false. )
- if ( status /= 0 ) then
- ! QA4ECV does not provide "cloud_fraction_no2", use cloud fraction instead
- status = TM5IF_set_group("/PRODUCT/SUPPORT_DATA/INPUT_DATA")
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "cloud_fraction", cloud_fraction_no2 )
- if ( status /= 0 ) goto 996
- call TM5IF_log_info(" Note: using -cloud_fraction- instead of -cloud_fraction_no2- ")
- end if
- status = TM5IF_set_group("/PRODUCT/SUPPORT_DATA/INPUT_DATA")
- if (status /= 0) goto 996
- status = TM5IF_get_var("surface_altitude", surface_altitude)
- if (status /= 0) goto 996
- status = TM5IF_get_var("surface_pressure", surface_pressure)
- if (status /= 0) goto 996
- status = TM5IF_get_var("surface_albedo_no2", surface_albedo_no2)
- if (status /= 0) goto 996
- status = TM5IF_get_var("cloud_pressure", cloud_pressure)
- if (status /= 0) goto 996
- status = TM5IF_get_var("cloud_albedo", cloud_albedo, printErrorMessage = .false.)
- if ( status /= 0 ) then
- ! QA4ECV does not provide cloud albedo
- ! set to fill value
- allocate ( cloud_albedo(dim_ground_pixel,dim_scanline,1) )
- cloud_albedo(:,:,:) = 0.8
- call TM5IF_log_info(" Note: -cloud_albedo- set to 0.8 ")
- end if
- status = TM5IF_get_var("snow_ice_flag", snow_ice_flag)
- if (status /= 0) goto 996
- status = TM5IF_get_var("scene_pressure", scene_pressure)
- if (status /= 0) goto 996
- status = TM5IF_get_var("scene_albedo", scene_albedo)
- if (status /= 0) goto 996
- ! note: surface_altitude_precision is a field in the file, but is not defined
- ! note: surface_classification is a field in the file, but is also not defined
- ! note: for OMI, "omi_xtrack_flags" row anomaly flags are provided.
- ! However, these errors are included in the "processing_quality_flags"
- ! note: the "snow_ice_flag" needs to be read, because this info is not yet included
- ! in the processing_quality_flags. In the "MObservationoperator" module
- ! the action needs to be defined for snow/ice (use scene albedo/pressure),
- ! and the processing_quality_flags should be updated accordingly.
- n = obstrack%count
- print *, ' dims scanline groundpix = ', dim_scanline, dim_ground_pixel
- obstrack%dimGroundPixel = dim_ground_pixel
- ! print *, 'processing_quality_flags(:, j=500, 1)',processing_quality_flags(:, 800, 1)
- obstrack%orbitNumber = iorbit
- do j = 1, dim_scanline
- do k = 1, dim_ground_pixel
- if ( iand(processing_quality_flags(k, j, 1), 255) == 0 ) then
- n = n + 1
- obstrack%orbitPartIndex(n) = i
- obstrack%pixelIndex(n) = k
- obstrack%scanlineIndex(n) = j
- obstrack%subPixelNumber(n) = 1
- obstrack%pixelFlag(n) = processing_quality_flags(k, j, 1)
- obsTrack%subPixelNumber(n) = pixel_type(k, j, 1)
- obstrack%latitude(n) = latitude(k, j, 1)
- obstrack%longitude(n) = longitude(k, j, 1)
- obstrack%cornerLatitude(:,n) = latitude_bounds(:, k, j, 1)
- obstrack%cornerLongitude(:,n) = longitude_bounds(:, k, j, 1)
- if ( use_scd_qa4ecv_units ) then
- ! QA4ECV definition
- ! units = molecules cm-2, store as (10^15 molecules cm-2)
- obstrack%no2SLC(n) = scd_no2(k, j, 1) / 1.0e+15
- ! units = molecules cm-2, store as %
- obstrack%no2SLCError(n) = scd_no2_precision(k, j, 1) * 100.0 / scd_no2(k, j, 1)
- else
- ! TROPOMI definition
- ! units = mol m-2, store as (10^15 molecules cm-2)
- obstrack%no2SLC(n) = scd_no2(k, j, 1) * 6.02214e+19 / 1.0e+15
- ! units = mol m2, store as %
- obstrack%no2SLCError(n) = scd_no2_precision(k, j, 1) * 100.0 / scd_no2(k, j, 1)
- end if
- obstrack%chiSquareFit(n) = chi_squared(k, j, 1)
- obstrack%solarZenithAngle(n) = solar_zenith_angle(k, j, 1)
- obstrack%solarAzimuthAngle(n) = solar_azimuth_angle(k, j, 1)
- obstrack%viewingZenithAngle(n) = viewing_zenith_angle(k, j, 1)
- obstrack%ViewingAzimuthAngle(n) = viewing_azimuth_angle(k, j, 1)
- obstrack%cloudFraction(n) = cloud_fraction_no2(k, j, 1)
- obstrack%cloudTopPressure(n) = cloud_pressure(k, j, 1)
- obstrack%cloudAlbedo(n) = cloud_albedo(k, j, 1)
- obstrack%snowIceFlag(n) = snow_ice_flag(k, j, 1)
- obstrack%sceneAlbedo(n) = scene_albedo(k, j, 1)
- obstrack%scenePressure(n) = scene_pressure(k, j, 1)
- obstrack%cloudRadianceFraction(n) = cloud_radiance_fraction_no2(k, j, 1)
- obstrack%surfaceAlbedo(n) = surface_albedo_no2(k, j, 1)
- obstrack%terrainHeight(n) = surface_altitude(k, j, 1)
- obstrack%terrainPressure(n) = surface_pressure(k, j, 1)
- end if
- end do
- end do
- obstrack%count = n
- 996 continue
- deallocate ( latitude, stat=status )
- deallocate ( longitude, stat=status )
- deallocate ( latitude_bounds, stat=status )
- deallocate ( longitude_bounds, stat=status )
- deallocate ( solar_zenith_angle, stat=status )
- deallocate ( solar_azimuth_angle, stat=status )
- deallocate ( viewing_zenith_angle, stat=status )
- deallocate ( viewing_azimuth_angle, stat=status )
- deallocate ( surface_altitude, stat=status )
- deallocate ( surface_pressure, stat=status )
- deallocate ( surface_albedo_no2, stat=status )
- deallocate ( scd_no2, stat=status )
- deallocate ( scd_no2_precision, stat=status )
- deallocate ( chi_squared, stat=status )
- deallocate ( cloud_fraction_no2, stat=status )
- deallocate ( cloud_pressure, stat=status )
- deallocate ( cloud_albedo, stat=status )
- deallocate ( cloud_radiance_fraction_no2, stat=status )
- deallocate ( scene_albedo )
- deallocate ( scene_pressure )
- deallocate ( snow_ice_flag )
- deallocate ( pixel_type, stat=status )
- deallocate ( time, stat=status )
- deallocate ( delta_time, stat=status )
- deallocate ( processing_quality_flags, stat=status )
- 997 continue
- status = TM5IF_close ( )
- if ( status /= 0 ) goto 998
- 998 continue
- end do
- write(str, *) obstrack%count
- call TM5IF_log_info(" TM5IF_obstrack_read, loaded " // trim(adjustl(str)) // " observations")
- 999 continue
- end subroutine TM5IF_obstrack_read
- ! -----------------------------------------------------------------------------
- subroutine TM5IF_obsfcinfo_write ( obstrack, obsfcinfo, TM5Data )
- ! Update L2 NO2 product
- use MTM5Data, only : TTM5Data
- implicit none
- ! in/out
- type(TObsTrack), intent(inout) :: obstrack
- type(TObsFcInfo), intent(inout) :: obsfcinfo
- type(TTM5Data), intent(inout) :: TM5Data
- ! local
- integer :: i, j, k, l, n, intf
- integer :: status
- real :: f
- logical :: no_error
- ! main product
- integer, dimension(:,:,:), allocatable :: processing_error_flag
- real(4), dimension(:,:,:), allocatable :: amf_total
- real(4), dimension(:,:,:), allocatable :: amf_trop
- real(4), dimension(:,:,:,:), allocatable :: averaging_kernel
- real(4), dimension(:,:,:), allocatable :: tm5_surface_pressure
- real(4), dimension(:,:,:), allocatable :: tm5_tropopause_layer_index
- real(4), dimension(:,:,:), allocatable :: tropospheric_no2_vertical_column
- real(4), dimension(:,:,:), allocatable :: tropospheric_no2_vertical_column_precision
- real(4), dimension(:,:), allocatable :: tm5_pressure_level_a
- real(4), dimension(:,:), allocatable :: tm5_pressure_level_b
- ! detailed results
- real(4), dimension(:,:,:), allocatable :: amf_clear
- real(4), dimension(:,:,:), allocatable :: amf_strat
- real(4), dimension(:,:,:), allocatable :: ghost_column_no2
- integer, dimension(:,:,:), allocatable :: processing_quality_flags
- real(4), dimension(:,:,:), allocatable :: stratospheric_no2_vertical_column
- real(4), dimension(:,:,:), allocatable :: stratospheric_no2_vertical_column_precision
- real(4), dimension(:,:,:), allocatable :: summed_no2_total_vertical_column
- real(4), dimension(:,:,:), allocatable :: summed_no2_total_vertical_column_precision
- real(4), dimension(:,:,:), allocatable :: total_no2_vertical_column
- real(4), dimension(:,:,:), allocatable :: total_no2_vertical_column_precision
- real(4), dimension(:,:,:), allocatable :: cloud_radiance_fraction
- ! start code
- do i = 1, obstrack%norbitparts
- call TM5IF_log_info("TM5IF_obsfcinfo_write: Writing VCD NO2 data to file: ")
- call TM5IF_log_info(" " // trim(obstrack%orbitparts(i)%filename))
- status = TM5IF_open(trim(obstrack%orbitparts(i)%filename), nf90_write)
- if ( status /= 0 ) goto 998
- status = TM5IF_put_att("processing_status", "Retrieval/assimilation step complete, vertical columns and kernels added")
- if ( status /= 0 ) goto 996
- ! === Main product ===
- status = TM5IF_set_group("/PRODUCT" )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "processing_error_flag", processing_error_flag )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "amf_total", amf_total )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "amf_trop", amf_trop )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "averaging_kernel", averaging_kernel )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "tm5_pressure_level_a", tm5_pressure_level_a )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "tm5_pressure_level_b", tm5_pressure_level_b )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "tm5_surface_pressure", tm5_surface_pressure )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "tm5_tropopause_layer_index", tm5_tropopause_layer_index )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "tropospheric_no2_vertical_column", tropospheric_no2_vertical_column )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "tropospheric_no2_vertical_column_precision", tropospheric_no2_vertical_column_precision )
- if ( status /= 0 ) goto 996
- ! === Detailed Results ===
- status = TM5IF_set_group("/PRODUCT/SUPPORT_DATA/DETAILED_RESULTS")
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "amf_clear", amf_clear )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "amf_strat", amf_strat )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "ghost_column_no2", ghost_column_no2 )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "processing_quality_flags", processing_quality_flags )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "stratospheric_no2_vertical_column", stratospheric_no2_vertical_column )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "stratospheric_no2_vertical_column_precision", stratospheric_no2_vertical_column_precision )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "summed_no2_total_vertical_column", summed_no2_total_vertical_column )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "summed_no2_total_vertical_column_precision", summed_no2_total_vertical_column_precision )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "total_no2_vertical_column", total_no2_vertical_column )
- if ( status /= 0 ) goto 996
- status = TM5IF_get_var( "total_no2_vertical_column_precision", total_no2_vertical_column_precision )
- if ( status /= 0 ) goto 996
- if ( ObsFcInfo%cloudRadFraction_computed ) then
- status = TM5IF_get_var( "cloud_radiance_fraction_no2", cloud_radiance_fraction )
- if ( status /= 0 ) goto 996
- end if
- ! QA4ECV units or TROPOMI units (NO2 columns)
- if ( use_scd_qa4ecv_units ) then
- ! QA4ECV definition
- ! units = molecules cm-2, store as (10^15 molecules cm-2)
- f = 1.0e+15
- else
- f = 1.0e+15 / 6.02214e+19
- end if
- do n = 1, obstrack%count
- if ( obstrack%orbitPartIndex(n) == i ) then
- j = obstrack%scanlineIndex(n)
- k = obstrack%pixelIndex(n)
- ! errors/warnings
- processing_quality_flags(k, j, 1) = obsfcinfo%flag(n)
- ! check if first 8 bits are all = 0
- no_error = (iand(obsfcinfo%flag(n), 255) == 0)
- if ( no_error ) then
- processing_error_flag(k, j, 1) = 0 ! success
- else
- processing_error_flag(k, j, 1) = 1 ! failure
- end if
- ! replace fill values only in case there was no error detected
- if ( no_error ) then
- ! main product
- amf_total(k, j, 1) = obsfcinfo%amf(n)
- amf_trop(k, j, 1) = obsfcinfo%amftrop(n)
- averaging_kernel(:, k, j, 1) = obsfcinfo%avkernel(:, n)
- tm5_surface_pressure(k, j, 1) = obsfcinfo%psurf(n)
- tm5_tropopause_layer_index(k, j, 1) = obsfcinfo%levtropopause(n)
- tropospheric_no2_vertical_column(k, j, 1) = obsfcinfo%no2vcdtrop(n) * f
- tropospheric_no2_vertical_column_precision(k, j, 1) = obsfcinfo%no2vcdtropsig(n) * f
-
- ! detailed results
- amf_clear(k, j, 1) = obsfcinfo%amfclear(n)
- amf_strat(k, j, 1) = obsfcinfo%amfstrat(n)
- ghost_column_no2(k, j, 1) = obsfcinfo%ghostcol(n) * f
- stratospheric_no2_vertical_column(k, j, 1) = obsfcinfo%no2vcdstrat(n) * f
- stratospheric_no2_vertical_column_precision(k, j, 1) = obsfcinfo%no2vcdstratsig(n) * f
- summed_no2_total_vertical_column(k, j, 1) = obsfcinfo%no2vcdsum(n) * f
- summed_no2_total_vertical_column_precision(k, j, 1) = obsfcinfo%no2vcdsumsig(n) * f
- total_no2_vertical_column(k, j, 1) = obsfcinfo%no2vcd(n) * f
- total_no2_vertical_column_precision(k, j, 1) = obsfcinfo%no2vcdsig(n) * f
- if ( ObsFcInfo%cloudRadFraction_computed ) then
- cloud_radiance_fraction(k, j, 1) = obsfcinfo%cloudradfraction(n)
- end if
- end if
- end if
- end do
- status = TM5IF_set_group("/PRODUCT")
- if ( status /= 0 ) goto 996
- do l = 1, TM5Data%lm
- do intf = 1, 2
- tm5_pressure_level_a(intf,l) = TM5Data%hyai(l+intf-1)
- tm5_pressure_level_b(intf,l) = TM5Data%hybi(l+intf-1)
- end do
- end do
- status = TM5IF_put_var("processing_error_flag", processing_error_flag)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("amf_total", amf_total)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("amf_trop", amf_trop)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("averaging_kernel", averaging_kernel)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("tm5_pressure_level_a", tm5_pressure_level_a)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("tm5_pressure_level_b", tm5_pressure_level_b)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("tm5_surface_pressure", tm5_surface_pressure)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("tm5_tropopause_layer_index", tm5_tropopause_layer_index)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("tropospheric_no2_vertical_column", tropospheric_no2_vertical_column)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("tropospheric_no2_vertical_column_precision", tropospheric_no2_vertical_column_precision)
- if ( status /= 0 ) goto 996
- status = TM5IF_set_group("/PRODUCT/SUPPORT_DATA/DETAILED_RESULTS")
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("amf_clear", amf_clear)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("amf_strat", amf_strat)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("ghost_column_no2", ghost_column_no2)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("processing_quality_flags", processing_quality_flags)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("stratospheric_no2_vertical_column", stratospheric_no2_vertical_column)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("stratospheric_no2_vertical_column_precision", stratospheric_no2_vertical_column_precision)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("summed_no2_total_vertical_column", summed_no2_total_vertical_column)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("summed_no2_total_vertical_column_precision", summed_no2_total_vertical_column_precision)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("total_no2_vertical_column", total_no2_vertical_column)
- if ( status /= 0 ) goto 996
- status = TM5IF_put_var("total_no2_vertical_column_precision", total_no2_vertical_column_precision)
- if ( status /= 0 ) goto 996
- if ( ObsFcInfo%cloudRadFraction_computed ) then
- status = TM5IF_put_var( "cloud_radiance_fraction_no2", cloud_radiance_fraction )
- if ( status /= 0 ) goto 996
- end if
- 996 continue
- deallocate( processing_error_flag, stat=status )
- deallocate( amf_total, stat=status )
- deallocate( amf_trop, stat=status )
- deallocate( averaging_kernel, stat=status )
- deallocate( tm5_pressure_level_a, stat=status )
- deallocate( tm5_pressure_level_b, stat=status )
- deallocate( tm5_surface_pressure, stat=status )
- deallocate( tm5_tropopause_layer_index, stat=status )
- deallocate( tropospheric_no2_vertical_column, stat=status )
- deallocate( tropospheric_no2_vertical_column_precision, stat=status )
- deallocate( amf_clear, stat=status )
- deallocate( amf_strat, stat=status )
- deallocate( ghost_column_no2, stat=status )
- deallocate( processing_quality_flags, stat=status )
- deallocate( stratospheric_no2_vertical_column, stat=status )
- deallocate( stratospheric_no2_vertical_column_precision, stat=status )
- deallocate( summed_no2_total_vertical_column, stat=status )
- deallocate( summed_no2_total_vertical_column_precision, stat=status )
- deallocate( total_no2_vertical_column, stat=status )
- deallocate( total_no2_vertical_column_precision, stat=status )
- 997 continue
- status = TM5IF_close()
- if ( status /= 0 ) goto 998
- 998 continue
- end do
- 999 continue
- end subroutine TM5IF_obsfcinfo_write
- ! -----------------------------------------------------------------------------
- integer function TM5IF_open ( filename, mode )
- implicit none
- character(len=*), intent(in) :: filename
- integer, intent(in) :: mode
- integer :: status
- ncfilename = filename
- call TM5IF_log_debug("Opening '" // trim(ncfilename) // "'")
- status = nf90_open(trim(ncfilename), mode, ncfileid)
- if (status /= 0) then
- call TM5IF_log_error("Failed to open file '" // trim(ncfilename) // "'")
- TM5IF_open = 1
- return
- end if
- ncgroupid = ncfileid
- TM5IF_open = 0
- end function TM5IF_open
- ! -----------------------------------------------------------------------------
- function TM5IF_close()
- integer TM5IF_close
- integer status
- call TM5IF_log_debug("Closing '" // trim(ncfilename) // "'")
- status = nf90_close(ncfileid)
- if (status /= 0) then
- call TM5IF_log_error("Failed to close file '" // trim(ncfilename) // "'")
- TM5IF_close = 1
- return
- end if
- TM5IF_close = 0
- end function TM5IF_close
- ! -----------------------------------------------------------------------------
- function TM5IF_set_group(name)
- integer TM5IF_set_group
- character*(*) name
- integer status
- integer ncnewgroupid
- integer i, j, n
- i = 1
- j = 1
- n = len(trim(name))
- do j = 1, n
- if (j == n) then
- status = nf90_inq_grp_ncid(ncgroupid, name(i:j), ncnewgroupid)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire id for group '" // trim(name(i:j)) // "'")
- TM5IF_set_group = 1
- return
- end if
- ncgroupid = ncnewgroupid
- else if (name(j:j) == "/") then
- if (i == j) then
- ncgroupid = ncfileid
- else
- status = nf90_inq_grp_ncid(ncgroupid, name(i:j-1), ncnewgroupid)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire id for group '" // trim(name(i:j-1)) // "'")
- TM5IF_set_group = 1
- return
- end if
- ncgroupid = ncnewgroupid
- end if
- i = j + 1
- end if
- end do
- TM5IF_set_group = 0
- end function TM5IF_set_group
- ! -----------------------------------------------------------------------------
- function TM5IF_get_dimension(name, value)
- integer TM5IF_get_dimension
- character*(*) name
- integer value
- integer status
- integer ncdimid
- status = nf90_inq_dimid(ncgroupid, name, ncdimid)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire id for dimension '" // name // "'")
- TM5IF_get_dimension = 1
- return
- end if
- status = nf90_inquire_dimension(ncgroupid, ncdimid, len=value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dimension '" // name // "'")
- TM5IF_get_dimension = 1
- return
- end if
- TM5IF_get_dimension = 0
- end function TM5IF_get_dimension
- ! -----------------------------------------------------------------------------
- function TM5IF_get_att_i(name, value)
- integer :: TM5IF_get_att_i
- character*(*) :: name
- integer :: value
- integer :: status
- status = nf90_get_att(ncgroupid, NF90_GLOBAL, name, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get attribute '" // name // "'")
- TM5IF_get_att_i = 1
- return
- end if
- TM5IF_get_att_i = 0
- end function TM5IF_get_att_i
- ! -----------------------------------------------------------------------------
- function TM5IF_get_att_str(name, value)
- integer TM5IF_get_att_str
- character*(*) :: name
- character*(*) :: value
- integer status
- status = nf90_get_att(ncgroupid, NF90_GLOBAL, name, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get attribute '" // name // "'")
- TM5IF_get_att_str = 1
- return
- end if
- TM5IF_get_att_str = 0
- end function TM5IF_get_att_str
- ! -----------------------------------------------------------------------------
- integer function TM5IF_put_att_str ( name, value )
- implicit none
- character(len=*), intent(in) :: name
- character(len=*), intent(in) :: value
- integer :: status
- status = nf90_put_att(ncgroupid, NF90_GLOBAL, name, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to put attribute '" // name // "'")
- TM5IF_put_att_str = 1
- return
- end if
- TM5IF_put_att_str = 0
- end function TM5IF_put_att_str
- ! -----------------------------------------------------------------------------
- function TM5IF_get_var_att_str(varname, name, value)
- integer :: TM5IF_get_var_att_str
- character*(*) :: varname
- character*(*) :: name
- character*(*) :: value
- integer :: status
- integer :: ncvarid
- ! first, get the varid corresponding to varname
- status = nf90_inq_varid(ncgroupid, varname, ncvarid)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_get_var_att_str = 1
- return
- end if
- ! then, get the attribute of this variable
- status = nf90_get_att(ncgroupid, ncvarid, name, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get attribute '" // name // "'")
- TM5IF_get_var_att_str = 1
- return
- end if
- TM5IF_get_var_att_str = 0
- end function TM5IF_get_var_att_str
- ! -----------------------------------------------------------------------------
- integer function TM5IF_put_var_f2(name, value)
- implicit none
- character(len=*), intent(in) :: name
- real(4), dimension(:,:), intent(inout), allocatable :: value
- integer :: status
- integer :: ncvarid
- integer :: ndims
- integer, dimension(nf90_max_var_dims) :: dimids
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_put_var_f2 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_put_var_f2 = 1
- return
- end if
- if ( ndims /= 2 ) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_put_var_f2 = 1
- return
- end if
- status = nf90_put_var(ncgroupid, ncvarid, value)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to put variable '" // name // "'")
- TM5IF_put_var_f2 = 1
- return
- end if
- TM5IF_put_var_f2 = 0
- end function TM5IF_put_var_f2
- ! -----------------------------------------------------------------------------
- integer function TM5IF_put_var_f3(name, value)
- implicit none
- character(len=*), intent(in) :: name
- real(4), dimension(:,:,:), intent(inout),allocatable :: value
- integer :: status
- integer :: ncvarid
- integer :: ndims
- integer, dimension(nf90_max_var_dims) :: dimids
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_put_var_f3 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_put_var_f3 = 1
- return
- end if
- if ( ndims /= 3 ) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_put_var_f3 = 1
- return
- end if
- status = nf90_put_var(ncgroupid, ncvarid, value)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to put variable '" // name // "'")
- TM5IF_put_var_f3 = 1
- return
- end if
- TM5IF_put_var_f3 = 0
- end function TM5IF_put_var_f3
- ! -----------------------------------------------------------------------------
- integer function TM5IF_put_var_f4(name, value)
- implicit none
- character(len=*), intent(in) :: name
- real(4), dimension(:,:,:,:), intent(inout),allocatable :: value
- integer :: status
- integer :: ncvarid
- integer :: ndims
- integer, dimension(nf90_max_var_dims) :: dimids
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_put_var_f4 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_put_var_f4 = 1
- return
- end if
- if ( ndims /= 4 ) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_put_var_f4 = 1
- return
- end if
- status = nf90_put_var(ncgroupid, ncvarid, value)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to put variable '" // name // "'")
- TM5IF_put_var_f4 = 1
- return
- end if
- TM5IF_put_var_f4 = 0
- end function TM5IF_put_var_f4
- ! -----------------------------------------------------------------------------
- integer function TM5IF_put_var_i3(name, value)
- ! unsigned byte, 3D array
- implicit none
- character(len=*), intent(in) :: name
- integer, dimension(:,:,:), intent(inout), allocatable :: value
- integer :: status
- integer :: ncvarid
- integer :: ndims
- integer, dimension(nf90_max_var_dims) :: dimids
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_put_var_i3 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_put_var_i3 = 1
- return
- end if
- if ( ndims /= 3 ) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_put_var_i3 = 1
- return
- end if
- status = nf90_put_var(ncgroupid, ncvarid, value)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to put variable '" // name // "'")
- TM5IF_put_var_i3 = 1
- return
- end if
- TM5IF_put_var_i3 = 0
- end function TM5IF_put_var_i3
- ! -----------------------------------------------------------------------------
- integer function TM5IF_get_var_f2 ( name, value, printErrorMessage )
- implicit none
- character(len=*), intent(in) :: name
- real(4), dimension(:,:), allocatable, intent(inout) :: value
- logical, intent(in), optional :: printErrorMessage
- integer :: status
- integer :: ncvarid
- integer :: ndims, idim
- integer, dimension(nf90_max_var_dims) :: dimids
- integer, dimension(nf90_max_var_dims) :: dims
- logical :: shout
- ! messages ?
- shout = .true.
- if ( present(printErrorMessage) ) shout = printErrorMessage
- ! variable should not have been allocated yet
- if ( allocated(value) ) deallocate(value)
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if (status /= 0) then
- if ( shout ) call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_get_var_f2 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_f2 = 1
- return
- end if
- if ( ndims /= 2 ) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_get_var_f2 = 1
- return
- end if
- do idim = 1, ndims
- status = nf90_inquire_dimension(ncgroupid, dimids(idim), len = dims(idim))
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_f2 = 1
- return
- end if
- end do
- allocate(value(dims(1), dims(2)))
- status = nf90_get_var(ncgroupid, ncvarid, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get variable '" // name // "'")
- TM5IF_get_var_f2 = 1
- return
- end if
- TM5IF_get_var_f2 = 0
- end function TM5IF_get_var_f2
- ! -----------------------------------------------------------------------------
- integer function TM5IF_get_var_f3 ( name, value, printErrorMessage )
- implicit none
- character(len=*), intent(in) :: name
- real(4), dimension(:,:,:), intent(inout), allocatable :: value
- logical, intent(in), optional :: printErrorMessage
- integer :: status
- integer :: ncvarid
- integer :: ndims, idim
- integer, dimension(nf90_max_var_dims) :: dimids
- integer, dimension(nf90_max_var_dims) :: dims
- logical :: shout
- ! messages ?
- shout = .true.
- if ( present(printErrorMessage) ) shout = printErrorMessage
- ! variable should not have been allocated yet
- if ( allocated(value) ) deallocate(value)
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if ( status /= 0 ) then
- if ( shout ) call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_get_var_f3 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_f3 = 1
- return
- end if
- if ( ndims /= 3 ) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_get_var_f3 = 1
- return
- end if
- do idim = 1, ndims
- status = nf90_inquire_dimension(ncgroupid, dimids(idim), len = dims(idim))
- if ( status /= 0 ) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_f3 = 1
- return
- end if
- end do
- allocate(value(dims(1), dims(2), dims(3)))
- status = nf90_get_var(ncgroupid, ncvarid, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get variable '" // name // "'")
- TM5IF_get_var_f3 = 1
- return
- end if
- TM5IF_get_var_f3 = 0
- end function TM5IF_get_var_f3
- ! -----------------------------------------------------------------------------
- function TM5IF_get_var_f4 ( name, value, printErrorMessage )
- integer TM5IF_get_var_f4
- character*(*) name
- real(4), allocatable :: value(:,:,:,:)
- logical, intent(in), optional :: printErrorMessage
- integer status
- integer ncvarid
- integer ndims, idim
- integer, dimension(nf90_max_var_dims) :: dimids
- integer, dimension(nf90_max_var_dims) :: dims
- logical :: shout
- ! messages ?
- shout = .true.
- if ( present(printErrorMessage) ) shout = printErrorMessage
- ! variable should not have been allocated yet
- if ( allocated(value) ) deallocate(value)
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if (status /= 0) then
- if ( shout ) call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_get_var_f4 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_f4 = 1
- return
- end if
- if (ndims /= 4) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_get_var_f4 = 1
- return
- end if
- do idim = 1, ndims
- status = nf90_inquire_dimension(ncgroupid, dimids(idim), len = dims(idim))
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_f4 = 1
- return
- end if
- end do
- allocate(value(dims(1), dims(2), dims(3), dims(4)))
- status = nf90_get_var(ncgroupid, ncvarid, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get variable '" // name // "'")
- TM5IF_get_var_f4 = 1
- return
- end if
- TM5IF_get_var_f4 = 0
- end function TM5IF_get_var_f4
- ! -----------------------------------------------------------------------------
- function TM5IF_get_var_i1 ( name, value, printErrorMessage )
- integer TM5IF_get_var_i1
- character*(*) name
- integer, allocatable :: value(:)
- logical, intent(in), optional :: printErrorMessage
- integer status
- integer ncvarid
- integer ndims, idim
- integer, dimension(nf90_max_var_dims) :: dimids
- integer, dimension(nf90_max_var_dims) :: dims
- logical :: shout
- ! messages ?
- shout = .true.
- if ( present(printErrorMessage) ) shout = printErrorMessage
- ! variable should not have been allocated yet
- if ( allocated(value) ) deallocate(value)
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if (status /= 0) then
- if ( shout ) call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_get_var_i1 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_i1 = 1
- return
- end if
- if (ndims /= 1) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_get_var_i1 = 1
- return
- end if
- do idim = 1, ndims
- status = nf90_inquire_dimension(ncgroupid, dimids(idim), len = dims(idim))
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_i1 = 1
- return
- end if
- end do
- allocate(value(dims(1)))
- status = nf90_get_var(ncgroupid, ncvarid, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get variable '" // name // "'")
- TM5IF_get_var_i1 = 1
- return
- end if
- TM5IF_get_var_i1 = 0
- end function TM5IF_get_var_i1
- ! -----------------------------------------------------------------------------
- function TM5IF_get_var_i2 ( name, value, printErrorMessage )
- integer TM5IF_get_var_i2
- character*(*) name
- integer, allocatable :: value(:,:)
- logical, intent(in), optional :: printErrorMessage
- integer status
- integer ncvarid
- integer ndims, idim
- integer, dimension(nf90_max_var_dims) :: dimids
- integer, dimension(nf90_max_var_dims) :: dims
- logical :: shout
- ! messages ?
- shout = .true.
- if ( present(printErrorMessage) ) shout = printErrorMessage
- ! variable should not have been allocated yet
- if ( allocated(value) ) deallocate(value)
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if (status /= 0) then
- if ( shout ) call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_get_var_i2 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_i2 = 1
- return
- end if
- if (ndims /= 2) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_get_var_i2 = 1
- return
- end if
- do idim = 1, ndims
- status = nf90_inquire_dimension(ncgroupid, dimids(idim), len = dims(idim))
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_i2 = 1
- return
- end if
- end do
- allocate(value(dims(1), dims(2)))
- status = nf90_get_var(ncgroupid, ncvarid, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get variable '" // name // "'")
- TM5IF_get_var_i2 = 1
- return
- end if
- TM5IF_get_var_i2 = 0
- end function TM5IF_get_var_i2
- ! -----------------------------------------------------------------------------
- function TM5IF_get_var_i3 ( name, value, printErrorMessage )
- integer TM5IF_get_var_i3
- character*(*) name
- integer, allocatable :: value(:,:,:)
- logical, intent(in), optional :: printErrorMessage
- integer status
- integer ncvarid
- integer ndims, idim
- integer, dimension(nf90_max_var_dims) :: dimids
- integer, dimension(nf90_max_var_dims) :: dims
- logical :: shout
- ! messages ?
- shout = .true.
- if ( present(printErrorMessage) ) shout = printErrorMessage
- ! variable should not have been allocated yet
- if ( allocated(value) ) deallocate(value)
- status = nf90_inq_varid(ncgroupid, name, ncvarid)
- if (status /= 0) then
- if ( shout ) call TM5IF_log_error("Failed to inquire id for variable '" // name // "'")
- TM5IF_get_var_i3 = 1
- return
- end if
- status = nf90_inquire_variable(ncgroupid, ncvarid, dimids = dimids, ndims = ndims)
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_i3 = 1
- return
- end if
- if (ndims /= 3) then
- call TM5IF_log_error("Number of dimensions not supported for variable '" // name // "'")
- TM5IF_get_var_i3 = 1
- return
- end if
- do idim = 1, ndims
- status = nf90_inquire_dimension(ncgroupid, dimids(idim), len = dims(idim))
- if (status /= 0) then
- call TM5IF_log_error("Failed to inquire dims for variable '" // name // "'")
- TM5IF_get_var_i3 = 1
- return
- end if
- end do
- allocate(value(dims(1), dims(2), dims(3)))
- status = nf90_get_var(ncgroupid, ncvarid, value)
- if (status /= 0) then
- call TM5IF_log_error("Failed to get variable '" // name // "'")
- TM5IF_get_var_i3 = 1
- return
- end if
- TM5IF_get_var_i3 = 0
- end function TM5IF_get_var_i3
- ! -----------------------------------------------------------------------------
- function TM5IF_convert_date(string, date)
- integer TM5IF_convert_date
- character*(*) string
- type(TM5IF_date) :: date
- integer status
- if (len(string) .lt. 19) then
- TM5IF_convert_date = 1
- return
- end if
- read(string(1:4) ,*,iostat=status,err=999) date%year
- read(string(6:7) ,*,iostat=status,err=999) date%month
- read(string(9:10) ,*,iostat=status,err=999) date%day
- read(string(12:13),*,iostat=status,err=999) date%hour
- read(string(15:16),*,iostat=status,err=999) date%minute
- read(string(18:19),*,iostat=status,err=999) date%second
- 999 continue
- if (status /= 0) then
- TM5IF_convert_date = 1
- return
- end if
- TM5IF_convert_date = 0
- end function TM5IF_convert_date
- ! -----------------------------------------------------------------------------
- subroutine TM5IF_log_info(text)
- character*(*) :: text
- write(*,*) trim(text)
- end subroutine TM5IF_log_info
- ! -----------------------------------------------------------------------------
- subroutine TM5IF_log_debug(text)
- character*(*) :: text
- !write(*,*) trim(text)
- end subroutine TM5IF_log_debug
- ! -----------------------------------------------------------------------------
- subroutine TM5IF_log_error(text)
- character*(*) :: text
- write(*,*) trim(text)
- end subroutine TM5IF_log_error
- ! -----------------------------------------------------------------------------
- function TM5IF_time_get_seconds(time)
- integer TM5IF_time_get_seconds
- type(TM5IF_date) :: time
- integer,parameter,dimension(12) :: days = [31,28,31,30,31,30,31,31,30,31,30,31]
- integer,parameter :: epoch = 2000
- integer :: d, i
- d = 0
- do i = epoch, time%year - 1
- d = d + 365
- if ((mod(i, 4) .eq. 0) .and. (mod(i, 100) .ne. 0)) d = d + 1
- end do
- do i = 1, time%month - 1
- d = d + days(i)
- if ((i .eq. 2) .and. (mod(time%year, 4) .eq. 0) .and. (mod(time%year, 100) .ne. 0)) d = d + 1
- end do
- d = d + time%day - 1
- TM5IF_time_get_seconds = d * 86400 + time%hour * 3600 + time%minute * 60 + time%second
- end function TM5IF_time_get_seconds
- ! -----------------------------------------------------------------------------
- function TM5IF_time_to_string(time)
- character*(STR_LEN) TM5IF_time_to_string
- type(TM5IF_date) :: time
- write(TM5IF_time_to_string, '(I4.4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2)') time%year, '-', time%month, '-', time%day, 'T', time%hour, ':', time%minute, ':', time%second
- end function TM5IF_time_to_string
- ! -----------------------------------------------------------------------------
- subroutine TM5IF_time_init(time, year, month, day, hour, minute, second)
- type(TM5IF_date) :: time
- integer :: year, month, day, hour, minute, second
- time%year = year
- time%month = month
- time%day = day
- time%hour = hour
- time%minute = minute
- time%second = second
- end subroutine TM5IF_time_init
- ! -----------------------------------------------------------------------------
- end module TM5IF_module
|