!------------------------------------------------------------------------------ !> @file !> !> NAME: !> !> Parallax_Module.f90 !> !> FUNCTION: !> !> Compute the parallax corrected brightness temperatures !> !> DESCRIPTION: !> !> REFERENCE: !> !> CALLING SEQUENCE: !> !> INPUTS: !> !> OUTPUTS: !> !> DEPENDENCIES: !> !> SIDE EFFECTS: !> !> RESTRICTIONS: !> !> HISTORY: !> - Arthur Russakoff (arthur.russakoff@noaa.gov), 6/13/2019, initial version !> - Tianxu Yu (Tianxu.Yu@noaa.gov), 05/10/2021, added optional GFS interpolation for !> temperature and height profiles !> !> @ingroup PARALLAX !------------------------------------------------------------------------------ MODULE Parallax_Module USE TYPE_KINDS_AIT USE NF_Parm USE Framework_Global_Variables_Module !API Related Modules USE fw_log_mod IMPLICIT NONE PUBLIC :: Parallax_Main CONTAINS SUBROUTINE Parallax_Main(Return_Status) USE NetCDF USE Zenitcor_Correction_Module USE GFS_Interp_Module !API Related Modules USE ds_data_mod USE fw_misc_mod USE cf_data_mod USE fw_str_mod USE fw_work_order_mod USE fw_scene_mod REAL(SINGLE), DIMENSION(:,:,:), POINTER :: t_GFS REAL(SINGLE), DIMENSION(:,:,:), POINTER :: z_GFS REAL(SINGLE),DIMENSION(:,:), POINTER :: BT REAL(SINGLE),DIMENSION(:,:), ALLOCATABLE :: BT_14 REAL(SINGLE),DIMENSION(:,:), POINTER :: SatLat REAL(SINGLE),DIMENSION(:,:), POINTER :: SatLon REAL(SINGLE),DIMENSION(:,:), POINTER :: SatZen LOGICAL :: ZenCorFlag REAL(SINGLE), DIMENSION(:,:), POINTER :: LimbCor_Tb REAL(SINGLE),DIMENSION(:,:), POINTER :: BT_Temp INTEGER(SHORT), DIMENSION(:,:), POINTER :: BT_Temp_Short REAL(SINGLE), ALLOCATABLE, DIMENSION(:,:) :: BT_Temp2 INTEGER(BYTE), DIMENSION(:,:), POINTER:: iQf INTEGER(LONG) :: Idx_Band INTEGER(LONG) :: Idx_X INTEGER(LONG) :: Idx_Y INTEGER :: iteration REAL :: tAbove, tBelow, zAbove, zBelow INTEGER :: iAbove, iBelow REAL :: PixelHeight INTEGER :: Level INTEGER :: Idx_X_GFS, Idx_Y_GFS INTEGER, DIMENSION(:,:), POINTER :: Idx_X_GFS_Array, Idx_Y_GFS_Array INTEGER :: LUT_z REAL :: t_GFS_temp !parameters from parallax parameters file INTEGER(SHORT), PARAMETER :: TNUM_PARALLAX = 34 REAL, PARAMETER :: PARALLAX_LUT_DZ = 500. INTEGER, PARAMETER :: GFS_LEVEL = 26 INTEGER(LONG), PARAMETER :: I_BOX_WIDTH = 2 INTEGER(SHORT), DIMENSION(:,:,:), ALLOCATABLE :: Para_IX_3D INTEGER(SHORT), DIMENSION(:,:,:), ALLOCATABLE :: Para_IY_3D INTEGER(SHORT), DIMENSION(:,:), ALLOCATABLE :: New_Idx_X INTEGER(SHORT), DIMENSION(:,:), ALLOCATABLE :: New_Idx_Y REAL(SINGLE) :: BT_Mid INTEGER(SHORT) :: New_X, New_Y INTEGER(LONG) :: ii, jj REAL(SINGLE) :: wtcnt,xsum,wt CHARACTER(len=*), PARAMETER :: PAR_GFS_INTERP_FLAG_LBL = "parameters/GFS_INTERP_FLAG" CHARACTER(len=*), PARAMETER :: PAR_CHANNEL_NAMES_LBL = "parameters/CHANNEL_NAMES" CHARACTER(len=*), PARAMETER :: PAR_ZEN_COR_FILE_LBL = "parameters/ZEN_COR_FILE" CHARACTER(len=*), PARAMETER :: PAR_PARA_LUT_FILENAME_LBL = "parameters/PARA_LUT_FILENAME" CHARACTER(len=*), PARAMETER :: IN_BT_14_LBL = "input/sat/BT_14" CHARACTER(len=*), PARAMETER :: IN_TIME_STAMP_LBL = "input/sat/TimeStamp" CHARACTER(len=*), PARAMETER :: IN_SAT_LAT_LBL = "input/sat/Latitude" CHARACTER(len=*), PARAMETER :: IN_SAT_LON_LBL = "input/sat/Longitude" CHARACTER(len=*), PARAMETER :: IN_SAT_ZEN_LBL = "input/sat/SatelliteZenith" CHARACTER(len=*), PARAMETER :: IN_IQf14_LBL = "input/sat/QF_14" CHARACTER(len=*), PARAMETER :: IN_IDX_X_GFS_LBL = "input/gfs/IDX_X_GFS" CHARACTER(len=*), PARAMETER :: IN_IDX_Y_GFS_LBL = "input/gfs/IDX_Y_GFS" CHARACTER(len=*), PARAMETER :: IN_TEMP_PROF_LBL = "input/gfs/TempProf" CHARACTER(len=*), PARAMETER :: IN_HEIGHT_PROF_LBL = "input/gfs/HgtProf" CHARACTER(len=*), PARAMETER :: IN_GFS_NUM_LAT_LBL = "input/gfs/NumLat" CHARACTER(len=*), PARAMETER :: IN_GFS_NUM_LON_LBL = "input/gfs/NumLon" CHARACTER(len=*), PARAMETER :: IN_GFS_DELTA_LAT_LBL = "input/gfs/DeltaLat" CHARACTER(len=*), PARAMETER :: IN_GFS_DELTA_LON_LBL = "input/gfs/DeltaLon" CHARACTER(len=*), PARAMETER :: IN_GFS_FIRST_LAT_LBL = "input/gfs/FirstLat" CHARACTER(len=*), PARAMETER :: IN_GFS_FIRST_LON_LBL = "input/gfs/FirstLon" CHARACTER(len=*), PARAMETER :: IN_GFS_LEVELS_LBL = "input/gfs/NumLevels" CHARACTER(len=*), PARAMETER :: OUT_LIMB_CORRECTED_BT_LBL = "capability/LimbAdjusted_BT14" CHARACTER(LEN=:), ALLOCATABLE :: Para_LUT_Filename CHARACTER(LEN=:), ALLOCATABLE :: Zen_Corr_File CHARACTER(len=256) :: input_LBL !CHARACTER(len=256) :: qf_LBL CHARACTER(len=256) :: capability_float_LBL, capability_short_LBL TYPE(fw_str), DIMENSION(:), ALLOCATABLE :: channelNames LOGICAL :: requested_float, requested_short, hasVal INTEGER(LONG), PARAMETER :: scale_factor = 10 REAL(SINGLE), PARAMETER :: BT_MIN = 174. TYPE(fw_time_stamp) :: TimeStamp INTEGER(LONG) :: SEGMENT_COL, SEGMENT_ROW INTEGER(LONG) :: start_row, start_col TYPE(fw_data_context) :: data_context INTEGER(LONG) :: Return_Status CHARACTER(LEN=*), PARAMETER :: ROUTINE_NAME = "Parallax_Main" REAL(SINGLE), DIMENSION(1:I_BOX_WIDTH,1:I_BOX_WIDTH) :: Weight INTEGER(LONG), DIMENSION(1:I_BOX_WIDTH) :: Idx_X_GFS_Box INTEGER(LONG), DIMENSION(1:I_BOX_WIDTH) :: Idx_Y_GFS_Box REAL(SINGLE), ALLOCATABLE, DIMENSION(:) :: GFS_Lat REAL(SINGLE), ALLOCATABLE, DIMENSION(:) :: GFS_Lon REAL(SINGLE), ALLOCATABLE, DIMENSION(:) :: t_int, z_int INTEGER(LONG) :: ix_GFS INTEGER(LONG) :: iy_GFS REAL(SINGLE) :: Sat_Lat_Pix REAL(SINGLE) :: Sat_Lon_Pix INTEGER(LONG) :: GFS_Num_Lat INTEGER(LONG) :: GFS_Num_Lon REAL(SINGLE) :: GFS_Delta_Lat REAL(SINGLE) :: GFS_Delta_Lon REAL(SINGLE) :: GFS_First_Lat REAL(SINGLE) :: GFS_First_Lon INTEGER(LONG) :: Flag_Interp Return_Status = RETURN_FAIL !-- Compute limb corrected 11-um band Tb if LUT available --------------------------------------- NULLIFY(BT_Temp, iQf) NULLIFY(SatLat, SatLon, SatZen, Idx_X_GFS_Array, Idx_Y_GFS_Array, t_GFS, z_GFS) IF(.NOT. ds_get(IN_BT_14_LBL, BT_Temp, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_SAT_LAT_LBL, SatLat, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_SAT_LON_LBL, SatLon, ROUTINE_NAME)) RETURN IF( .NOT. fw_uri_segment_ctx(IN_BT_14_LBL, FW_DIM_ROW, data_context, ROUTINE_NAME) ) RETURN start_row = int(data_context%position%start_pos, LONG) IF( .NOT. fw_uri_segment_ctx(IN_BT_14_LBL, FW_DIM_COLUMN, data_context, ROUTINE_NAME) ) RETURN start_col = int(data_context%position%start_pos, LONG) SEGMENT_COL = SIZE(BT_Temp, 1) SEGMENT_ROW = SIZE(BT_Temp, 2) ALLOCATE(BT_14(SEGMENT_COL, SEGMENT_ROW)) BT_14 = BT_Temp WHERE(BT_14 < BT_MIN) BT_14 = MISSING_VALUE_SINGLE IF(.NOT. cf_has(IN_IQf14_LBL, hasVal, ROUTINE_NAME)) RETURN IF(hasVal) THEN IF(.NOT. ds_get(IN_IQf14_LBL, iQf, ROUTINE_NAME)) RETURN WHERE(INT2(iQf) /= INT2(0) .AND. INT2(iQf) /= INT2(4)) BT_14 = MISSING_VALUE_SINGLE END IF IF(.NOT. ds_alloc(OUT_LIMB_CORRECTED_BT_LBL, LimbCor_Tb, ROUTINE_NAME)) RETURN IF(.NOT. cf_has(PAR_ZEN_COR_FILE_LBL, ZenCorFlag, ROUTINE_NAME)) RETURN if(ZenCorFlag .EQV. .TRUE.) THEN IF(.NOT. cf_get(PAR_ZEN_COR_FILE_LBL, Zen_Corr_File, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_SAT_ZEN_LBL, SatZen, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_TIME_STAMP_LBL, TimeStamp, ROUTINE_NAME)) RETURN IF(.NOT. Zenitcor_Correction(Zen_Corr_File, BT_14, SatLat, SatZen, TimeStamp%Julian_Day, LimbCor_Tb)) RETURN ELSE LimbCor_Tb = BT_14 END IF !--- get the GFS indices ----- IF(.NOT. ds_get(IN_IDX_X_GFS_LBL, Idx_X_GFS_Array, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_IDX_Y_GFS_LBL, Idx_Y_GFS_Array, ROUTINE_NAME)) RETURN !-- get the GFS --- IF(.NOT. ds_get(IN_TEMP_PROF_LBL, t_GFS, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_HEIGHT_PROF_LBL, z_GFS, ROUTINE_NAME)) RETURN ALLOCATE(New_Idx_X(SEGMENT_COL,SEGMENT_ROW)) ALLOCATE(New_Idx_Y(SEGMENT_COL,SEGMENT_ROW)) ALLOCATE(Para_IX_3D(TNUM_PARALLAX, SEGMENT_COL, SEGMENT_ROW)) ALLOCATE(Para_IY_3D(TNUM_PARALLAX, SEGMENT_COL, SEGMENT_ROW)) IF(.NOT. cf_get(PAR_PARA_LUT_FILENAME_LBL, Para_LUT_Filename, ROUTINE_NAME)) RETURN IF(.NOT. AIT_ReadParaLUT_3D(Para_LUT_Filename, Para_IX_3D, Para_IY_3D, TNUM_PARALLAX, start_col, start_row, SEGMENT_COL, SEGMENT_ROW)) RETURN IF(.NOT. ds_get(IN_GFS_NUM_LAT_LBL, GFS_Num_Lat, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_GFS_NUM_LON_LBL, GFS_Num_Lon, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_GFS_DELTA_LAT_LBL, GFS_Delta_Lat, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_GFS_DELTA_LON_LBL, GFS_Delta_Lon, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_GFS_FIRST_LAT_LBL, GFS_First_Lat, ROUTINE_NAME)) RETURN IF(.NOT. ds_get(IN_GFS_FIRST_LON_LBL, GFS_First_Lon, ROUTINE_NAME)) RETURN IF(.NOT. cf_get(PAR_GFS_INTERP_FLAG_LBL, Flag_Interp, ROUTINE_NAME)) RETURN ALLOCATE(GFS_Lat(1:GFS_Num_Lat)) ALLOCATE(GFS_Lon(1:GFS_Num_Lon)) ALLOCATE(t_int(1:GFS_LEVEL)) ALLOCATE(z_int(1:GFS_LEVEL)) !-- compute GFS grid latitudes and longitudes DO Idx_Y = 1, GFS_Num_Lat ! start from the upper left corner for RR GFS_Lat(Idx_Y) = GFS_First_Lat - (Idx_Y - 1)*GFS_Delta_Lat ENDDO DO Idx_X = 1, GFS_Num_Lon GFS_Lon(Idx_X) = GFS_First_Lon + (Idx_X - 1)*GFS_Delta_Lon ENDDO !-- Loop through the IR pixels to determine parallax correction based on ---- !-- cloud-top height as determined from cloud-top Tb ------------------------ DO Idx_Y = 1, SEGMENT_ROW !-- get the LUT parameters for the current row (memory cost savings for large LUT) --- Col_Loop: DO Idx_X = 1, SEGMENT_COL !-- Only adjust pixels that have good values -------------------------- IF (LimbCor_Tb(Idx_X, Idx_Y) < 100. .OR. SatLat(Idx_X, Idx_Y) < -90.) THEN New_Idx_X(Idx_X,Idx_Y) = MISSING_VALUE_SHORT New_Idx_Y(Idx_X,Idx_Y) = MISSING_VALUE_SHORT CYCLE Col_Loop ENDIF !-- Do not adjust pixels that are warmer than 290 K ---------------- IF (LimbCor_Tb(Idx_X,Idx_Y) > 290. ) THEN New_Idx_X(Idx_X,Idx_Y) = INT(Idx_X, SHORT) New_Idx_Y(Idx_X,Idx_Y) = INT(Idx_Y, SHORT) CYCLE Col_Loop ENDIF !--- Interpolate T and Z only if interpolation flag is on (true) ------ IF (Flag_Interp .NE. 0) THEN !--- Rescale satellite longitude to 0-360 if needed ------------- IF (SatLon(Idx_X, Idx_Y) < 0.) THEN Sat_Lon_Pix = SatLon(Idx_X, Idx_Y) + 360. ELSE Sat_Lon_Pix = SatLon(Idx_X, Idx_Y) ENDIF Sat_Lat_Pix = SatLat(idx_x,idx_y) !-- Determine pixel location on the GFS grid -------------------------- ix_GFS = INT((Sat_Lon_Pix - GFS_Lon(1)) / & (GFS_Lon(2) - GFS_Lon(1))) + 1 IF (ix_GFS < 1) THEN ix_GFS = ix_GFS + GFS_Num_Lon Sat_Lon_Pix = Sat_Lon_Pix + 360.0 ELSE IF (ix_GFS > GFS_Num_Lon) THEN ix_GFS = ix_GFS - GFS_Num_Lon Sat_Lon_Pix = Sat_Lon_Pix - 360.0 ENDIF iy_GFS = INT((Sat_Lat_Pix - GFS_lat(1)) / & (GFS_Lat(2) - GFS_Lat(1))) + 1 !--- Graceful exit if y-coordinate is out of bounds ---------------- IF (iy_GFS < 1 .OR. iy_GFS > GFS_Num_Lat) THEN CALL fw_log_error(ROUTINE_NAME, 'Latitude error!') RETURN ENDIF !--- Call the interpolation function ------------------------------- CALL Interpolation_Weights(ix_GFS, iy_GFS, GFS_lat, GFS_lon, & Sat_Lat_Pix, Sat_Lon_Pix, Idx_X_GFS_Box, Idx_Y_GFS_Box, Weight) !--- Compute RH from Weights --------------------------------------- t_int = Weight(1,1) * t_GFS(Idx_X_GFS_Box(1),Idx_Y_GFS_Box(1),:) + & Weight(2,1) * t_GFS(Idx_X_GFS_Box(2),Idx_Y_GFS_Box(1),:) + & Weight(1,2) * t_GFS(Idx_X_GFS_Box(1),Idx_Y_GFS_Box(2),:) + & Weight(2,2) * t_GFS(Idx_X_GFS_Box(2),Idx_Y_GFS_Box(2),:) z_int = Weight(1,1) * z_GFS(Idx_X_GFS_Box(1),Idx_Y_GFS_Box(1),:) + & Weight(2,1) * z_GFS(Idx_X_GFS_Box(2),Idx_Y_GFS_Box(1),:) + & Weight(1,2) * z_GFS(Idx_X_GFS_Box(1),Idx_Y_GFS_Box(2),:) + & Weight(2,2) * z_GFS(Idx_X_GFS_Box(2),Idx_Y_GFS_Box(2),:) ELSE !-- Determine pixel location on the GFS grid -------------------- Idx_X_GFS = Idx_X_GFS_Array(Idx_X, Idx_Y) Idx_Y_GFS = Idx_Y_GFS_Array(Idx_X, Idx_Y) t_int = t_GFS(Idx_X_GFS, Idx_Y_GFS, :) z_int = z_GFS(Idx_X_GFS, Idx_Y_GFS, :) ENDIF !-- Determine the pixel height corresponding to temperature ----- !-- In the Framework, a greater level corresponds to lower heights and higher temperatures BT_Mid = LimbCor_Tb(Idx_X, Idx_Y) iBelow = 0 iAbove = 0 Level = GFS_LEVEL / 2 DO iteration = 1, GFS_LEVEL t_GFS_temp = t_int(level) IF (t_GFS_temp < BT_Mid) THEN iAbove = Level Level = Level + 1 IF (Level == GFS_LEVEL + 1) THEN iAbove = GFS_LEVEL iBelow = GFS_LEVEL ENDIF IF (iBelow /= 0 .AND. iAbove /= 0) EXIT ELSE iBelow = Level Level = Level - 1 IF (Level == 0) THEN iAbove = 1 iBelow = 1 ENDIF IF (iBelow /= 0 .AND. iAbove /= 0) EXIT ENDIF ENDDO IF (iteration == GFS_LEVEL + 1) THEN CALL fw_log_error(ROUTINE_NAME, 'pixel height determination failed to converge') RETURN END IF !-- Interpolate between GFS levels to get actual height --------- zAbove = z_int(iAbove) zBelow = z_int(iBelow) tAbove = t_int(iAbove) tBelow = t_int(iBelow) PixelHeight = zBelow + (zAbove - zBelow) * (BT_Mid - tBelow) / & (tAbove - tBelow) IF (iAbove == iBelow) PixelHeight = zBelow !-- Convert height into LUT level ------------------------------- LUT_z = MAX(MIN(NINT(PixelHeight / PARALLAX_LUT_DZ) + 1, TNUM_PARALLAX), 1) New_Idx_X(Idx_X, Idx_Y) = Para_IX_3D(LUT_z, Idx_X, Idx_Y) - start_col + 1 New_Idx_Y(Idx_X, Idx_Y) = Para_IY_3D(LUT_z, Idx_X, Idx_Y) - start_row + 1 !-- Move on to the next pixel -------------------------------------------- END DO Col_Loop END DO DEALLOCATE(GFS_Lat) DEALLOCATE(GFS_Lon) DEALLOCATE(t_int) DEALLOCATE(z_int) DEALLOCATE (Para_IX_3D) DEALLOCATE (Para_IY_3D) IF(ALLOCATED(BT_14)) DEALLOCATE(BT_14) ALLOCATE(BT_Temp2(SEGMENT_COL, SEGMENT_ROW)) IF(.NOT. cf_get(PAR_CHANNEL_NAMES_LBL, channelNames, ROUTINE_NAME) ) RETURN DO Idx_Band = 1, SIZE(channelNames) capability_float_LBL="capability/"//channelNames(Idx_Band)%str//"/BT_Parallax" capability_short_LBL="capability/"//channelNames(Idx_Band)%str//"/BT_Parallax_SShort" input_LBL="input/sat/"//channelNames(Idx_Band)%str//"/BT" IF(.NOT. wo_is_requested(capability_float_LBL, requested_float, ROUTINE_NAME)) RETURN IF(.NOT. wo_is_requested(capability_short_LBL, requested_short, ROUTINE_NAME)) RETURN IF(requested_float .OR. requested_short) THEN !--- Create and populate space with original (unshifted) BT values ---------- NULLIFY(BT, BT_Temp, BT_Temp_Short,iQf) IF(.NOT. ds_get(input_LBL, BT, ROUTINE_NAME)) RETURN IF(.NOT. ds_alloc(capability_float_LBL, BT_Temp, ROUTINE_NAME)) RETURN BT_Temp = MISSING_VALUE_SINGLE !--- Compute the shifted BT values ---------- DO Idx_Y = 1, SEGMENT_ROW DO Idx_X = 1, SEGMENT_COL !-- Put the pixel in its new location on the temp grid ---------- New_X = New_Idx_X(Idx_X, Idx_Y) New_Y = New_Idx_Y(Idx_X, Idx_Y) IF(New_X > INT2(0) .AND. New_X <= SEGMENT_COL .AND. New_Y > INT2(0) .AND. New_Y <= SEGMENT_ROW) THEN BT_Temp(New_X, New_Y) = BT(Idx_X, Idx_Y) END IF END DO END DO !--- Fill in any missing values via weighted interpolation ------------------ BT_Temp2 = BT_Temp DO Idx_Y = 1, SEGMENT_ROW DO Idx_X = 1, SEGMENT_COL IF (BT_Temp2(Idx_X,Idx_Y) < 0.) THEN wtcnt = 0. xsum = 0. DO ii = MAX(1,Idx_X-2), MIN(SEGMENT_COL,Idx_X+2) DO jj = MAX(1,Idx_Y-2), MIN(SEGMENT_ROW,Idx_Y+2) IF (BT_Temp2(ii,jj) > 0.) THEN wt = REAL(5 - ABS(ii-Idx_X) - ABS(jj-Idx_Y)) wtcnt =wtcnt + wt xsum = xsum + wt * BT_Temp2(ii,jj) ENDIF END DO END DO IF (wtcnt > 0.) THEN BT_Temp(Idx_X, Idx_Y) = xsum / wtcnt ELSE BT_Temp(Idx_X, Idx_Y) = MISSING_VALUE_SINGLE ENDIF ENDIF END DO END DO !compute the short version IF(requested_short) THEN IF(.NOT. ds_alloc(capability_short_LBL, BT_Temp_Short, ROUTINE_NAME)) RETURN DO Idx_Y = 1, SEGMENT_ROW DO Idx_X = 1, SEGMENT_COL BT_Temp_Short(Idx_X, Idx_Y) = NINT(BT_Temp(Idx_X, Idx_Y) * scale_factor, kind=SHORT) END DO END DO END IF !erase float if not needed IF(.NOT. requested_float) THEN IF(.NOT. ds_erase(capability_float_LBL, ROUTINE_NAME)) RETURN ELSE DO Idx_Y = 1, SEGMENT_ROW DO Idx_X = 1, SEGMENT_COL ! set the precision to what the HYDRO_RAIN_RATE_EN requires BT_Temp(Idx_X, Idx_Y) = NINT(BT_Temp(Idx_X, Idx_Y) * scale_factor, kind=SHORT)/REAL(scale_factor) END DO END DO END IF END IF END DO DEALLOCATE (New_Idx_X) DEALLOCATE (New_Idx_Y) DEALLOCATE(BT_Temp2) Return_Status = RETURN_SUCCESS END SUBROUTINE Parallax_Main FUNCTION AIT_ReadParaLUT_3D(Para_LUT_Filename, para_i_3D, para_j_3D, TNUM_PARALLAX, Idx_X, Idx_Y, SEGMENT_COL, SEGMENT_ROW) result(Return_Status) USE netcdf IMPLICIT NONE INTEGER(SHORT), INTENT(IN) :: TNUM_PARALLAX INTEGER(LONG), INTENT(IN) :: SEGMENT_ROW INTEGER(LONG), INTENT(IN) :: SEGMENT_COL INTEGER(SHORT), DIMENSION(TNUM_PARALLAX,SEGMENT_COL,SEGMENT_ROW), INTENT(INOUT) :: para_i_3D,para_j_3D INTEGER(LONG), INTENT(IN) :: Idx_X INTEGER(LONG), INTENT(IN) :: Idx_Y CHARACTER(LEN=*), INTENT(IN) :: Para_LUT_Filename INTEGER(LONG) :: LONG_TNUM_PARALLAX LOGICAL :: Return_Status INTEGER(LONG) :: ncid INTEGER(LONG) :: varid INTEGER(LONG) :: Error_Status CHARACTER(LEN=*), PARAMETER :: ROUTINE_NAME = "AIT_ReadParaLUT_3D" Return_Status = .TRUE. LONG_TNUM_PARALLAX=INT(TNUM_PARALLAX, KIND=4) Error_Status = nf90_open(Para_LUT_Filename, NF90_NOWRITE, ncid) IF(Error_Status == nf90_noerr) Error_Status = nf90_inq_varid(ncid, "Parallax_LUT_x", varid) IF(Error_Status == nf90_noerr) Error_Status = nf90_get_var(ncid, varid, para_i_3D,& start = (/ 1, Idx_X, Idx_Y /),& count = (/ LONG_TNUM_PARALLAX, SEGMENT_COL, SEGMENT_ROW /)) IF(Error_Status == nf90_noerr) Error_Status = nf90_inq_varid(ncid, "Parallax_LUT_y", varid) IF(Error_Status == nf90_noerr) Error_Status = nf90_get_var(ncid, varid, para_j_3D,& start = (/ 1, Idx_X, Idx_Y /),& count = (/ LONG_TNUM_PARALLAX, SEGMENT_COL, SEGMENT_ROW /)) IF(Error_Status == nf90_noerr) Error_Status = nf90_close(ncid) IF(Error_Status /= nf90_noerr) THEN CALL fw_log_error(ROUTINE_NAME, nf90_strerror(Error_Status)) Return_Status = .FALSE. END IF RETURN END FUNCTION AIT_ReadParaLUT_3D END MODULE Parallax_Module